Finished round 2 of puzzle-8

2 files changed, 44 insertions, 7 deletions

diff --git a/2022/lib.lisp b/2022/lib.lisp
index 2441481..1d81219 100644
--- a/2022/lib.lisp
+++ b/2022/lib.lisp
@@ -27,6 +27,8 @@
           while line
           collect line)))
 
+(defun id (x) x)
+
 (defun all (pred lst)
   (if (not (cdr lst))
       (funcall pred (car lst))
diff --git a/2022/puzzle-8.lisp b/2022/puzzle-8.lisp
index 38c5421..85fd1ae 100644
--- a/2022/puzzle-8.lisp
+++ b/2022/puzzle-8.lisp
@@ -18,6 +18,9 @@
 (defun get-tree (x y)
   (nth x (nth y trees)))
 
+(defun at-end? (a)
+  (or (= a 0) (= a (- n-trees))))
+
 (defun is-visible? (x y)
   (if (or (= x 0) (= x (- n-trees 1))
          (= y 0) (= y (- n-trees 1)))
@@ -30,23 +33,55 @@
              (col (get-column x))
              (col-top (subseq col 0 y))
              (col-bottom (subseq col (+ y 1))))
-        (or
-         (all lt-tree? row-left)
-         (all lt-tree? row-right)
-         (all lt-tree? col-top)
-         (all lt-tree? col-bottom)))))
+        (some #'id
+              (mapcar (lambda (x) (all lt-tree? x))
+                 (list row-left row-right col-top col-bottom))))))
 
 (defun how-many-visible ()
   (loop
-    for x from 0 to (- n-trees 1)
+    for x from 0 below n-trees
     sum
     (reduce
      #'+
      (loop
-       for y from 0 to (- n-trees 1)
+       for y from 0 below n-trees
        if (is-visible? x y)
          collect 1
        else
          collect 0))))
 
 (format t "round 1: ~s~%" (how-many-visible))
+
+(defun keep-till-last-satisfying (pred lst &optional acc)
+  "Iteratively collect all items of LST that satisfy PRED, including the
+first member which does not satisfy PRED."
+  (cond
+    ((null lst) acc)
+    ((not (funcall pred (car lst)))
+     (cons (car lst) acc))
+    (t
+     (keep-till-last-satisfying pred (cdr lst) (cons (car lst) acc)))))
+
+(defun scenic-score (x y)
+  "Calculate the scenic score of the tree at position X, Y."
+  (let* ((tree (get-tree x y))
+         (lt-tree? (lambda (a) (< a tree)))
+         (row (get-row y))
+         (row-left (reverse (subseq row 0 x)))
+         (row-right (subseq row (+ x 1)))
+         (col (get-column x))
+         (col-top (reverse (subseq col 0 y)))
+         (col-bottom (subseq col (+ y 1))))
+    (reduce #'*
+            (mapcar (lambda (x) (length (keep-till-last-satisfying lt-tree? x)))
+               (list row-left row-right col-top col-bottom)))))
+
+(format t "round 2: ~s~%"
+        (car (sort
+              ;; Calculate all scenic scores
+              (loop for x from 0 below n-trees
+                    nconcing
+                    (loop for y from 0 below n-trees
+                          collect
+                          (scenic-score x y)))
+              #'>)))