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
|
(load "lib")
(defparameter input (uiop:read-file-string "11-input"))
(defparameter lines (get-lines input))
(defun lines->segments (lines)
(--> (split-by-completely lines "" #'string=)
(mapcar (lambda (x)
(--> (loop for i in x
collect
(string-trim '(#\Space) i))))
it)))
(defun segment->monkey (segment)
(destructuring-bind (name starting op test clause-1 clause-2) segment
(declare (ignore name))
`(:items
,(--> (subseq starting 16)
(string-to-clist it)
(split-by-completely it #\,)
(mapcar (lambda (lst)
(--> (clist-to-string lst)
(string-trim '(#\Space) it)
(parse-integer it)))
it))
:inspect
,(--> (subseq op 21)
(format nil "(~a old)" it)
(with-input-from-string (s it)
(read s))
(eval `(lambda (old) ,it)))
:test
,(let ((test (parse-integer (subseq test 19)))
(clause-1 (parse-integer (subseq clause-1 25)))
(clause-2 (parse-integer (subseq clause-2 26))))
(lambda (n)
(if (= (mod n test) 0)
clause-1
clause-2)))
:divisor ,(parse-integer (subseq test 19)))))
(defmacro get-monkey (monkeys ind)
`(nth ,ind ,monkeys))
(defmacro get-monkey-items (monkeys ind)
`(getf (get-monkey ,monkeys ,ind) :items))
(defun monkey-increment-alist (monkey-alist monkey-ind)
(setf (cdr (assoc monkey-ind monkey-alist))
(+ 1 (cdr (assoc monkey-ind monkey-alist)))))
(defun monkey-send-item (monkeys item recipient)
(setf (get-monkey-items monkeys recipient)
(append (get-monkey-items monkeys recipient)
(list item))))
(defun monkey-process-item (inspect item)
(floor (/ (funcall inspect item) 3)))
(defun monkey-do-turn (monkeys monkey-alist monkey-ind)
(let* ((monkey (nth monkey-ind monkeys))
(items (getf monkey :items))
(inspect (getf monkey :inspect))
(test (getf monkey :test)))
(loop for item in items
for proper-item = (monkey-process-item inspect item)
for recipient = (funcall test proper-item)
do (monkey-send-item monkeys proper-item recipient)
do (monkey-increment-alist monkey-alist monkey-ind))
(setf (get-monkey-items monkeys monkey-ind) nil)
monkeys))
(defun monkeys-do-round (monkeys monkey-alist)
(loop for monkey in monkeys
for i from 0
do (monkey-do-turn monkeys monkey-alist i)))
(defun monkey-business (monkey-alist)
(--> (lambda (x y) (> (cdr x) (cdr y)))
(sort monkey-alist it)
(subseq it 0 2)
(mapcar #'cdr it)
(reduce #'* it)))
(let* ((monkeys (--> (lines->segments lines)
(mapcar #'segment->monkey it)))
(monkey-alist (loop for monkey in monkeys
for i from 0
collect `(,i . 0))))
(loop for i from 1 to 20
do (monkeys-do-round monkeys monkey-alist))
(format t "Round 1: ~a~%" (monkey-business monkey-alist)))
(defvar *monkey-divisor* nil)
(defun monkey-process-item (inspect item)
(mod (funcall inspect item) *monkey-divisor*))
(let* ((monkeys (--> (lines->segments lines)
(mapcar #'segment->monkey it)))
(monkey-alist (loop for monkey in monkeys
for i from 0
collect `(,i . 0))))
;; To ensure we don't go too hard.
(setq *monkey-divisor* (reduce #'*
(loop for monkey in monkeys
for divisor = (getf monkey :divisor)
collect divisor)))
(loop for i from 1 to 10000
do (monkeys-do-round monkeys monkey-alist))
(format t "Round 2: ~a~%" (monkey-business monkey-alist)))
|
