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...# +########## + +^v>^vv^v>v<>v^v<<><>>v^v^>^<<<><^ +vvv<<^>^v^^><<>>><>^<<><^vv^^<>vvv<>><^^v>^>vv<>v<<<^<^^>>>^<>vv>v^v^<>><>>>><^^>vv>v<^^^>>v^v^<^^>v^^>v^<^v>v<>>v^v^v^^<^^vv< +<>^^^^>>>v^<>vvv^>^^^vv^^>v<^^^^v<>^>vvvv><>>v^<<^^^^^ +^><^><>>><>^^<<^^v>>><^^>v>>>^v><>^v><<<>vvvv>^<><<>^>< +^>><>^v<><^vvv<^^<><^v<<<><<<^^<^>>^<<<^>>^v^>>^v>vv>^<<^v<>><<><<>v<^vv<<<>^^v^>^^>>><<^v>>v^v><^^>>^<>vv^ +<><^^>^^^<>^vv<<^><<><<><<<^^<<<^<<>><<><^^^>^^<>^>v<> +^^>vv<^v^v^<>^^^>>>^^vvv^>vvv<>>>^<^>>>>>^<<^v>^vvv<>^<>< +v^^>>><<^^<>>^v^v^<<>^<^v^v><^<<<><<^vv>>v>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<<")) +(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)))