From 72e1b88b459218b88a9b843bb2ec7eb2d935df9a Mon Sep 17 00:00:00 2001
From: Peter Tillemans <pti@snamellit.com>
Date: Wed, 18 Dec 2024 08:28:34 +0100
Subject: [PATCH] solved day 18
---
src/2024/day13.lisp | 2 +-
src/2024/day17.lisp | 9 +-
src/2024/day18.lisp | 190 +++++++++++++++++++++++++++++++++++--
tests/2024/day18-test.lisp | 38 ++++++--
4 files changed, 210 insertions(+), 29 deletions(-)
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)))