solved day 18

src/2024/day13.lisp

@@ -1,6 +1,6 @@
 
 (defpackage :aoc/2024/13
-  (:use :cl :aoc :alexandria :trivia :lla :smug :arrow-macros)
+  (:use :cl :aoc :alexandria :lla :smug :arrow-macros)
   (:export
    #:sample-data
    #:sample-data2

src/2024/day17.lisp

@@ -17,9 +17,6 @@
    #:cpu-ip
    #:cpu-mem
    #:cpu-state
-   
-   
-   
    ))
 
 (in-package :aoc/2024/17)
@@ -211,11 +208,6 @@ Program: 0,1,5,4,3,0"))
 	       (operand (literal-operand cpu)))
 	   (format t " ~A ~A~%" opcode operand)))))
 
-
-
-
-
-
 ;; BST 4   -->   B = A mod 8
 ;; BXL 1   -->   B = B xor 1
 ;; CDV 5  -->  C = A shr B
@@ -255,6 +247,7 @@ Program: 0,1,5,4,3,0"))
     finally (return a))
   )
 
+
 (defun part2 (data)
   (format nil "~A" (solve-part2 data)))
 

src/2024/day18.lisp

@@ -1,35 +1,205 @@
 
 (defpackage :aoc/2024/18
-  (:use :cl :aoc :alexandria :trivia :lla)
+  (:use :cl :aoc :alexandria :trivia :lla :queues)
   (:export
    #:sample-data
    #:sample-data2
    #:part1
    #:part2
+   #:in-bounds-p
+   #:make-pos
+   #:pos-x
+   #:pos-y
+   #:next-moves
    ))
 
 (in-package :aoc/2024/18)
 
+(defstruct pos
+  (x 0 :type fixnum)
+  (y 0 :type fixnum))
+
+(defun pos-move (pos dir)
+  (case dir
+    (#\^ (make-pos :x (pos-x pos) :y (1- (pos-y pos))))
+    (#\v (make-pos :x (pos-x pos) :y (1+ (pos-y pos))))
+    (#\< (make-pos :x (1- (pos-x pos)) :y (pos-y pos)))
+    (#\> (make-pos :x (1+ (pos-x pos)) :y (pos-y pos)))
+    ))
+
+(defun show-map (map &optional (dest t))
+  (let ((w (array-dimension map 1))
+	(h (array-dimension map 0)))
+    (format
+     dest "~{~A~}"
+     (loop
+       for row from 0 below h
+       collect (format nil "~A~%"
+		       (coerce
+			(loop for col from 0 below w
+			      collect (aref map row col))
+			'string))))))
+
+(defun get-pos (map pos)
+  (aref map (pos-y pos) (pos-x pos)))
+
+(defun set-pos (map pos tile)
+  (setf (aref map (pos-y pos) (pos-x pos)) tile))
 
 (defun parse-line (line)
-  line)
+  (let ((p (mapcar #'parse-integer (ppcre:split "," line))))
+    (make-pos :x (first p) :y (second p))))
 
 
 (defun parse-input (lines)
-  (mapcar #'parse-line lines))
+  (let ((mem (make-hash-table :test #'equalp)))
+    (loop
+      for p in (mapcar #'parse-line lines)
+      for i from 1
+      do (setf (gethash p mem) i))
+    mem))
+
+
+(defstruct memory size map)
 
 (defparameter input-text (test-input 2024 18))
-(defparameter input-data (parse-input input-text))
+(defparameter input-data
+  (make-memory
+   :size 70
+   :map (parse-input input-text)))
+
+(defparameter sample-text (aoc:split-lines "5,4
+4,2
+4,5
+3,0
+2,1
+6,3
+2,4
+1,5
+0,6
+3,3
+2,6
+5,1
+1,2
+5,5
+2,5
+6,5
+1,4
+0,4
+6,4
+1,1
+6,1
+1,0
+0,5
+1,6
+2,0"))
 
-(defparameter sample-text (aoc:split-lines ""))
 (defparameter sample-data
-              (parse-input sample-text))
+  (make-memory
+   :size 6
+   :map (parse-input sample-text)))
 
-(defun part1 (data)
-  (length data))
+(defun in-bounds-p (mem pos)
+  (and
+   (<= 0 (pos-x pos))
+   (<= 0 (pos-y pos))
+   (>= (memory-size mem) (pos-x pos))
+   (>= (memory-size mem) (pos-y pos))
+   ))
+
+(defun next-moves (mem pos &optional (tm 1024))
+  "return conses of next pos get there"
+  (loop for d in '(#\^ #\v #\> #\<)
+	for p = (pos-move pos d)
+	
+	if (and
+	    (in-bounds-p mem p)
+	    (< tm (gethash p (memory-map mem) 1000000)))
+	  collect p))
+
+(defun distance-estimate-f (finish)
+  "estimate the distance for a reindeer from given finish"
+  (let ((a finish))
+    (lambda (b)
+      (+
+       (abs (- (pos-x a) (pos-x b)))
+       (abs (- (pos-y a) (pos-y b)))
+       ))))
+
+(defstruct state score path)
+
+(defun compare-states-f (finish)
+  (let ((dist-est (distance-estimate-f finish)))
+    (lambda (s1 s2)
+      (< (+ (state-score s1)
+	    (funcall dist-est (car (state-path s1))))
+	 (+ (state-score s2)
+	    (funcall dist-est (car (state-path s2))))))))
+
+(defun best-path (map time)
+  (let* ((start (make-pos :x 0 :y 0))
+	 (finish (make-pos :x (memory-size map) :y (memory-size map)))
+	 (state-comparison (compare-states-f finish))
+	 (best (make-hash-table :test #'equalp))
+	 (todo (make-queue :priority-queue :compare state-comparison)))
+    (qpush todo (make-state
+		 :path (list start)
+		 :score 0))    
+    (loop
+      for s = (qpop todo)
+      until (or
+	     (null s)
+	     (equalp (first (state-path s)) finish))
+      finally (return s)
+      do (loop
+	   for next in (next-moves map (first (state-path s)) time)
+	   for score = (+ (state-score s) 1)
+	   if (> (gethash next best 1000000000) score)
+	     do (progn
+		  (qpush todo
+			 (make-state
+			  :path (cons next (state-path s))
+			  :score score))
+		  (setf (gethash next best) score)))
+
+      )))
+
+(defun solve-part1 (data time)
+  (let ((path (best-path data time)))
+    (state-score path))
+  )
+
+(defun part1 (data &optional (time 1024))
+  (format nil "~A" (solve-part1 data time)))
+
+(defun pos-at-time (mem tm)
+  (loop
+    for k being the hash-keys of (memory-map mem)
+    for v being the hash-values of (memory-map mem)
+    if (= v tm)
+      return k))
+
+
+(defun find-block-position (mem )
+  (let* ((delta (ash 1 (ceiling (log (hash-table-count (memory-map mem)) 2))))
+	 (tm   0)
+	 (best-tm 0))
+    (loop
+      for x = 1
+      do (format t "delta: ~A, tm: ~A, best-tm: ~A~%" delta tm best-tm)
+      until (zerop delta)
+      if (best-path mem tm)
+	do (progn
+	     (setf best-tm (max best-tm tm))
+	     (incf tm delta))
+      else
+	do (decf tm delta)
+      do (setf delta (ash delta -1))
+      finally (return (pos-at-time mem (1+ best-tm))))))
 
 (defun part2 (data)
-  (length data))
+  (let ((first-block-pos (find-block-position data)))
+    (format nil "~A,~A" (pos-x first-block-pos) (pos-y first-block-pos))))
 
 (defun solve-day ()
   (format t "part1: ~A~%" (part1 input-data))

tests/2024/day18-test.lisp

@@ -7,21 +7,39 @@
                                         ;:parent suite-2024
              )
 
-(define-test test-foo
+(define-test test-in-bounds-p
   :parent suite-2024-18
+  (true (in-bounds-p sample-data (make-pos :x 0 :y 0)))
+  (true (in-bounds-p sample-data (make-pos :x 6 :y 6)))
+  (true (in-bounds-p sample-data (make-pos :x 3 :y 3)))
+  (false (in-bounds-p sample-data (make-pos :x -1 :y 3)))
+  (false (in-bounds-p sample-data (make-pos :x 3 :y -1)))
+  (false (in-bounds-p sample-data (make-pos :x 7 :y 3)))
+  (false (in-bounds-p sample-data (make-pos :x 3 :y 7)))
   ) 
 
 
-(define-test test-bar
+(define-test test-next-moves
   :parent suite-2024-18
+
+  (is equalp (list
+	      (make-pos :x 0 :y 1)
+	      (make-pos :x 1 :y 0)
+	      )
+      (next-moves sample-data (make-pos :x 0 :y 0) 12))
+  (is equalp (list
+	      (make-pos :x 4 :y 0)
+	      (make-pos :x 3 :y 1)
+	      )
+      (next-moves sample-data (make-pos :x 4 :y 1) 12))
   )
 
 
 
 (define-test+run test-part1
   :parent suite-2024-18
-                 (is equal nil (part1 sample-data)))
+  (is equal "22" (part1 sample-data 12)))
 
 (define-test+run test-part2
   :parent suite-2024-18
-                 (is equal nil (part2 sample-data)))
+  (is equal "6,1" (part2 sample-data)))