commit - f379ab53ea1596b4051f8162e1df4a267c92e47d
commit + c3dc0bc1b9d10e1cb15b5e7b3de92896523afbb5
blob - cdc218e1f7503f21d26b948ae8e92aff9766c49b
blob + eb6aa41de116b76751c296c92e52e2364779df10
--- src/day-14.lisp
+++ src/day-14.lisp
@@ -3,21 +3,86 @@
   (:export #:day-14))
 (in-package #:aoc/day-14)
 
-(defun slide-rock (map pos)
-  (loop for y from (1- (point-y pos)) downto 0
-        for cell = (map-cell map (cons (point-x pos) y))
-        while (char= cell #\.)
-        finally (setf (map-cell map pos) #\.
-                      (map-cell map (cons (point-x pos) (1+ y))) #\O)))
+(defun point-x-constructor (y)
+  (lambda (x)
+    (cons x y)))
 
-(defun slide-rocks (map)
-  (loop for y from 0 below (input-map-height map)
-        do (loop for x from 0 below (input-map-height map)
-                 for pos = (cons x y)
-                 for cell = (map-cell map pos)
-                 when (char= cell #\O)
-                   do (slide-rock map pos))))
+(defun point-y-constructor (x)
+  (lambda (y)
+    (cons x y)))
 
+(defun make-in-range-p (to)
+  (lambda (i)
+    (and (>= i 0)
+         (< i to))))
+
+(defun slide-rock-direction-configuration (map point direction)
+  (ecase direction
+    (:north
+     (values (1- (point-y point))
+             #'1- #'1+
+             (make-in-range-p (input-map-height map))
+             (point-y-constructor (point-x point))))
+    (:west
+     (values (1- (point-x point))
+             #'1- #'1+
+             (make-in-range-p (input-map-width map))
+             (point-x-constructor (point-y point))))
+    (:south
+     (values (1+ (point-y point))
+             #'1+ #'1-
+             (make-in-range-p (input-map-height map))
+             (point-y-constructor (point-x point))))
+    (:east
+     (values (1+ (point-x point))
+             #'1+ #'1-
+             (make-in-range-p (input-map-width map))
+             (point-x-constructor (point-y point))))))
+
+(defun slide-rock (map pos direction)
+  (multiple-value-bind (start-pos by final in-range-p make-point)
+      (slide-rock-direction-configuration map pos direction)
+    (loop for i = start-pos then (funcall by i)
+          while (funcall in-range-p i)
+          for cell = (map-cell map (funcall make-point i))
+          while (char= cell #\.)
+          finally (setf (map-cell map pos) #\.
+                        (map-cell map (funcall make-point (funcall final i))) #\O))))
+
+(defun slide-direction-configuration (map direction)
+  (ecase direction
+    (:north
+     (values 0 #'1+
+             (curry #'> (input-map-height map)) (input-map-width map)
+             (lambda (d-1 d-2)
+               (cons d-2 d-1))))
+    (:west
+     (values 0 #'1+
+             (curry #'> (input-map-width map)) (input-map-height map)
+             (lambda (d-1 d-2)
+               (cons d-1 d-2))))
+    (:south
+     (values (1- (input-map-height map)) #'1-
+             (curry #'<= 0) (input-map-width map)
+             (lambda (d-1 d-2)
+               (cons d-2 d-1))))
+    (:east
+     (values (1- (input-map-width map)) #'1-
+             (curry #'<= 0) (input-map-height map)
+             (lambda (d-1 d-2)
+               (cons d-1 d-2))))))
+
+(defun slide-rocks (map direction)
+  (multiple-value-bind (d-1-from d-1-by d-1-while-p d-2-below make-point)
+      (slide-direction-configuration map direction)
+    (loop for d-1 = d-1-from then (funcall d-1-by d-1)
+          while (funcall d-1-while-p d-1)
+          do (loop for d-2 from 0 below d-2-below
+                   for pos = (funcall make-point d-1 d-2)
+                   for cell = (map-cell map pos)
+                   when (char= cell #\O)
+                     do (slide-rock map pos direction)))))
+
 (defun total-load (map)
   (loop for y from 0 below (input-map-height map)
         for load-multiplier downfrom (input-map-height map)
@@ -27,5 +92,5 @@
 
 (defun day-14 (input)
   (let ((map (make-map input)))
-    (slide-rocks map)
+    (slide-rocks map :north)
     (total-load map)))