diff --git a/aoc.asd b/aoc.asd index 9e3e6c2..8d17487 100644 --- a/aoc.asd +++ b/aoc.asd @@ -27,6 +27,7 @@ :components ((:module "src" :components ((:file "main") + (:file "maze") (:file "2018/day06") (:file "2018/day07") (:file "2024/day01") @@ -49,6 +50,7 @@ (:file "2024/day18") (:file "2024/day19") (:file "2024/day20") + (:file "2024/day21") ))) :description "Advent of Code challenges and solutions." :long-description "Solutions for the AOC challenges." @@ -85,6 +87,7 @@ (:file "2024/day18-test") (:file "2024/day19-test") (:file "2024/day20-test") + (:file "2024/day21-test") ))) :description "Test system for aoc" :perform (test-op (op c) (symbol-call :parachute :test :aoc/tests))) diff --git a/src/2024/day16.lisp b/src/2024/day16.lisp index 10957de..1981c73 100644 --- a/src/2024/day16.lisp +++ b/src/2024/day16.lisp @@ -1,6 +1,5 @@ - (defpackage :aoc/2024/16 - (:use :cl :aoc :alexandria :trivia :lla :queues) + (:use :cl :aoc :aoc/maze :alexandria :trivia :lla :queues) (:export #:parse-input #:best-score @@ -42,86 +41,10 @@ #S..#.....#...# ###############")) -(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 find-tile (map char) - (let ((w (array-dimension map 1)) - (h (array-dimension map 0))) - (loop - for row from 0 below h - for col = (loop - for col from 0 below w - if (eq (aref map row col) char) return col) - if col - return (make-pos :x col :y row) - ))) - -(defun swap-pos (map p np) - "swaps content of map. returns np" - (let ((o (get-pos map p))) - (setf (aref map (pos-y p) (pos-x p)) (get-pos map np)) - (setf (aref map (pos-y np) (pos-x np)) o) - np)) - - -(defun wet-finger-distance (a b) - "estimate the distance" - (+ - (abs (- (pos-x a) (pos-x b))) - (abs (- (pos-y a) (pos-y b))) - (and - (eq (pos-x a) (pos-x b)) - (eq (pos-y a) (pos-y b)) - 1000))) - -(defun rotate-left (dir) - (case dir - (#\^ #\<) - (#\v #\>) - (#\< #\v) - (#\> #\^) - )) -(defun rotate-right (dir) - (case dir - (#\^ #\>) - (#\v #\<) - (#\< #\^) - (#\> #\v) - )) - (defun valid-pos-p (map pos) (not (eq #\# (get-pos map pos)))) -(defstruct reindeer pos dir) +(defstruct reindeer pos (dir #\>)) (defstruct state path score) @@ -136,59 +59,34 @@ (cons (make-reindeer :pos p :dir (rotate-left d)) 1000) (cons (make-reindeer :pos p :dir (rotate-right d)) 1000))))) - -(defun distance-estimate-f (finish) +(defun heuristic (x finish) "estimate the distance for a reindeer from given finish" - (let ((a finish)) - (lambda (reindeer) - (let ((b (reindeer-pos reindeer) )) - (+ - (abs (- (pos-x a) (pos-x b))) - (abs (- (pos-y a) (pos-y b))) - (if (or - (eq (pos-x a) (pos-x b)) - (eq (pos-y a) (pos-y b))) - 0 - 1000)))))) - -(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)))))))) + (let* ((a (reindeer-pos finish)) + (b (reindeer-pos x))) + (+ + (manhattan-distance a b) + (if (or + (eq (pos-x a) (pos-x b)) + (eq (pos-y a) (pos-y b))) + 0 + 1000)))) (defun best-path (map) - (let* ((start (find-tile map #\S)) - (finish (find-tile map #\E)) - (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 (make-reindeer :pos start :dir #\>)) - :score 0)) - (loop - for s = (qpop todo) - until (or - (null s) - (equalp (reindeer-pos (first (state-path s))) finish)) - finally (return s) - do (loop - for next in (next-moves map (first (state-path s))) - for score = (+ (state-score s) (cdr next)) - if (> (gethash (car next) best 1000000000) score) - do (progn - (qpush todo - (make-state - :path (cons (car next) (state-path s)) - :score score)) - (setf (gethash (car next) best) score))) - - ))) + (let* ((start (make-reindeer :pos (find-tile map #\S))) + (finish (make-reindeer :pos (find-tile map #\E))) + (path-finder (make-a-star + #'next-moves + #'heuristic + :finished-p (lambda (a b) + (equalp + (reindeer-pos a) + (reindeer-pos b))) + ))) + (funcall path-finder map start finish)) + ) (defun best-score (map) - (state-score (best-path map))) + (caar (best-path map))) (defparameter sample-data (parse-input sample-text)) diff --git a/src/2024/day17.lisp b/src/2024/day17.lisp index ef6926f..16a544f 100644 --- a/src/2024/day17.lisp +++ b/src/2024/day17.lisp @@ -198,7 +198,7 @@ Program: 0,1,5,4,3,0")) -(defun disassemble (cpu) +(defun my-disassemble (cpu) (let ((program (cpu-mem cpu)) (cpu (copy-cpu cpu))) (loop diff --git a/src/2024/day18.lisp b/src/2024/day18.lisp index 093efcd..b02d79e 100644 --- a/src/2024/day18.lisp +++ b/src/2024/day18.lisp @@ -1,38 +1,17 @@ (defpackage :aoc/2024/18 - (:use :cl :aoc :alexandria :trivia :lla :queues) + (:use :cl :aoc :aoc/maze :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 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) (let ((p (mapcar #'parse-integer (ppcre:split "," line)))) (make-pos :x (first p) :y (second p)))) @@ -104,56 +83,19 @@ (< 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))) - - ))) + (let ((start (make-pos :x 0 :y 0)) + (finish (make-pos :x (memory-size map) :y (memory-size map))) + (path-finder (make-a-star + #'(lambda (map pos) (loop + for p in (next-moves map pos time) + collect (cons p 1))) + #'manhattan-distance))) + (funcall path-finder map start finish))) (defun solve-part1 (data time) (let ((path (best-path data time))) - (state-score path)) + (caar path)) ) (defun part1 (data &optional (time 1024)) diff --git a/src/2024/day20.lisp b/src/2024/day20.lisp index 9ce7ea4..7ad5228 100644 --- a/src/2024/day20.lisp +++ b/src/2024/day20.lisp @@ -1,6 +1,6 @@ (defpackage :aoc/2024/20 - (:use :cl :aoc :alexandria :trivia :lla) + (:use :cl :aoc :aoc/maze :alexandria :trivia :lla) (:export #:sample-data #:sample-data2 @@ -11,25 +11,82 @@ (in-package :aoc/2024/20) -(defun parse-line (line) - line) - - -(defun parse-input (lines) - (mapcar #'parse-line lines)) - (defparameter input-text (test-input 2024 20)) -(defparameter input-data (parse-input input-text)) +(defparameter input-data (parse-maze input-text)) -(defparameter sample-text (aoc:split-lines "")) +(defparameter sample-text (aoc:split-lines "############### +#...#...#.....# +#.#.#.#.#.###.# +#S#...#.#.#...# +#######.#.#.### +#######.#.#...# +#######.#.###.# +###..E#...#...# +###.#######.### +#...###...#...# +#.#####.#.###.# +#.#...#.#.#...# +#.#.#.#.#.#.### +#...#...#...### +############### +")) (defparameter sample-data - (parse-input sample-text)) + (parse-maze sample-text)) -(defun part1 (data) - (length data)) -(defun part2 (data) - (length data)) +(defun next-moves (map pos) + "return conses of next pos and cost" + (loop for d in '(#\^ #\v #\> #\<) + for p = (pos-move pos d) + if (and + (array-in-bounds-p map (pos-x p) (pos-y p)) + (not (eq #\# (aref map (pos-y p) (pos-x p))))) + collect (cons p 1))) + +(defun best-path (map) + (let* ((start (find-tile map #\S)) + (finish (find-tile map #\E)) + (pathfinder (make-a-star #'next-moves + #'manhattan-distance)) + ) + (funcall pathfinder map start finish))) + + +(defun find-shortcuts (map &optional (max-distance 2)) + (let ((path (best-path map))) + (loop + for s1 in path + append (loop + for s2 in path + for dist = (manhattan-distance (cdr s1) (cdr s2)) + for saving = (- (car s2) (car s1) dist) + if (and + (plusp saving) + (<= dist max-distance)) + collect (list saving (cdr s1) (cdr s2)))))) + +(defun count-sc-groups (shortcuts &optional (min-savings)) + ;; present results to make it easy to compare to challenge + (let ((count-map (make-hash-table))) + (loop + for s in shortcuts + do (incf (gethash (first s) count-map 0))) + (sort + (loop + for k being the hash-keys in count-map + for v being the hash-values in count-map + if (>= k min-savings) + collect (cons k v) + ) + #'(lambda (a b) (< (car a) (car b))) + ))) + + +(defun part1 (map) + (loop for sc in (find-shortcuts map) count (>= (car sc) 100) )) + +(defun part2 (map) + (loop for sc in (find-shortcuts map 20) count (>= (car sc) 100) )) (defun solve-day () (format t "part1: ~A~%" (part1 input-data)) diff --git a/src/maze.lisp b/src/maze.lisp new file mode 100644 index 0000000..1e62aef --- /dev/null +++ b/src/maze.lisp @@ -0,0 +1,160 @@ +(defpackage :aoc/maze + (:use :cl :alexandria :trivia :lla :queues) + (:export + #:parse-maze + #:make-a-star + #:pos + #:make-pos + #:pos-x + #:pos-y + #:pos-move + #:show-map + #:get-pos + #:set-pos + #:find-tile + #:manhattan-distance + )) + +(in-package :aoc/maze) + +(defun parse-line (line) + (coerce line 'list)) + + +(defun parse-maze (lines) + (make-array + (list (length lines) (length (first lines))) + :initial-contents (mapcar #'parse-line lines))) + +(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 find-tile (map char) + (let ((w (array-dimension map 1)) + (h (array-dimension map 0))) + (loop + for row from 0 below h + for col = (loop + for col from 0 below w + if (eq (aref map row col) char) return col) + if col + return (make-pos :x col :y row) + ))) + +(defun swap-pos (map p np) + "swaps content of map. returns np" + (let ((o (get-pos map p))) + (setf (aref map (pos-y p) (pos-x p)) (get-pos map np)) + (setf (aref map (pos-y np) (pos-x np)) o) + np)) + + +(defun manhattan-distance (a b) + "estimate the distance" + (+ + (abs (- (pos-x a) (pos-x b))) + (abs (- (pos-y a) (pos-y b))) + )) + +(defun rotate-left (dir) + (case dir + (#\^ #\<) + (#\v #\>) + (#\< #\v) + (#\> #\^) + )) +(defun rotate-right (dir) + (case dir + (#\^ #\>) + (#\v #\<) + (#\< #\^) + (#\> #\v) + )) + +(defun state-score (s) + (caar s)) + +(defun state-x (s) + (cdar s)) + +(defun make-a-star (next-moves heuristic &key (finished-p #'equalp)) + (lambda (map start finish) + (defun state-less-p (s1 s2) + (< (+ (state-score s1) + (funcall heuristic (state-x s1) finish)) + (+ (state-score s2) + (funcall heuristic (state-x s2) finish)))) + (let* ((best (make-hash-table :test #'equalp)) + (todo (queues:make-queue :priority-queue :compare #'state-less-p))) + (queues:qpush todo (list (cons 0 start))) + (loop + for s = (queues:qpop todo) + until (or + (null s) + (funcall finished-p (state-x s) finish)) + finally (return s) + do (loop + for next in (funcall next-moves map (state-x s)) + for score = (+ (state-score s) (cdr next)) + for next-x = (car next) + if (> (gethash next-x best 1000000000) score) + do (progn + (queues:qpush todo (cons (cons score next-x) s)) + (setf (gethash next-x best) score))) + + )))) + +(defun make-a-star-all-best-paths (next-moves heuristic &key (finished-p #'equalp)) + (lambda (map start finish) + (defun state-less-p (s1 s2) + (< (+ (state-score s1) + (funcall heuristic (state-x s1) finish)) + (+ (state-score s2) + (funcall heuristic (state-x s2) finish)))) + (let* ((best (make-hash-table :test #'equalp)) + (todo (queues:make-queue :priority-queue :compare #'state-less-p))) + (queues:qpush todo (list (cons 0 start))) + (loop + for s = (queues:qpop todo) + until (or + (null s) + (funcall finished-p (state-x s) finish)) + finally (return s) + do (loop + for next in (funcall next-moves map (state-x s)) + for score = (+ (state-score s) (cdr next)) + for next-x = (car next) + if (>= (gethash next-x best 1000000000) score) + do (progn + (queues:qpush todo (cons (cons score next-x) s)) + (setf (gethash next-x best) score))) + + ))))