diff --git a/src/2024/day13.lisp b/src/2024/day13.lisp index 880d300..df07ce4 100644 --- a/src/2024/day13.lisp +++ b/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 diff --git a/src/2024/day17.lisp b/src/2024/day17.lisp index 490fbd5..ef6926f 100644 --- a/src/2024/day17.lisp +++ b/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))) diff --git a/src/2024/day18.lisp b/src/2024/day18.lisp index e60c56d..f4a25c1 100644 --- a/src/2024/day18.lisp +++ b/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 "")) -(defparameter sample-data - (parse-input sample-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")) -(defun part1 (data) - (length data)) +(defparameter sample-data + (make-memory + :size 6 + :map (parse-input sample-text))) + +(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)) diff --git a/tests/2024/day18-test.lisp b/tests/2024/day18-test.lisp index 4730e2a..e60c8c8 100644 --- a/tests/2024/day18-test.lisp +++ b/tests/2024/day18-test.lisp @@ -7,21 +7,39 @@ ;:parent suite-2024 ) -(define-test test-foo - :parent suite-2024-18 - ) +(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 - :parent suite-2024-18 - ) +(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))) + :parent suite-2024-18 + (is equal "22" (part1 sample-data 12))) (define-test+run test-part2 - :parent suite-2024-18 - (is equal nil (part2 sample-data))) + :parent suite-2024-18 + (is equal "6,1" (part2 sample-data)))