-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathday5.lsp
182 lines (166 loc) · 7.29 KB
/
day5.lsp
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
;;;; Day 5
(ql:quickload :cl-ppcre )
(defun load-file (filename)
(with-open-file (in filename)
(loop for line = (read-line in nil)
while line
collect line)))
(defvar *file* nil) ;;procedure
(setf *file* (load-file "day5_input.txt")) ;; procedure
;(setf *file* (load-file "./test_input_day5.txt")) ;; procedure
(defun find-total-length (length-line)
(parse-integer (car (last (cl-ppcre:split :whitespace-char-class length-line)))))
(defun parse-container-line (container-line prev-pos)
(let ((containers '())
bracket-pos)
(when (position #\[ container-line)
(let ((start (position #\[ container-line))
(end (position #\] container-line)))
(setf containers (cons (list
(subseq container-line (incf start) end)
(+ start prev-pos))
containers))
(setf bracket-pos end)))
(when (position #\[ (subseq container-line bracket-pos))
(setf containers (append containers (parse-container-line
(subseq container-line (incf bracket-pos))
(+ bracket-pos prev-pos)))))
containers))
(defun stack-containers (c-list x)
(let (c-stack)
(dolist (next-row c-list)
(dolist (next-container next-row)
(when (equal (cadr next-container)
(+ 1 (* 4 x)))
(setf c-stack (cons (car next-container) c-stack)))))
c-stack))
(defun parse-move (move-line)
(let (out-line)
(setf out-line (cl-ppcre:split :whitespace-char-class move-line :omit-unmatched-p nil))
(mapcar 'parse-integer (list (nth 1 out-line) (nth 3 out-line) (nth 5 out-line)))))
(defun print-stacks (container-stacks)
; get longest stack
; starting at the top, go through each stack at that row
; if the stack is tall enough, get the value from the stack
; print out [<value>]
; if the stack is not tall enough, print whitespace
(let ((tallest 0)
(out-line ""))
(dolist (stack container-stacks)
(when (> (length stack) tallest)
(setf tallest (length stack))))
;(format t "tallest: ~a~%" tallest)
(format t "~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%")
(dotimes (row tallest)
;(format t "row: ~a~%" (- tallest row))
(dolist (stack container-stacks)
;(format t "stack height ~d~%" (length stack))
;(format t "stack ~a~%" stack)
;(format t "next-box: ~a~%" (nth row stack))
(if (<= (- tallest row) (length stack))
;(concatenate 'string out-line "[" "N" "] ")
;(if (<= 1 (length stack))
(setf out-line (concatenate 'string out-line "[" (nth (- (- tallest row) 1) (reverse stack)) "] "))
;(concatenate 'string out-line "[" (nth row stack) "] ")
(setf out-line (concatenate 'string out-line " "))
)
;(format t "out-line ~a~%" out-line)
)
(format t "~a~%" out-line)
(setf out-line ""))
(sleep 0.1)))
;(format t "~a~%" container-stacks)))
;(format t "output: ~a~%" (init-containers *file* 'move-container-9001))
(defun move-container (move-cmd container-stacks)
(setf move-cmd (cons (decf (car move-cmd)) (cdr move-cmd)))
(let ((from-column (nth (- (cadr move-cmd) 1) container-stacks))
(to-column (nth (- (caddr move-cmd) 1) container-stacks))
lower-column
upper-column
lower-bound
upper-bound
new-stacks)
(setf to-column (cons (car from-column) to-column))
(setf from-column (cdr from-column))
(if (< (cadr move-cmd) (caddr move-cmd))
(progn (setf lower-bound (- (cadr move-cmd) 1))
(setf upper-bound (- (caddr move-cmd) 1))
(setf lower-column from-column)
(setf upper-column to-column))
(progn (setf lower-bound (- (caddr move-cmd) 1))
(setf upper-bound (- (cadr move-cmd) 1))
(setf lower-column to-column)
(setf upper-column from-column)))
(dotimes (x (length container-stacks))
(if (or (equal x lower-bound) (equal x upper-bound))
(if (equal x lower-bound)
(setf new-stacks (append new-stacks (list lower-column)))
(setf new-stacks (append new-stacks (list upper-column))))
(setf new-stacks (append new-stacks (list (nth x container-stacks))))))
(print-stacks new-stacks)
(if (>= 0 (car move-cmd))
(return-from move-container new-stacks)
(move-container move-cmd new-stacks))))
(defun init-containers (file-data move-fn)
(let (container-list
move-list
(there-yet nil)
total-length
container-stacks)
;find full width
(dolist (next-line file-data)
(if (not there-yet)
(if (position #\[ next-line)
(setf container-list (cons
(parse-container-line next-line 0)
container-list)) ; get the containers
(progn
(setf there-yet 't)
(setf total-length (find-total-length next-line))))
(when (< 0 (length next-line)) (setf move-list (cons (parse-move next-line) move-list)))
)
)
; build the containers, using container-list and total-length
(dotimes (x total-length)
(setf container-stacks (cons (stack-containers container-list x) container-stacks)))
(setf container-stacks (reverse container-stacks))
;(print-stacks container-stacks)
;(return-from init-containers)
(dolist (next-move (reverse move-list))
(setf container-stacks (funcall move-fn next-move container-stacks)))
container-stacks
))
(defun count-output (final-stacks)
(let ((final-string ""))
(dolist (top final-stacks)
(setf final-string (concatenate 'string final-string (car top))))
final-string))
(defun move-container-9001 (move-cmd container-stacks)
(let ((from-column (nth (- (cadr move-cmd) 1) container-stacks))
(to-column (nth (- (caddr move-cmd) 1) container-stacks))
lower-column
upper-column
lower-bound
upper-bound
new-stacks)
(setf to-column (append (subseq from-column 0 (car move-cmd)) to-column))
(setf from-column (subseq from-column (car move-cmd)))
(if (< (cadr move-cmd) (caddr move-cmd))
(progn (setf lower-bound (- (cadr move-cmd) 1))
(setf upper-bound (- (caddr move-cmd) 1))
(setf lower-column from-column)
(setf upper-column to-column))
(progn (setf lower-bound (- (caddr move-cmd) 1))
(setf upper-bound (- (cadr move-cmd) 1))
(setf lower-column to-column)
(setf upper-column from-column)))
(dotimes (x (length container-stacks))
(if (or (equal x lower-bound) (equal x upper-bound))
(if (equal x lower-bound)
(setf new-stacks (append new-stacks (list lower-column)))
(setf new-stacks (append new-stacks (list upper-column))))
(setf new-stacks (append new-stacks (list (nth x container-stacks))))))
(print-stacks new-stacks)
new-stacks))
(format t "output: ~a~%" (count-output (init-containers *file* 'move-container)))
(format t "output: ~a~%" (count-output (init-containers *file* 'move-container-9001)))