aboutsummaryrefslogtreecommitdiff
path: root/2022/puzzle-8.lisp
blob: 85fd1aeaf12f9ef14eaa088c4e9d090eb0a2f183 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
(load "lib")
(defparameter input (uiop:read-file-string "8-input"))
(defparameter lines (get-lines input))
;; Just converts every line into a sequence of integral digits
(defparameter trees
  (mapcar (lambda (line) (mapcar (lambda (char) (parse-integer (string char))) (string-to-clist line)))
     lines))
;; Size of a row or column
(defparameter n-trees (length trees))

(defun get-column (x)
  (loop for row in trees
        collect (nth x row)))

(defun get-row (y)
  (nth y trees))

(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)))
      t
      (let* ((tree (get-tree x y))
             (lt-tree? (lambda (a) (< a tree)))
             (row (get-row y))
             (row-left (subseq row 0 x))
             (row-right (subseq row (+ x 1)))
             (col (get-column x))
             (col-top (subseq col 0 y))
             (col-bottom (subseq col (+ y 1))))
        (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 below n-trees
    sum
    (reduce
     #'+
     (loop
       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)))
              #'>)))