From 8cd8a952967e7465753c173dbfbbf906b8b58370 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
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(-)
(limited to 'AoC2022')
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