aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022/20/solver.lisp
blob: dc1f2c74fc6cc5779c41285443e2d3ad7813197c (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
(ql:quickload '(fiveam uiop))

(defparameter *msg* #(1 2 -3 3 -2 0 4))

(defun directional-pointers (size)
  (let ((forward (make-array size))
        (reverse (make-array size)))
    (dotimes (i size)
      (setf (svref forward i) (mod (1+ i) size)
            (svref reverse i) (mod (1- i) size)))
    (values forward reverse)))

(defun follow-pointer (pointer index count)
  (if (zerop count)
      index
      (follow-pointer pointer (svref pointer index) (1- count))))

(defun move! (forward reverse element-idx shift)
  "FORWARD is the leading array, not necessarily forward movement"
  (let ((next-element (svref forward element-idx))
        (prev-element (svref reverse element-idx)))
    ;; remove element from sequence
    (setf (svref reverse next-element) prev-element)
    (setf (svref forward prev-element) next-element))
  (let* ((amount (1+ (mod (1- shift) (1- (length forward)))))
         (target-index (follow-pointer forward element-idx amount)))
    (psetf (svref reverse element-idx) target-index
           (svref reverse (svref forward target-index)) element-idx
           (svref forward element-idx) (svref forward target-index)
           (svref forward target-index) element-idx))
  (values forward reverse))

(defun shuffle! (forward reverse element-idx shift)
  (cond
    ((zerop shift))
    ((plusp shift)
     (move! forward reverse element-idx shift))
    ((move! reverse forward element-idx (abs shift))))
  (values forward reverse))

(defun shuffle-pointers (msg repeat)
  (multiple-value-bind (forward reverse) (directional-pointers (length msg))
    (dotimes (_ repeat)
      (dotimes (element-idx (length msg))
        ;; (format t "st: ~a f: ~a r: ~a~%" (ordered-series msg forward) forward reverse)
        (shuffle! forward reverse element-idx (svref msg element-idx))))
    (values forward reverse)))

(defun ordered-series (msg forward)
  (let* ((len (length msg))
         (series (make-array len)))
    (do ((i (position 0 msg) (svref forward i))
         (count 0 (1+ count)))
        ((<= len count) series)
      (setf (svref series count)
            (svref msg i)))))

(defun solver (repeat message)
  (let ((new-array
          (ordered-series message (shuffle-pointers message repeat))))
    (+
     (svref new-array (mod 1000 (length new-array)))
     (svref new-array (mod 2000 (length new-array)))
     (svref new-array (mod 3000 (length new-array))))))


(defun times-decrypt-key (msg)
  (map 'vector (lambda (x) (* 811589153 x)) msg))

(fiveam:test solutions
  (fiveam:is (= 3 (solver 1 *msg*)))
  (fiveam:is (= 1623178306 (solver 10 (times-decrypt-key *msg*))))
  (let ((input-msg (map 'vector #'parse-integer (uiop:read-file-lines "input"))))
    (fiveam:is (= 7225 (solver 1 input-msg)))
    (fiveam:is (= 548634267428 (solver 10 (times-decrypt-key input-msg))))))
s="nb">reduce #'+ <> :key #'interval-length) (- <> (beacons-in-row markers target-row)))) ;; solution part 1 (fiveam:test part1 (fiveam:is (= 26 (measure-cover (markers (uiop:read-file-lines "eg-in")) 10))) (fiveam:is (= 5040643 (measure-cover (markers (uiop:read-file-lines "input")) 2000000)))) (defun coverage-edge (sensor coverage low high test) (destructuring-bind (x . y) sensor (let ((edge (1+ coverage))) (loop named dangling for cx from (max low (- x edge)) to (min high (+ x edge)) for available = (- edge (abs (- x cx))) :do (loop for cy in (list (- y available) (+ y available)) :when (and (<= low cy high) (not (funcall test (cons cx cy)))) :do (return-from dangling (list cx cy))))))) (defun point-covered (sensor-coverage) (lambda (point) (loop for (other-sensor range) in sensor-coverage :thereis (<= (manhattan-dist point other-sensor) range)))) ;; fail coverage too slow (defun fail-freq (markers bound) (loop :for y from 0 to bound :for col = (loop :for x from 0 to bound :when (loop :for (sensor beacon) on markers by #'cddr :never (<= (manhattan-dist sensor (cons x y)) (manhattan-dist sensor beacon))) :return x) :when col :return (+ (* 4000000 col) y))) (defun fail-freq-edge (markers low high) (let* ((sensor-coverage (sensor-coverage markers)) (covered-p (point-covered sensor-coverage))) (loop for (sensor coverage) in sensor-coverage :when (coverage-edge sensor coverage low high covered-p) :return it))) (defun tune-soluton (position) (destructuring-bind (x y) position (+ (* x 4000000) y))) (fiveam:test part2 (fiveam:is (= 56000011 (tune-soluton (fail-freq-edge (markers (uiop:read-file-lines "eg-in")) 0 20)))) (fiveam:is (= 11016575214126 (tune-soluton (fail-freq-edge (markers (uiop:read-file-lines "input")) 2700000 3300000))))) ;; Obsolete drawing (defun grid (bounds) (destructuring-bind ((xmin xmax) (ymin ymax)) bounds (make-array (* (- xmax xmin -1) (- ymax ymin -1)) :initial-element 0 :element-type '(unsigned-byte 2)))) (defun in-grid (bounds) (destructuring-bind ((xmin xmax) (ymin ymax)) bounds (let ((stride (- xmax xmin -1))) (lambda (x y) (when (and (<= xmin x xmax) (<= ymin y ymax)) (+ (- x xmin) (* (- y ymin) stride))))))) (defun from-grid (bounds) (destructuring-bind ((xmin xmax) (ymin _)) bounds (declare (ignore _)) (let ((stride (- xmax xmin -1))) (lambda (pos) (multiple-value-bind (y x) (floor pos stride) (cons (+ x xmin) (+ y ymin))))))) (defun draw-grid (grid stride) (let ((out (make-string-output-stream))) (loop for elt across grid for idx from 0 do (progn (when (= 0 (mod idx stride)) (terpri out)) (princ (case elt (0 ".") (1 "S") (2 "B") (3 "#")) out))) (get-output-stream-string out))) (defun bounds (markers) (list (list (loop for (x . y) in markers minimize x) (loop for (x . y) in markers maximize x)) (list (loop for (x . y) in markers minimize y) (loop for (x . y) in markers maximize y)))) (defun draw-example-coverage () (let* ((lines (uiop:read-file-lines "eg-in")) (markers (markers lines)) (bounds (bounds markers)) (loc (in-grid bounds)) (grid (grid bounds)) (coords (from-grid bounds))) (loop for ((sx . sy) (bx . by)) on markers by #'cddr do (progn (setf (aref grid (funcall loc sx sy)) 1) (setf (aref grid (funcall loc bx by)) 2))) (loop for (sensor beacon) on markers by #'cddr for distance = (manhattan-dist sensor beacon) do (loop for elt across grid and l from 0 when (and (<= (manhattan-dist sensor (funcall coords l)) distance) (= elt 0)) do (setf (aref grid l) 3))) (destructuring-bind ((xmin xmax) (ymin ymax)) bounds (declare (ignore ymax)) (let ((stride (- xmax xmin -1))) (princ (draw-grid grid stride)) (loop repeat stride for l from (* (+ 10 ymin) stride) when (= 3 (aref grid l)) count it)))))