commit c3dc0bc1b9d10e1cb15b5e7b3de92896523afbb5 parent f379ab53ea1596b4051f8162e1df4a267c92e47d Author: Lukas Henkel <lh@entf.net> Date: Thu, 14 Dec 2023 06:42:52 +0100 Abstracted sliding Diffstat:
| M | src/day-14.lisp | | | 95 | ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------- |
1 file changed, 80 insertions(+), 15 deletions(-)
diff --git a/src/day-14.lisp b/src/day-14.lisp @@ -3,20 +3,85 @@ (: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 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-x-constructor (y) + (lambda (x) + (cons x y))) + +(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) @@ -27,5 +92,5 @@ (defun day-14 (input) (let ((map (make-map input))) - (slide-rocks map) + (slide-rocks map :north) (total-load map)))