aoc18/day3.lisp -rw-r--r-- 2.0 KiB View raw
                                                                                
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
(in-package :aoc18)

(defstruct claim
  (id 0 :type fixnum)
  (x 0 :type fixnum)
  (y 0 :type fixnum)
  (w 0 :type fixnum)
  (h 0 :type fixnum))

(defun parse-claim (in)
  (let ((l (mapcar #'parse-integer
		   (cl-ppcre:split " +"
				   (string-trim " "
						(cl-ppcre:regex-replace-all "(#|\@|,|:|x| )+" in " "))))))
    (make-claim :id (nth 0 l) :x (nth 1 l) :y (nth 2 l) :w (nth 3 l) :h (nth 4 l))))


(defun make-fabric (w h)
  (make-array (list w h) :initial-element 0 :element-type 'fixnum))

(defun claim-fabric (f c)
  (loop for y from (claim-y c) below (+ (claim-y c) (claim-h c)) do
       (loop for x from (claim-x c) below (+ (claim-x c) (claim-w c)) do
	    (incf (aref f x y)))))

(defun print-fabric (f)
  (let* ((d (array-dimensions f))
	 (w (car d))
	 (h (cadr d)))
    (loop for y from 0 below h do
	 (loop for x from 0 below w do
	      (if (= 0 (aref f x y))
		  (format t ".")
		  (format t "~a" (aref f x y))))
	 (format t "~%"))))

(defun count-overclaims (f)
  (let* ((d (array-dimensions f))
	 (w (car d))
	 (h (cadr d))
	 (ret 0))
    (loop for y from 0 below h do
	 (loop for x from 0 below w do
	      (when (> (aref f x y) 1)
		(incf ret))))
    ret))

(defun solve-day3-part1 (input)
  (let ((fabric (make-fabric 2000 2000)))
    (loop for claim in input do
	 (claim-fabric fabric claim))
    (values (count-overclaims fabric) fabric)))

(defun claim-overlap-p (f c)
  (loop for y from (claim-y c) below (+ (claim-y c) (claim-h c)) do
       (loop for x from (claim-x c) below (+ (claim-x c) (claim-w c)) do
	    (when (> (aref f x y) 1)
	      (return-from claim-overlap-p t)))))

(defun solve-day3-part2 (input)
  (let ((f (nth-value 1 (solve-day3-part1 input))))
    (loop for claim in input do
	 (when (not (claim-overlap-p f claim))
	   (return-from solve-day3-part2 (claim-id claim))))))

(test day3-part1
  (is (= 113716 (solve-day3-part1 (mapcar #'parse-claim (read-lines "day3.input"))))))

(test day3-part2
  (is (= 742 (solve-day3-part2 (mapcar #'parse-claim (read-lines "day3.input"))))))