Finished round 2 of puzzle-8

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))

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
+        (some #'id
-         (all lt-tree? row-left)
+              (mapcar (lambda (x) (all lt-tree? x))
-         (all lt-tree? row-right)
+                 (list row-left row-right col-top col-bottom))))))
-         (all lt-tree? col-top)
-         (all lt-tree? 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)))
+              #'>)))