commit 43a821e3f89fc061f6bbfaa89844f5a78a727967 (patch)
parent 224961185e1eedf9a6d269834a99936dbda5837b
Author: Alex Karle <alex@alexkarle.com>
Date: Sun, 11 Dec 2022 14:58:18 -0500
day11: Add parsing logic for input, clean up driver loop
This makes it so that we print pt 1 and pt 2 based on the input
from stdin!
Diffstat:
| M | 2022/11/sol.scm | | | 187 | +++++++++++++++++++++++++++++++++++++++++-------------------------------------- |
1 file changed, 97 insertions(+), 90 deletions(-)
diff --git a/2022/11/sol.scm b/2022/11/sol.scm
@@ -1,112 +1,119 @@
#!/usr/local/bin/chicken-csi -ss
(import (chicken io)
(chicken sort)
+ (chicken string)
+ (chicken format)
regex)
-(define-record monkey items inspect test counter)
+(define-record monkey items inspect div true false counter)
+(set-record-printer! monkey
+ (lambda (x o)
+ (fprintf o "(monkey ~S ~S ~S ~S ~S)"
+ (monkey-counter x)
+ (monkey-div x)
+ (monkey-true x)
+ (monkey-false x)
+ (monkey-items x))))
-;; TODO: parse these!
-(define sample (vector
- (make-monkey '(79 98)
- (lambda (o) (* o 19))
- (lambda (x) (if (= 0 (modulo x 23)) 2 3))
- 0)
- (make-monkey '(54 65 75 74)
- (lambda (o) (+ o 6))
- (lambda (x) (if (= 0 (modulo x 19)) 2 0))
- 0)
- (make-monkey '(79 60 97)
- (lambda (o) (* o o))
- (lambda (x) (if (= 0 (modulo x 13)) 1 3))
- 0)
- (make-monkey '(74)
- (lambda (o) (+ o 3))
- (lambda (x) (if (= 0 (modulo x 17)) 0 1))
- 0)))
+;; to make parsing work line-by-line, we store the divisor,
+;; true-monkey and false-monkey in separate slots. This helper
+;; simulates the entire test sequence: given a value, spit out
+;; which monkey to hand it to next
+(define (monkey-test m v)
+ (if (= 0 (modulo v (monkey-div m)))
+ (monkey-true m)
+ (monkey-false m)))
-;; no need to even use (lcm) since all primes!
-(define sample-lcm (* 23 19 13 17))
-(define input-lcm (* 2 17 19 3 5 13 7 11))
+;; helper constructor for parsing
+(define (new-monkey)
+ (make-monkey #f #f #f #f #f 0))
-(define input (vector
- (make-monkey '(83 62 93)
- (lambda (o) (* 17 o))
- (lambda (x) (if (= 0 (modulo x 2)) 1 6))
- 0)
- (make-monkey '(90 55)
- (lambda (o) (+ 1 o))
- (lambda (x) (if (= 0 (modulo x 17)) 6 3))
- 0)
- (make-monkey '(91 78 80 97 79 88)
- (lambda (o) (+ 3 o))
- (lambda (x) (if (= 0 (modulo x 19)) 7 5))
- 0)
- (make-monkey '(64 80 83 89 59)
- (lambda (o) (+ 5 o))
- (lambda (x) (if (= 0 (modulo x 3)) 7 2))
- 0)
- (make-monkey '(98 92 99 51)
- (lambda (o) (* o o))
- (lambda (x) (if (= 0 (modulo x 5)) 0 1))
- 0)
- (make-monkey '(68 57 95 85 98 75 98 75)
- (lambda (o) (+ 2 o))
- (lambda (x) (if (= 0 (modulo x 13)) 4 0))
- 0)
- (make-monkey '(74)
- (lambda (o) (+ 4 o))
- (lambda (x) (if (= 0 (modulo x 7)) 3 2))
- 0)
- (make-monkey '(68 64 60 68 87 80 82)
- (lambda (o) (* o 19))
- (lambda (x) (if (= 0 (modulo x 11)) 4 5))
- 0)))
-
-
-(define (take-turn-1 m flock)
- (let ((items (monkey-items m)))
- (if (null? items)
- 'done
- (let* ((new-val (floor (/ ((monkey-inspect m) (car items)) 3)))
- (next-monkey-idx ((monkey-test m) new-val))
- (next-monkey (vector-ref flock next-monkey-idx)))
- (monkey-counter-set! m (add1 (monkey-counter m)))
- (monkey-items-set! m (cdr items))
- (monkey-items-set! next-monkey (append (monkey-items next-monkey)
- (list new-val)))
- (take-turn-1 m flock))))) ; recurse for next item
-
-
-;; What do monkeys REALLY care about? They care about the
-;; divisibility by their number. If monkeys 1, 2, and 3
-;; care about divisibility A B C, then (lcm A B C) is the
-;; highest number we care about. We can truncate there.
-(define (take-turn-2 m flock)
- ; (print (map monkey-items (vector->list flock)))
- ; (print (map monkey-counter (vector->list flock)))
+;; meat of the simulation (see main for notes on the 'reducer')
+(define (take-turn m flock reducer)
(let ((items (monkey-items m)))
(if (null? items)
'done
- (let* ((new-val (modulo ((monkey-inspect m) (car items)) input-lcm))
- (next-monkey-idx ((monkey-test m) new-val))
+ (let* ((new-val (reducer ((monkey-inspect m) (car items))))
+ (next-monkey-idx (monkey-test m new-val))
(next-monkey (vector-ref flock next-monkey-idx)))
(monkey-counter-set! m (add1 (monkey-counter m)))
(monkey-items-set! m (cdr items))
(monkey-items-set! next-monkey (append (monkey-items next-monkey)
(list new-val)))
- (take-turn-2 m flock))))) ; recurse for next item
+ (take-turn m flock reducer))))) ; recurse for next item
-
-(define (simul flock turn-proc rounds)
+;; simple countdown loop that passes args
+(define (simul flock rounds reducer)
(if (= rounds 0)
'done
(begin
- (for-each (lambda (m) (turn-proc m flock)) (vector->list flock))
- (simul flock turn-proc (sub1 rounds)))))
+ (for-each (lambda (m) (take-turn m flock reducer)) (vector->list flock))
+ (simul flock (sub1 rounds) reducer))))
+
+;; parse the input line-by-line into a vector of monkey records
+;; TODO: would be nice to use regex instead of equal?... (this was a doozy)
+(define (parse-input lines)
+ (let loop ((flock '()) (lines lines) (m (new-monkey)))
+ (if (null? lines)
+ (apply vector (append flock (list m)))
+ (let ((parts (string-split (car lines) " ,")))
+ (cond ((null? parts)
+ ;; start the next monkey
+ (loop (append flock (list m))
+ (cdr lines)
+ (new-monkey)))
+ ((equal? (car parts) "Monkey") ; just skip
+ (loop flock (cdr lines) m))
+ ((equal? (car parts) "Starting")
+ (monkey-items-set! m (map string->number (cddr parts)))
+ (loop flock (cdr lines) m))
+ ((equal? (car parts) "Operation:")
+ (let* ((opstr (list-ref parts 4))
+ (valstr (list-ref parts 5))
+ (op (cond ((equal? opstr "*") *)
+ ((equal? opstr "+") +)
+ (else "Bad op: " (car lines)))))
+ ;; special case "old"
+ (if (equal? valstr "old")
+ (monkey-inspect-set! m (lambda (o) (op o o)))
+ (monkey-inspect-set! m (lambda (o)
+ (op o (string->number valstr)))))
+ (loop flock (cdr lines) m)))
+ ((equal? (car parts) "Test:")
+ (monkey-div-set! m (string->number (list-ref parts 3)))
+ (loop flock (cdr lines) m))
+ ((equal? (car parts) "If")
+ (cond ((equal? (cadr parts) "true:")
+ (monkey-true-set! m (string->number (list-ref parts 5))))
+ ((equal? (cadr parts) "false:")
+ (monkey-false-set! m (string->number (list-ref parts 5))))
+ (else (error "Bad line " (car lines))))
+ (loop flock (cdr lines) m))
+ (else (error "Bad line " (car lines))))))))
+
+(define (reset-counters! flock)
+ (for-each (lambda (m) (monkey-counter-set! m 0))
+ (vector->list flock)))
+
+(define (score flock)
+ (let ((sorted (sort (map monkey-counter (vector->list flock)) >)))
+ (* (car sorted)
+ (cadr sorted))))
(define (main args)
- (simul input take-turn-2 10000)
- (let ((sorted (sort (map monkey-counter (vector->list input)) >)))
- ; (print (map monkey-items (vector->list input)))
- (print (* (car sorted)
- (cadr sorted)))))
+ (let* ((lines (read-lines))
+ (flock (parse-input lines))
+ (flock-lcm (apply * (map monkey-div (vector->list flock)))))
+ ;; For part 1, we reduce the fear by floor(v / 3)
+ (simul flock 20 (lambda (v) (floor (/ v 3))))
+ (print (score flock))
+ (reset-counters! flock)
+ ;; For part 2, we need to be smarter about how we manage
+ ;; the explosive fear growth (into bignum territory).
+ ;; What do monkeys REALLY care about? They care about the
+ ;; divisibility by the fear. If monkeys 1, 2, and 3
+ ;; care about divisibility A B C, then (lcm A B C) is the
+ ;; highest number we care about -> we can loop around at LCM
+ ;; since the divisibility of (X % LCM) = X.
+ (simul flock 10000 (lambda (v) (modulo v flock-lcm)))
+ (print (score flock))))
