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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
|
(load "lib")
(defparameter input (uiop:read-file-string "7-input"))
(defparameter lines (get-lines input)) ;; first line is ALWAYS "$ cd /"
(defun tokenise-lines (lines)
"Split each LINE in LINES by space"
(mapcar (lambda (line)
(mapcar #'clist-to-string
(split-by-completely (string-to-clist line) #\Space)))
lines))
(defun is-token-cmd? (token)
"Checks if TOKEN is a command (by the first member)"
(string= (car token) "$"))
(defun till-next-cmd (tokens)
"Iterates over TOKENS till a command is found, returning the remaining
tokens (including command)."
(loop
for token-set on tokens
if (is-token-cmd? (car token-set))
return token-set))
;;; Functions to manage a directory structure
(progn
#| What is a directory structure? You have some root directory, with
some entries. Your current working directory (CWD), at the start of
the program, will be at the root but later on could be any descendant
of the root. How do we manage moving around the directory structure
and ensure updates to the overall structure?
We should maintain a HISTORY stack where
CAR(HISTORY) = (NAME of CWD . State of CWD according to parent).
So the top of the history stack represents the current directory
structure in the form it'll inhabit in its parents. We need a way to
update the top of the history stack with the CWD.
UPDATE-CURRENT-DIRECTORY(CWD, HISTORY) {
CWD-ENTRY = PEEK(HISTORY);
IF NULL(CWD-ENTRY)
HISTORY = ((NIL . CWD))
ELSE
SETF((CDR CWD-ENTRY), CWD);
}
|#
(defun update-current-directory (cwd history)
"Updates the top of HISTORY (structure of CWD) with CWD i.e. set the
'state' of the top of the the HISTORY stack to CWD."
(if (null (car history))
(values
cwd
`((nil ,@cwd)))
(progn
(setf (cdr (car history)) cwd)
(values
cwd
history))))
#|
Say CWD = {... a = directory, ...}. How do I go down to `a`?
DOWN-DIRECTORY(a, CWD, HISTORY) {
UPDATE-CURRENT-DIRECTORY(CWD, HISTORY); <-- This is so we don't lose
any current information
HISTORY = ACONS(a, CWD@a, HISTORY);
CWD = CWD@a;
}
|#
(defun down-directory (name cwd history)
(multiple-value-bind (cwd history) (update-current-directory cwd history)
(let ((cwd@a (cdr (assoc name cwd :test #'string=))))
(values
cwd@a
(acons name cwd@a history)))))
#|
How do we ascend the directory structure? We need to account for 3 cases:
1) At the root
2) Parent is the root
3) Parent is any directory
Then UP-DIRECTORY(CWD, HISTORY) {
PAIR = POP(HISTORY); <-- (CWD-NAME . PREVIOUS-CWD-STATE)
if NULL(CAR(PAIR))
then error(AT ROOT)
else
PARENT = PEEK(HISTORY); <-- Parent of CWD (PARENT-NAME . PARENT-STATE)
ENTRY = ASSOC(CAR(PAIR) CDR(PARENT)) <-- Gives us the CWD entry in the parent
SETF CDR(ENTRY) CWD <-- Update the parent
CWD = CDR(PARENT) <-- Update CWD
}
|#
(defun up-directory (cwd history)
(when (null (caar history))
;; At root, so we can't go further up
(error "Directory already at root"))
;; We can't use names as in the pseudocode because we need to mutate
;; this specific pointer: Lisp copies by value so we won't be
;; mutating it if we use names.
(setf
;; CDR(ENTRY)
(cdr
;; ENTRY
(assoc
;; CAR(PAIR)
(car (car history))
;; CDR(PARENT)
(cdr (cadr history))
:test #'string=))
cwd)
(values
(cdr (cadr history))
(cdr history)))
#|
Finally, how do we go from some child all the way back to the root?
UP-TO-ROOT(CWD, HISTORY) {
IF (NULL (CAAR HISTORY)) <-- Means we're at the root
RETURN
ELSE
UP-DIRECTORY(CWD, HISTORY)
UP-TO-ROOT(CWD, HISTORY)
}
|#
(defun up-to-root (cwd history)
(if (null (caar history))
(values
cwd
history)
(multiple-value-bind (cwd history) (up-directory cwd history)
(up-to-root cwd history)))))
;;; Functions to parse the shell output
(progn
(defun parse-ls (tokens)
"Converts the following TOKENS till a command (via IS-TOKEN-CMD?) into a
directory structure i.e. an alist of string names by their content."
(loop for token in tokens
until (is-token-cmd? token)
collect
(let ((size (car token))
(name (cadr token)))
(if (string= size "dir")
`(,name . nil)
`(,name . ,(parse-integer size))))))
(defun parse-cd (name cwd history)
"Converts TOKEN into an action on CWD and HISTORY then returns them"
(cond
((string= "/" name)
(up-to-root cwd history))
((string= ".." name)
(up-directory cwd history))
(t
(down-directory name cwd history))))
(defun parse-next-command (tokens cwd history)
"Parses the next command available in TOKENS, managing CWD and HISTORY.
Assumes CAR(TOKENS) is a command (see IS-TOKEN-CMD?)"
(cond
((null tokens)
(multiple-value-bind (cwd history) (up-to-root cwd history)
(values
tokens
cwd
history)))
((string= (cadar tokens) "ls")
(values
(till-next-cmd (cdr tokens))
(parse-ls (cdr tokens))
history))
((string= (cadar tokens) "cd")
(multiple-value-bind (cwd history) (parse-cd (caddar tokens) cwd history)
(values
(till-next-cmd (cdr tokens))
cwd
history)))))
(defun parse-all-tokens (tokens &optional cwd history)
"Recursively parse all TOKENS, returning (CWD . HISTORY) from the
perspective of the root."
(if (null tokens)
(multiple-value-bind (cwd history) (up-to-root cwd history)
(values
cwd
history))
(multiple-value-bind (tokens cwd history)
(parse-next-command tokens cwd history)
(parse-all-tokens tokens cwd history)))))
(defun is-record-directory? (record)
"Checks if the record (output from parse-tokens) is a directory by
checking if the CDR is a list."
(listp (cdr record)))
(defun strip-file-names (record)
"Deletes file names, leaving the corresponding file sizes and
directory names (and the wrapping list structure)."
(if (is-record-directory? record)
(cons (car record)
(loop
for entry in (cdr record)
collect
(strip-file-names entry)))
(cdr record)))
(defun get-directory-sizes (dir &optional current)
"Computes the size of the directory dir, as well as all subdirectories.
Returns both the overall size of dir as well as an alist of sizes for
subdirectories."
(if (not (listp dir))
(values
dir
nil)
(let ((name (car dir))
(size (loop
for record in (cdr dir)
sum
(multiple-value-bind (size dir-alist) (get-directory-sizes record nil)
;; This is for the alist of subdirectory sizes
(setq current (concatenate 'list dir-alist current))
size))))
(values
size
(acons name size current)))))
(defparameter TOTAL-SIZE 70000000)
(defparameter REQUESTED-SIZE 30000000)
(multiple-value-bind (_ history)
(parse-all-tokens (tokenise-lines lines))
;; Since we're at the root, CAR(history) is the entire file structure
(declare (ignore _))
(multiple-value-bind (sum size-list)
(get-directory-sizes
(strip-file-names
;; normalize the name of root
(cons "/" (cdr (car history)))))
(format t "Round 1: ~s~%"
(reduce #'+ (loop for rec in size-list
if (< (cdr rec) 100000) ; only records that are at most 100000
collect (cdr rec))))
(let* ((root-size sum)
(free-space (- TOTAL-SIZE root-size))
(extra-space-req (- REQUESTED-SIZE free-space)))
(format t "Round 2: ~s~%"
(cdar
(sort (loop
for rec in size-list
;; only records whose size is at least the space required
if (>= (cdr rec) extra-space-req)
collect rec)
(lambda (rec1 rec2)
(< (cdr rec1) (cdr rec2)))))))))
|
