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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
|
(defstruct scanner ()
id
data
rot
pref
delta
nei)
(defun read-input (: (name "input"))
(with-stream (s (open-file name))
(build
(let (scnr)
(while-match-case (get-line s)
("")
(`@x,@y,@z` (push (vec (toint x) (toint y) (toint z)) scnr.data))
(`--- scanner @n ---` (set scnr (new scanner id (toint n))) (add scnr)))))))
(defmacro x (p) ^[,p 0])
(defmacro y (p) ^[,p 1])
(defmacro z (p) ^[,p 2])
(defmacro rot-z (p)
(with-gensyms (tp)
^(let ((,tp ,p))
(vec (- (y ,tp)) (x ,tp) (z ,tp)))))
(defmacro rot-y (p)
(with-gensyms (tp)
^(let ((,tp ,p))
(vec (z ,tp) (y ,tp) (- (x ,tp))))))
(defmacro rot-x (p)
(with-gensyms (tp)
^(let ((,tp ,p))
(vec (x ,tp) (- (z ,tp)) (y ,tp)))))
(defmacro psub (p0 p1)
(with-gensyms (tp0 tp1)
^(let ((,tp0 ,p0) (,tp1 ,p1))
(vec (- (x ,tp0) (x ,tp1))
(- (y ,tp0) (y ,tp1))
(- (z ,tp0) (z ,tp1))))))
(defmacro padd (p0 p1)
(with-gensyms (tp0 tp1)
^(let ((,tp0 ,p0) (,tp1 ,p1))
(vec (+ (x ,tp0) (x ,tp1))
(+ (y ,tp0) (y ,tp1))
(+ (z ,tp0) (z ,tp1))))))
(defmeth scanner gen-rot (sc)
(set sc.rot (vec))
(dotimes (i 24)
(vec-push sc.rot (vec)))
(each ((rA sc.data))
(let* ( (rB (rot-x rA)) (rC (rot-x rB)) (rD (rot-x rC))
(rE (rot-z rA)) (rF (rot-y rE)) (rG (rot-y rF)) (rH (rot-y rG))
(rI (rot-z rE)) (rJ (rot-x rI)) (rK (rot-x rJ)) (rL (rot-x rK))
(rM (rot-z rI)) (rN (rot-y rM)) (rO (rot-y rN)) (rP (rot-y rO))
(rQ (rot-y rA)) (rR (rot-z rQ)) (rS (rot-z rR)) (rT (rot-z rS))
(rU (rot-y (rot-y rQ))) (rV (rot-z rU)) (rW (rot-z rV)) (rX (rot-z rW)))
(vec-push [sc.rot 0] rA) (vec-push [sc.rot 1] rB)
(vec-push [sc.rot 2] rC) (vec-push [sc.rot 3] rD)
(vec-push [sc.rot 4] rE) (vec-push [sc.rot 5] rF)
(vec-push [sc.rot 6] rG) (vec-push [sc.rot 7] rH)
(vec-push [sc.rot 8] rI) (vec-push [sc.rot 9] rJ)
(vec-push [sc.rot 10] rK) (vec-push [sc.rot 11] rL)
(vec-push [sc.rot 12] rM) (vec-push [sc.rot 13] rN)
(vec-push [sc.rot 14] rO) (vec-push [sc.rot 15] rP)
(vec-push [sc.rot 16] rQ) (vec-push [sc.rot 17] rR)
(vec-push [sc.rot 18] rS) (vec-push [sc.rot 19] rT)
(vec-push [sc.rot 20] rU) (vec-push [sc.rot 21] rV)
(vec-push [sc.rot 22] rW) (vec-push [sc.rot 23] rX))))
(defun overlap-delta (pvec0 pvec1 amt)
(each-prod ((p0 pvec0)
(p1 pvec1))
(let* ((delta (psub p1 p0))
(novl (len (isec pvec0
(mapcar (do psub @1 delta) pvec1)))))
(when (>= novl amt)
(return delta)))))
(defun overlaps-with (s0 s1 : (amt 12))
(for* ((r 0) (r0 [s0.rot (or s0.pref 0)]) (rot1 s1.rot) (n (len rot1)))
((< r n))
((inc r))
(whenlet ((delta (overlap-delta r0 [rot1 r] amt)))
(return (cons delta r)))))
(defun link-graph (slist)
(let ((sf (car slist))
(backref)
(count 0))
(flet ((lnk (s0 s1)
(tree-case (overlaps-with s0 s1)
((delta . r)
(prinl ^(:lap ,s0.id ,s1.id ,r ,delta))
(cond
((and (neq s0 sf) (null s0.pref))
(push (cons s0 s1) backref))
(t
(set s1.pref r)
(push (list* s1 r delta) s0.nei)))))))
(each-match ((@s0 @s1) (comb slist 2))
(prinl ^(,(inc count) ,s0.id ,s1.id))
(cond
((null s1.pref) (lnk s0 s1))
((null s0.pref) (lnk s1 s0))))
(while backref
(set count 0)
(put-line "backref")
(each-match ((@s0 . @s1) (zap backref))
(prinl ^(,(inc count) ,s0.id ,s1.id))
(cond
((null s1.pref) (lnk s0 s1))
((null s0.pref) (lnk s1 s0))))))
(keep-if .nei slist)))
(defun assemble-map (slist)
(let ((out (vec)))
(labels ((visit (sn r delta)
(prinl ^(:visit ,sn.id ,r))
(set sn.delta delta)
(each ((p [sn.rot r]))
(vec-push out (psub p delta)))
(each-match ((@n @nr . @ndelta) sn.nei)
(visit n nr (padd delta ndelta)))))
(visit (car slist) 0 #(0 0 0)))
(prinl ^(:len out ,(len out)))
(uniq out)))
(defun solve-one (: (name :))
(flow name
read-input
(progn (mapdo .(gen-rot) @1) @1)
link-graph
assemble-map))
(defun manhattan (p)
[sum p abs])
(defun max-manhattan-delta (slist)
(let ((maxhattan 0))
(each-match ((@s0 @s1) (comb slist 2))
(prinl ^(:delta ,s0.id ,s0.delta ,s1.id ,s1.delta))
(let ((mhdelta (manhattan (psub s0.delta s1.delta))))
(upd maxhattan (max mhdelta))))
maxhattan))
(defun solve-two (: (name :))
(flow name
read-input
(let ((orig @1))
(flow orig
(progn (mapdo .(gen-rot) @1) @1)
link-graph
assemble-map)
(flow orig
(keep-if .delta)
max-manhattan-delta))))
|
