aboutsummaryrefslogtreecommitdiff
path: root/puzzle-4.lisp
blob: be842d34ad9ef3bf874ab87fa9fbaa49dfa3271c (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
;; Example input: a-b,c-d which denotes [a,b] and [c,d]

;; We want to find if [c,d] < [a,b] or vice versa (complete inclusion)
;; and since we're working with integers, it's simply checking if the
;; bounds are included i.e. c in [a,b] and d in [a,b]

(defvar input (uiop:read-file-string "puzzle-4-input.txt"))

(defun parse-bound (str)
  "Given STR=\"a-b\" return (a b)"
  (let* ((sep (search "-" str))
         (first (subseq str 0 sep))
         (second (subseq str (+ sep 1))))
    (list (parse-integer first) (parse-integer second))))

(defvar completed-parse
  (with-input-from-string (s input)
    (loop for line = (read-line s nil)
          until (null line)
          collect
          ;; given a-b,c-d we want ((a b) (c d))
          (let* ((sep (search "," line))
                 (first-bound (subseq line 0 sep))
                 (second-bound (subseq line (+ sep 1))))
            (list (parse-bound first-bound) (parse-bound second-bound))))))

(defun complete-inclusion (first-bound second-bound)
  (destructuring-bind (a b) first-bound
    (destructuring-bind (c d) second-bound
      (or
       (and
        (>= a c) (<= a d)
        (>= b c) (<= b d))
       (and
        (>= c a) (<= c b)
        (>= d a) (<= d b))))))

(defvar round-1-answer (length (remove-if #'null
                                          (mapcar (lambda (pair)
                                               (destructuring-bind (first second) pair
                                                 (complete-inclusion first second)))
                                             completed-parse))))

;; Round 2: any overlap at all.  Basically just overhaul the inclusion
;; function and then do the same answer checking.
(defun any-inclusion (first second)
  (destructuring-bind (a b) first
    (destructuring-bind (c d) second
      ;; How about doing this through negation?  [a,b] does not overlap with [c,d] at all if either b < c or a > d.
      (not
       (or
        (< b c)
        (> a d))))))

(defvar round-2-answer (length (remove-if #'null
                                          (mapcar (lambda (pair)
                                               (destructuring-bind (first second) pair
                                                 (any-inclusion first second)))
                                             completed-parse))))