diff options
| -rw-r--r-- | 2022/lib.lisp | 2 | ||||
| -rw-r--r-- | 2022/puzzle-8.lisp | 49 |
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))) + #'>))) |