From 8cd8a952967e7465753c173dbfbbf906b8b58370 Mon Sep 17 00:00:00 2001 From: Oscar Najera Date: Tue, 13 Dec 2022 21:12:25 +0100 Subject: CL line of sight function refactor --- AoC2022/08/solver.lisp | 71 ++++++++++++++++---------------------------------- 1 file changed, 23 insertions(+), 48 deletions(-) diff --git a/AoC2022/08/solver.lisp b/AoC2022/08/solver.lisp index 9f5c754..05353f0 100644 --- a/AoC2022/08/solver.lisp +++ b/AoC2022/08/solver.lisp @@ -1,10 +1,11 @@ (ql:quickload '(fiveam uiop arrows)) -(defun coord-x-minor (width height) - (lambda (x y) - (when (and (< -1 x width) - (< -1 y height)) - (+ x (* y width))))) +(defun line-of-sight (direction p width height) + (case direction + (right (loop for l from (1+ p) below (* width (1+ (floor p width))) collect l)) + (left (loop for l downfrom (1- p) to (* width (floor p width)) collect l)) + (bottom (loop for l from (+ p width) below (* width height) by width collect l)) + (top (loop for l downfrom (- p width) to 0 by width collect l)))) (defun forest (data) (let ((width (length (car data))) @@ -14,54 +15,28 @@ (lambda (x) (- (char-code x) 48)) (apply #'concatenate 'string data))))) -(defun line-of-sight (direction x y width height) - (let ((location (coord-x-minor width height))) - (case direction - (right (loop for l from (1+ x) below width collect (funcall location l y))) - (bottom (loop for l from (1+ y) below height collect (funcall location x l))) - (left (loop for l downfrom (1- x) to 0 collect (funcall location l y))) - (top (loop for l downfrom (1- y) to 0 collect (funcall location x l)))))) - (defun solver-p1 (filename) (multiple-value-bind (width height forest-arr) (forest (uiop:read-file-lines filename)) - (let ((visibility-mask (make-array (* width height) :initial-element nil)) - (location-x (coord-x-minor width height))) - (flet ((toggle-visibility (major minor location reverse) - (let ((range (if reverse - (loop for i downfrom (1- minor) to 0 collect i) - (loop for i below minor collect i)))) - (dotimes (m major) - (loop - for n in range - for maxh = -1 then (max maxh tree-height) - for tree-height = (aref forest-arr (funcall location n m)) - when (> tree-height maxh) - do (setf (aref visibility-mask (funcall location n m)) t))))) - (location-y (y x) (funcall location-x x y))) - (toggle-visibility height width location-x nil) - (toggle-visibility height width location-x t) - (toggle-visibility width height #'location-y nil) - (toggle-visibility width height #'location-y t)) - (loop for v across visibility-mask counting v)))) + (loop for base across forest-arr + and p from 0 + count (some (lambda (direction) + (loop for l in (line-of-sight direction p width height) + for tree-height = (aref forest-arr l) + always (< tree-height base))) + '(right left top bottom))))) (defun solver-p2 (filename) (multiple-value-bind (width height forest-arr) (forest (uiop:read-file-lines filename)) - (let ((score (make-array (* width height))) - (location-x (coord-x-minor width height))) - - (flet ((score-direction (base dir) - (loop for l in dir - for tree-height = (aref forest-arr l) - count l until (>= tree-height base)))) - (dotimes (y height) - (dotimes (x width) - (let ((base (aref forest-arr (funcall location-x x y)))) - (arrows:->> '(right left top bottom) - (mapcar (lambda (direction) - (score-direction base (line-of-sight direction x y width height)))) - (apply #'* ) - (setf (aref score (funcall location-x x y))))))) - (loop for v across score maximize v))))) + (flet ((score-direction (base dir) + (loop for l in dir + for tree-height = (aref forest-arr l) + count l until (>= tree-height base)))) + (loop for base across forest-arr + and p from 0 + maximize (arrows:->> '(right left top bottom) + (mapcar (lambda (direction) + (score-direction base (line-of-sight direction p width height)))) + (apply #'* )))))) (fiveam:test solutions (fiveam:is (= 21 (solver-p1 "eg-in"))) -- cgit v1.2.3