solved day 15
This commit is contained in:
parent
1371a5e368
commit
9e01c019bf
2 changed files with 465 additions and 18 deletions
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue