blob: 09be7989c459fdb315e8f12c7cdf7f9b92b970a4 (
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
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
|
(defvar input (uiop:read-file-string "2022/5-input"))
;; When we get two newlines, it means the end of the initial state and
;; the start of instructions
(defvar parse-separator (search (format nil "~%~%") input))
(defvar initial-state
(with-input-from-string (s (subseq input 0 parse-separator))
(loop
for line = (read-line s nil)
until (null line)
collect line)))
;; the last number, indicating the number of stacks
(defparameter n-stacks (let ((str (car (last initial-state))))
(parse-integer (subseq str (- (length str) 1)))))
(defun default-state ()
(loop for i from 1 to n-stacks
collect nil))
(defvar state
(default-state))
#|
conjecture: the nth stack, if it has an entry, has '[' beginning at index 4n;
base case: the 0th stack must begin at index 0 (if at all)
intuition: next stack must start at 0 + 2 (for the stack info) +
1 (for whitespace) + 1 so 4.
inductive hypothesis: for the kth stack [ begins at 4k
proof of induction claim: from 4k we have the following:
4k+1: symbol
4k+2: ]
4k+3: whitespace
4k+4: data for the (k+1 stack)
Immediately 4k+4 = 4(k+1) so by principle of induction we have the
conjecture. QED.
This gives us all the information we need to make a parser: check
every position and see if it has a [ char. If so then parse the data
and insert into the index/4th stack!|#
(defun parse-initial-state ()
(loop
;; don't want to parse the last line
for j in (remove (car (last initial-state)) initial-state)
do
(loop
for i from 0
for c across j
do
(if (char= c #\[)
(let ((ind (/ i 4))
(sym (subseq j (+ i 1) (+ i 2))))
(setf (nth ind state) (append (nth ind state) (list sym))))))))
;; Now we have the initial memory layout, we need to parse program code.
;; + 2 because two newlines
(defvar instructions-str (subseq input (+ 2 parse-separator)))
#| Each command is of the following: move ~n from ~a to ~b.
~n is some natural number of crates, ~a is the stack from which we
are taking them and ~b is the stack we are adding them to. Let's
define this operation first! |#
(defun move-crates (n a b)
"Take N number of crates from stack at position A to stack at position B"
(let ((stack-a (nth a state))
(stack-b (nth b state)))
(if (= n 0)
nil
(progn
;; Pop the first element off the stack
(setf (nth a state) (cdr stack-a))
;; Then cons that onto b
(setf (nth b state) (cons (car stack-a) stack-b))
;; Recur
(move-crates (- n 1) a b)))))
(defun parse-instruction-str (instruction)
"Given INSTRUCTION of form \"move n from a to b\", return (n (a - 1) (b - 1))"
(let ((first (search "move " instruction))
(second (search "from " instruction))
(third (search "to " instruction)))
(list
(parse-integer (subseq instruction (+ 5 first) (- second 1)))
;; Input assumes crates start at 1, but we need it to start at 0
(- (parse-integer (subseq instruction (+ 5 second) (- third 1))) 1)
(- (parse-integer (subseq instruction (+ 3 third))) 1))))
(defun perform-instructions (instructions)
(with-input-from-string (s instructions)
(loop
for line = (read-line s nil)
until (null line)
collect
;; Parse each instruction then move the crates!
(destructuring-bind (n a b) (parse-instruction-str line)
(move-crates n a b)))))
(defun first-round ()
(setq state (default-state))
(parse-initial-state)
(perform-instructions instructions-str)
(let ((ret (mapcar #'car state)))
(setq state (default-state))
(reduce (lambda (s1 s2) (concatenate 'string s1 s2)) ret)))
;; Round 2 is pretty simple: the move-crates algorithm is overhauled
;; to keep movements "in-order". Thankfully I already implemented
;; this by accident when implementing move-crates, so easy!
(defun move-crates-2 (n a b)
(let ((stack-a (nth a state))
(stack-b (nth b state)))
(setf (nth b state)
(append (loop for i from 1 to n
for j in stack-a
collect j)
stack-b))
(dotimes (i n)
(setf stack-a (cdr stack-a)))
(setf (nth a state) stack-a)))
(defun perform-instructions-2 (instructions)
(with-input-from-string (s instructions)
(loop
for line = (read-line s nil)
until (null line)
collect
;; Parse each instruction then move the crates!
(destructuring-bind (n a b) (parse-instruction-str line)
(move-crates-2 n a b)))))
(defun second-round ()
(setq state (default-state))
(parse-initial-state)
(perform-instructions-2 instructions-str)
(let ((ret (mapcar #'car state)))
(setq state (default-state))
(reduce (lambda (s1 s2) (concatenate 'string s1 s2)) ret)))
|
