solved day 15

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))
 
+
+
+(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))

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-foo
+(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)))) 
 
 
-(define-test test-bar
+(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+run test-part1
   :parent suite-2024-15
-                 (is equal nil (part1 sample-data)))
+  (is equal "10092" (part1 sample-data)))
 
 (define-test+run test-part2
   :parent suite-2024-15
-                 (is equal nil (part2 sample-data)))
+  (is equal "9021" (part2 sample-data)))