From 9e01c019bf5511d861143077010392a9cfba9a7e Mon Sep 17 00:00:00 2001
From: Peter Tillemans <pti@snamellit.com>
Date: Sun, 15 Dec 2024 13:58:34 +0100
Subject: [PATCH] solved day 15
---
src/2024/day15.lisp | 199 +++++++++++++++++++++++++-
tests/2024/day15-test.lisp | 284 +++++++++++++++++++++++++++++++++++--
2 files changed, 465 insertions(+), 18 deletions(-)
diff --git a/src/2024/day15.lisp b/src/2024/day15.lisp
index b59e41c..f179b15 100644
--- a/src/2024/day15.lisp
+++ b/src/2024/day15.lisp
@@ -4,6 +4,17 @@
(:export
#:sample-data
#:sample-data2
+ #:parse-line
+ #:parse-input
+ #:make-pos
+ #:pos-x
+ #:pos-y
+ #:show-map
+ #:find-robot
+ #:move-robot
+ #:move-pos
+ #:big-warehouse
+ #:total-gps
#:part1
#:part2
))
@@ -12,24 +23,200 @@
(defun parse-line (line)
- line)
+ (coerce line 'list))
(defun parse-input (lines)
- (mapcar #'parse-line lines))
+ (let* ((rows (mapcar #'parse-line lines))
+ (split (position-if #'null rows)))
+ (cons
+ (make-array
+ `(,split ,(length (first rows)))
+ :initial-contents (subseq rows 0 split))
+ (reduce
+ (lambda (acc r)
+ (append acc (coerce r 'list)))
+ (subseq rows (1+ split)))
+ )))
(defparameter input-text (test-input 2024 15))
(defparameter input-data (parse-input input-text))
-(defparameter sample-text (aoc:split-lines ""))
+(defparameter sample-text (aoc:split-lines "##########
+#..O..O.O#
+#......O.#
+#.OO..O.O#
+#..O@..O.#
+#O#..O...#
+#O..O..O.#
+#.OO.O.OO#
+#....O...#
+##########
+
+<vv>^<v^>v>^vv^v>v<>v^v<v<^vv<<<^><<><>>v<vvv<>^v^>^<<<><<v<<<v^vv^v>^
+vvv<<^>^v^^><<>>><>^<<><^vv^^<>vvv<>><^^v>^>vv<>v<<<<v<^v>^<^^>>>^<v<v
+><>vv>v^v^<>><>>>><^^>vv>v<^^^>>v^v^<^^>v^^>v^<^v>v<>>v^v^<v>v^^<^^vv<
+<<v<^>>^^^^>>>v^<>vvv^><v<<<>^^^vv^<vvv>^>v<^^^^v<>^>vvvv><>>v^<<^^^^^
+^><^><>>><>^^<<^^v>>><^<v>^<vv>>v>>>^v><>^v><<<<v>>v<v<v>vvv>^<><<>^><
+^>><>^v<><^vvv<^^<><v<<<<<><^v<<<><<<^^<v<^^^><^>>^<v^><<<^>>^v<v^v<v^
+>^>>^v>vv>^<<^v<>><<><<v<<v><>v<^vv<<<>^^v^>^^>>><<^v>>v^v><^^>>^<>vv^
+<><^^>^^^<><vvvvv^v<v<<>^v<v>v<<^><<><<><<<^^<<<^<<>><<><^^^>^^<>^>v<>
+^^>vv<^v^v<vv>^<><v<^v>^^^>>>^^vvv^>vvv<>>>^<^>>>>>^<<^v>^vvv<>^<><<v>
+v^^>>><<^^<>>^v^<v^vv<>v^<<>^<^v^v><^<<<><<^<v><v<>vv>>v><v^<vv<>v^<<^"))
+
(defparameter sample-data
- (parse-input sample-text))
+ (parse-input sample-text))
+
+
+
+(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 pos-gps (pos)
+ (+ (* 100 (pos-y pos)) (pos-x 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 find-robot (map)
+ (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) #\@) 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 total-gps (map)
+ (loop
+ for row from 0 below (array-dimension map 0)
+ sum (loop
+ for col from 0 below (array-dimension map 1)
+ for p = (make-pos :x col :y row)
+ if (member (get-pos map p) '(#\O #\[))
+ sum (pos-gps p))))
+
+(defun merge-pushes (dir pa pb)
+ "remove duplicate swaps and return them in the right order"
+ (sort
+ (remove-duplicates (append pa pb) :test #'equalp)
+ (if (eq dir #\^) #'< #'>)
+ :key #'(lambda (p) (pos-y (cdr p)))))
+
+(defun try-move-pos (map pos dir &optional (swaps nil))
+ "return new position if valid otherwise nil. returns a list of swaps"
+ (let* ((np (pos-move pos dir))
+ (object (get-pos map pos)))
+ (ccase object
+ (#\# nil)
+ (#\. swaps)
+ (#\@ (try-move-pos map np dir (push (cons pos np) swaps)))
+ (#\O (try-move-pos map np dir (push (cons pos np) swaps)))
+ (#\[ (progn
+ (ccase dir
+ ((#\< #\>) (try-move-pos map np dir (push (cons pos np) swaps)))
+ ((#\^ #\v) (let* ((pos2 (make-pos :x (1+ (pos-x pos)) :y (pos-y pos)))
+ (np2 (make-pos :x (1+ (pos-x np)) :y (pos-y np)))
+ (push1 (try-move-pos map np dir (list (cons pos np))))
+ (push2 (try-move-pos map np2 dir (list (cons pos2 np2)))))
+ (if (and push1 push2)
+ (append
+ (merge-pushes dir push1 push2)
+ swaps
+ ))))
+ )))
+ (#\] (progn
+ (ccase dir
+ ((#\< #\>) (try-move-pos map np dir (push (cons pos np) swaps)))
+ ((#\^ #\v) (let* ((pos2 (make-pos :x (1- (pos-x pos)) :y (pos-y pos)))
+ (np2 (make-pos :x (1- (pos-x np)) :y (pos-y np)))
+ (push1 (try-move-pos map np dir (list (cons pos np))))
+ (push2 (try-move-pos map np2 dir (list (cons pos2 np2)))))
+ (if (and push1 push2)
+ (append
+ (merge-pushes dir push1 push2)
+ swaps
+ ))))
+ ))))))
+
+(defun move-pos (map pos dir)
+ (let ((swaps (try-move-pos map pos dir)))
+ (loop for swap in swaps
+ do (swap-pos map (car swap) (cdr swap)))
+ (and swaps (pos-move pos dir))))
+
+(defun move-robot (og-map moves)
+ (let ((map (copy-array og-map))
+ (robot (find-robot og-map)))
+ (loop for move in moves
+ for np = (move-pos map robot move)
+ if np
+ do (setf robot np))
+ map))
+
+(defun big-warehouse (sm)
+ (make-array
+ (list (array-dimension sm 1) (* 2 (array-dimension sm 0)))
+ :initial-contents
+ (loop for row from 0 below (array-dimension sm 1)
+ collect (loop
+ for col from 0 below (array-dimension sm 0)
+ append (case (aref sm row col)
+ (#\@ '(#\@ #\.))
+ (#\# '(#\# #\#))
+ (#\O '(#\[ #\]))
+ (#\. '(#\. #\.)))))))
+
+
+
+(defun solve-part1 (data)
+ (let ((map (car data))
+ (moves (cdr data)))
+ (total-gps (move-robot map moves))))
+
+(defun solve-part2 (data)
+ (let ((map (big-warehouse (car data)))
+ (moves (cdr data)))
+ (total-gps (move-robot map moves))))
(defun part1 (data)
- (length data))
+ (format nil "~A" (solve-part1 data)))
(defun part2 (data)
- (length data))
+ (format nil "~A" (solve-part2 data)))
(defun solve-day ()
(format t "part1: ~A~%" (part1 input-data))
diff --git a/tests/2024/day15-test.lisp b/tests/2024/day15-test.lisp
index d4dcff1..49667d0 100644
--- a/tests/2024/day15-test.lisp
+++ b/tests/2024/day15-test.lisp
@@ -1,27 +1,287 @@
(defpackage :aoc/2024/15/tests
- (:use :cl :aoc :aoc/tests :aoc/2024/tests :parachute :aoc/2024/15))
+ (:use :cl :aoc :aoc/tests :aoc/2024/tests :parachute :aoc/2024/15
+ ))
(in-package :aoc/2024/15/tests)
+
+(defparameter test-text (aoc:split-lines "########
+#..O.O.#
+##@.O..#
+#...O..#
+#.#.O..#
+#...O..#
+#......#
+########
+
+<^^>>>vv<v>>v<<"))
+(defparameter test-data (parse-input test-text))
+
+
(define-test suite-2024-15
;:parent suite-2024
- )
+ )
+
+(define-test test-find-robot
+ :parent suite-2024-15
+ (is equalp (make-pos :x 2 :y 2) (find-robot (first test-data)))
+ (is equalp (make-pos :x 4 :y 4) (find-robot (first sample-data))))
+
+
+(defparameter map1 "########
+#..O.O.#
+##@.O..#
+#...O..#
+#.#.O..#
+#...O..#
+#......#
+########
+")
+
+(defparameter final-sample-map "##########
+#.O.O.OOO#
+#........#
+#OO......#
+#OO@.....#
+#O#.....O#
+#O.....OO#
+#O.....OO#
+#OO....OO#
+##########
+")
+
+(define-test test-move-robot
+ :parent suite-2024-15
+ (is equal map1 (let ((map (car test-data)))
+ (move-robot map (subseq (cdr test-data) 0 1))
+ (show-map map nil)))
+ (is equal final-sample-map
+ (let* ((initial (car sample-data))
+ (actual (move-robot initial (cdr sample-data))))
+ (show-map actual nil)))
+ )
+
+;;; -------------- Part 2 ---------------------
+
+(defparameter s2-text (aoc:split-lines "Initial state:
+##############
+##......##..##
+##..........##
+##....[][]@.##
+##....[]....##
+##..........##
+##############
+
+Move <:
+##############
+##......##..##
+##..........##
+##...[][]@..##
+##....[]....##
+##..........##
+##############
+
+Move v:
+##############
+##......##..##
+##..........##
+##...[][]...##
+##....[].@..##
+##..........##
+##############
+
+Move v:
+##############
+##......##..##
+##..........##
+##...[][]...##
+##....[]....##
+##.......@..##
+##############
+
+Move <:
+##############
+##......##..##
+##..........##
+##...[][]...##
+##....[]....##
+##......@...##
+##############
+
+Move <:
+##############
+##......##..##
+##..........##
+##...[][]...##
+##....[]....##
+##.....@....##
+##############
+
+Move ^:
+##############
+##......##..##
+##...[][]...##
+##....[]....##
+##.....@....##
+##..........##
+##############
+
+Move ^:
+##############
+##......##..##
+##...[][]...##
+##....[]....##
+##.....@....##
+##..........##
+##############
+
+Move <:
+##############
+##......##..##
+##...[][]...##
+##....[]....##
+##....@.....##
+##..........##
+##############
+
+Move <:
+##############
+##......##..##
+##...[][]...##
+##....[]....##
+##...@......##
+##..........##
+##############
+
+Move ^:
+##############
+##......##..##
+##...[][]...##
+##...@[]....##
+##..........##
+##..........##
+##############
+
+Move ^:
+##############
+##...[].##..##
+##...@.[]...##
+##....[]....##
+##..........##
+##..........##
+##############"))
+
+(defun parse-s2 (lines &optional (rslt))
+ (if (null lines)
+ (reverse rslt)
+ (let* ((move (ppcre:register-groups-bind (s) ("Move (.):" (car lines) ) (and s (char s 0))))
+
+ (split (or (position-if #'alexandria:emptyp lines) (length lines)))
+ (rows (mapcar #'parse-line (subseq lines 1 split)))
+ (dims (list (1- split) (length (first rows)))))
+ (parse-s2
+ (subseq lines (min (1+ split) (length lines)) (length lines))
+ (push (cons move (make-array dims :initial-contents rows)) rslt)))))
+
+(defparameter s2-data
+ (parse-s2 s2-text))
+
+
+(defparameter test-sample2-final
+ (let* ((rows (mapcar #'parse-line (aoc:split-lines "####################
+##[].......[].[][]##
+##[]...........[].##
+##[]........[][][]##
+##[]......[]....[]##
+##..##......[]....##
+##..[]............##
+##..@......[].[][]##
+##......[][]..[]..##
+####################")))
+ (dims (list (length rows) (length (first rows)))))
+ (make-array dims :initial-contents rows)))
+
+
+(defparameter tc-data-test (aoc:split-lines "Initial state:
+####################
+##....[]....[]..[]##
+##............[]..##
+##..[][]....[]..[]##
+##...[].......[]..##
+##[]##....[]......##
+##[]......[]..[]..##
+##..[][]..@[].[][]##
+##........[]......##
+####################
+
+Move ^:
+####################
+##....[]....[]..[]##
+##............[]..##
+##..[][]....[]..[]##
+##...[]...[]..[]..##
+##[]##....[]......##
+##[]......@...[]..##
+##..[][]...[].[][]##
+##........[]......##
+####################
+"))
+
+
+(define-test test-move-robot-2
+ (let ((last-map nil))
+ (loop
+ for test-case in (parse-s2 s2-text)
+ for move = (car test-case)
+ for expected-map = (cdr test-case)
+ if move
+ do (let* ((robot (find-robot last-map)))
+ (move-pos last-map robot move)
+ (is equalp expected-map last-map)
+ (setf last-map expected-map) ; reset to expected for next tests
+ )
+ do (setf last-map expected-map)
+ ))
+
+
+ )
+
+(define-test test-tc
+ :parent suite-2024-15
+ (let ((last-map nil))
+ (loop
+ for test-case in (parse-s2 tc-data-test)
+ for move = (car test-case)
+ for expected-map = (cdr test-case)
+ if move
+ do (let* ((robot (find-robot last-map)))
+ (format t "start~%")
+ (show-map last-map t)
+ (move-pos last-map robot move)
+ (format t "expected~%")
+ (show-map expected-map t)
+ (format t "actual~%")
+ (show-map last-map t) (is equalp expected-map last-map)
+ )
+ do (setf last-map expected-map)
+ )))
+
+(define-test test-sample-2
+ :parent suite-2024-15
+ (let ((actual (move-robot (big-warehouse (car sample-data)) (cdr sample-data)))) ()
+
+ (format t "expected:~A~%actual :~A~%" test-sample2-final actual)
+ (is equalp test-sample2-final actual)))
-(define-test test-foo
- :parent suite-2024-15
- )
-(define-test test-bar
- :parent suite-2024-15
- )
(define-test+run test-part1
- :parent suite-2024-15
- (is equal nil (part1 sample-data)))
+ :parent suite-2024-15
+ (is equal "10092" (part1 sample-data)))
(define-test+run test-part2
- :parent suite-2024-15
- (is equal nil (part2 sample-data)))
+ :parent suite-2024-15
+ (is equal "9021" (part2 sample-data)))