aboutsummaryrefslogtreecommitdiffstats
path: root/AoC2022/18/solver.lisp
blob: 91397ec53355792867a15c5d12ea30f992941322 (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
(ql:quickload '(fiveam uiop))

(defun distance-1 (a b)
  (apply #'+
         (mapcar (lambda (e1 e2)
                   (abs (- e1 e2))) a b)))

(fiveam:test distance
  (fiveam:for-all* ((n (fiveam:gen-integer :min 1 :max 10))
                    (a (fiveam:gen-list :length (lambda () n)))
                    (b (fiveam:gen-list :length (lambda () n)) (not (equal a b)))
                    (c (fiveam:gen-list :length (lambda () n))))
    (fiveam:is (zerop (distance-1 a a)))
    (fiveam:is (plusp (distance-1 a b)))
    (fiveam:is (= (distance-1 a b) (distance-1 b a)))
    (fiveam:is (<= (distance-1 a b) (+ (distance-1 a c) (distance-1 c b))))))

(defun surface (cubes)
  (loop for a in cubes
        sum (- 6 (loop for b in cubes
                       count (= 1 (distance-1 a b))))))

(defun parse-coords (filename)
  (mapcar (lambda (l)
            (mapcar #'parse-integer (uiop:split-string l :separator ",")))
          (uiop:read-file-lines filename)))

(defun bounding-corner (points edge)
  (reduce (lambda (edges point)
            (mapcar edge edges point))
          points))

(defun box-surface (min-point max-point)
  (* 2
     (loop for (a . rest) on (mapcar #'- max-point min-point)
           sum (loop for b in rest
                     sum (* a b)))))

(defconstant +neighbor-dirs+ '((1 0 0) (0 1 0) (0 0 1)
                               (-1 0 0) (0 -1 0) (0 0 -1)))

(defun spread-steam (next allowedp)
  (loop for dir in +neighbor-dirs+
        for nbg = (mapcar #'+ next dir)
        when (funcall allowedp nbg)
          collect nbg))

(defun available-p (cubes min-point max-point)
  (lambda (point)
    (and (every #'<= min-point point max-point)
         (not (member point cubes :test #'equal)))))

(defun fill-outside (queue outer-region cubes min-point max-point)
  (reduce (lambda (out voxel)
            (let ((next-queue (spread-steam voxel
                                            (available-p
                                             (append out cubes) min-point max-point))))
              (fill-outside next-queue
                            (append next-queue out)
                            cubes min-point max-point)))
          queue
          :initial-value outer-region))

(defun exterior-surface (cubes)
  (let* ((min (mapcar #'1- (bounding-corner cubes #'min)))
         (max (mapcar #'1+ (bounding-corner cubes #'max)))
         (outer (list min)))
    (- (surface
        (fill-outside outer outer cubes min max))
       (box-surface min (mapcar #'1+ max)))))


(fiveam:test solutions
  ;; part 1
  (fiveam:is (= 64 (surface (parse-coords "eg-in"))))
  (fiveam:is (= 4474 (surface (parse-coords "input"))))
  ;; part 2
  (fiveam:is (= 58 (exterior-surface (parse-coords "eg-in"))))
  (fiveam:is (= 2518 (exterior-surface (parse-coords "input")))))