aoc18/day6.lisp -rw-r--r-- 3.8 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
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
(in-package :aoc18)

(defun read-day6-input (path &optional (offset 0))
  (mapcar #'(lambda (l) (mapcar #'(lambda (p) (+ p offset))
				(mapcar #'parse-integer (cl-ppcre:split ", " l ))))
	  (read-lines path)))

(defun give-names (points)
  (let ((mapping (make-hash-table)))
    (loop for x from 0 below (length points) do
	 (setf (gethash x mapping nil) (nth x points)))
    mapping))

(defstruct cord 
  (x 0 :type fixnum)
  (y 0 :type fixnum))

(declaim (inline move-cord))
(defun move-coord (pos dir)
  (declare (optimize (speed 3) (safety 1))
	   (type cord pos dir))
  (make-cord :x (the fixnum (+ (cord-x pos) (cord-x dir)))
	     :y (the fixnum (+ (cord-y pos) (cord-y dir)))))

(defparameter *dirs* (mapcar #'(lambda (p) (make-cord :x (car p) :y (cadr p)))
		      '((0 1) (0 -1) (1 0) (-1 0) (1 1) (1 -1) (-1 -1) (-1 1))))

(defun neighbours (pos)
  (mapcar #'(lambda (p) (move-coord pos p)) *dirs*))

(defun cord-m-dist (c1 c2)
  (+ (abs (- (cord-x c1) (cord-x c2)))
     (abs (- (cord-y c1) (cord-y c2)))))

(defun read-input-as-named-cords (path)
  (give-names (loop for p in (read-day6-input path) collecting (make-cord :x (car p) :y (cadr p)))))

(defun closest-cord-name (named c)
  (let ((best-name nil)
	(best-dist most-positive-fixnum))
    (loop for name being the hash-key of named using (hash-value cord) do
	 (let ((dist (cord-m-dist cord c)))
	   (cond
	     ((< dist best-dist)
	      (setf best-name name
		    best-dist dist))
	     ((= dist best-dist)
	      (setf best-name nil)))))
    best-name))

(defun closest-to-p (named c expected)
  (equal expected (closest-cord-name named c)))

(defun border-cords (named)
  (let* ((x-cords (loop for c being the hash-value of named collecting (cord-x c)))
	 (y-cords (loop for c being the hash-value of named collecting (cord-y c)))
	 (min-x (1- (apply #'min x-cords)))
	 (min-y (1- (apply #'min y-cords)))
	 (max-x (1+ (apply #'max x-cords)))
	 (max-y (1+ (apply #'max y-cords)))
	 (cords nil))
    (loop for x from min-x to max-x do
	 (loop for y from min-y to max-y do
	      (when (or (= x min-x) (= x max-x) (= y min-y) (= y max-y))
		(push (make-cord :x x :y y) cords))))
    cords))

(defun find-infinite-cords (named)
  (remove-duplicates
   (remove nil
	   (mapcar #'(lambda (x) (closest-cord-name named x)) (border-cords named)))))

(defun region-starting-from (start pred)
  (assert (funcall pred start))
  (let ((to-visit (list start))
	(seen (make-hash-table :test #'equalp))
	(region 0))
    (loop while (not (empty-p to-visit)) do
	 (let* ((next (pop to-visit))
		(candidates (neighbours next)))
	   (incf region)
	   (setf (gethash next seen) t)
	   (loop for cand in candidates do
		(when (and (funcall pred cand) (null (gethash cand seen)))
		  (setf (gethash cand seen) t)
		  (push cand to-visit)))))
    region))

(defun solve-day6-part1 (named)
  (let* ((infinite (find-infinite-cords named))
	 (finite (set-difference (loop for n being the hash-key of named collecting n) infinite)))
    (apply #'max
	   (mapcar #'(lambda (c) (region-starting-from (gethash c named)
						       #'(lambda (cand) (closest-to-p named cand c))))
		   finite))))

(test day6-part1
  (is (= 3890 (solve-day6-part1 (read-input-as-named-cords "day6.input")))))

(defun middle-cord (named)
  (let ((x-cord (alexandria:median
		 (mapcar #'cord-x (loop for c being the hash-value of named collecting c))))
	(y-cord (alexandria:median
		 (mapcar #'cord-y (loop for c being the hash-value of named collecting c)))))
    (make-cord :x (floor x-cord)
	       :y (floor y-cord))))

(defun is-safe-cord-p (named cord &optional (max 10000))
  (< (loop for p being the hash-value of named summing (cord-m-dist cord p)) max))

(defun solve-day6-part2 (named)
  (region-starting-from (middle-cord named) #'(lambda (cand) (is-safe-cord-p named cand))))

(test day6-part2
  (is (= 40284 (solve-day6-part2 (read-input-as-named-cords "day6.input")))))