sol.scm (5122B) [raw]
1 #!/usr/local/bin/chicken-csi -ss 2 (import (chicken io) 3 (chicken sort) 4 (chicken string) 5 (chicken format) 6 regex) 7 8 (define-record monkey items inspect div true false counter) 9 (set-record-printer! monkey 10 (lambda (x o) 11 (fprintf o "(monkey ~S ~S ~S ~S ~S)" 12 (monkey-counter x) 13 (monkey-div x) 14 (monkey-true x) 15 (monkey-false x) 16 (monkey-items x)))) 17 18 ;; to make parsing work line-by-line, we store the divisor, 19 ;; true-monkey and false-monkey in separate slots. This helper 20 ;; simulates the entire test sequence: given a value, spit out 21 ;; which monkey to hand it to next 22 (define (monkey-test m v) 23 (if (= 0 (modulo v (monkey-div m))) 24 (monkey-true m) 25 (monkey-false m))) 26 27 ;; helper constructor for parsing 28 (define (new-monkey) 29 (make-monkey #f #f #f #f #f 0)) 30 31 ;; meat of the simulation (see main for notes on the 'reducer') 32 (define (take-turn m flock reducer) 33 (let ((items (monkey-items m))) 34 (if (null? items) 35 'done 36 (let* ((new-val (reducer ((monkey-inspect m) (car items)))) 37 (next-monkey-idx (monkey-test m new-val)) 38 (next-monkey (vector-ref flock next-monkey-idx))) 39 (monkey-counter-set! m (add1 (monkey-counter m))) 40 (monkey-items-set! m (cdr items)) 41 (monkey-items-set! next-monkey (append (monkey-items next-monkey) 42 (list new-val))) 43 (take-turn m flock reducer))))) ; recurse for next item 44 45 ;; simple countdown loop that passes args 46 (define (simul flock rounds reducer) 47 (if (= rounds 0) 48 'done 49 (begin 50 (for-each (lambda (m) (take-turn m flock reducer)) (vector->list flock)) 51 (simul flock (sub1 rounds) reducer)))) 52 53 ;; parse the input line-by-line into a vector of monkey records 54 ;; TODO: would be nice to use regex instead of equal?... (this was a doozy) 55 (define (parse-input lines) 56 (let loop ((flock '()) (lines lines) (m (new-monkey))) 57 (if (null? lines) 58 (apply vector (append flock (list m))) 59 (let ((parts (string-split (car lines) " ,"))) 60 (cond ((null? parts) 61 ;; start the next monkey 62 (loop (append flock (list m)) 63 (cdr lines) 64 (new-monkey))) 65 ((equal? (car parts) "Monkey") ; just skip 66 (loop flock (cdr lines) m)) 67 ((equal? (car parts) "Starting") 68 (monkey-items-set! m (map string->number (cddr parts))) 69 (loop flock (cdr lines) m)) 70 ((equal? (car parts) "Operation:") 71 (let* ((opstr (list-ref parts 4)) 72 (valstr (list-ref parts 5)) 73 (op (cond ((equal? opstr "*") *) 74 ((equal? opstr "+") +) 75 (else "Bad op: " (car lines))))) 76 ;; special case "old" 77 (if (equal? valstr "old") 78 (monkey-inspect-set! m (lambda (o) (op o o))) 79 (monkey-inspect-set! m (lambda (o) 80 (op o (string->number valstr))))) 81 (loop flock (cdr lines) m))) 82 ((equal? (car parts) "Test:") 83 (monkey-div-set! m (string->number (list-ref parts 3))) 84 (loop flock (cdr lines) m)) 85 ((equal? (car parts) "If") 86 (cond ((equal? (cadr parts) "true:") 87 (monkey-true-set! m (string->number (list-ref parts 5)))) 88 ((equal? (cadr parts) "false:") 89 (monkey-false-set! m (string->number (list-ref parts 5)))) 90 (else (error "Bad line " (car lines)))) 91 (loop flock (cdr lines) m)) 92 (else (error "Bad line " (car lines)))))))) 93 94 (define (reset-counters! flock) 95 (for-each (lambda (m) (monkey-counter-set! m 0)) 96 (vector->list flock))) 97 98 (define (score flock) 99 (let ((sorted (sort (map monkey-counter (vector->list flock)) >))) 100 (* (car sorted) 101 (cadr sorted)))) 102 103 (define (main args) 104 (let* ((lines (read-lines)) 105 (flock (parse-input lines)) 106 (flock-lcm (apply * (map monkey-div (vector->list flock))))) 107 ;; For part 1, we reduce the fear by floor(v / 3) 108 (simul flock 20 (lambda (v) (floor (/ v 3)))) 109 (print (score flock)) 110 (reset-counters! flock) 111 ;; For part 2, we need to be smarter about how we manage 112 ;; the explosive fear growth (into bignum territory). 113 ;; What do monkeys REALLY care about? They care about the 114 ;; divisibility by the fear. If monkeys 1, 2, and 3 115 ;; care about divisibility A B C, then (lcm A B C) is the 116 ;; highest number we care about -> we can loop around at LCM 117 ;; since the divisibility of (X % LCM) = X. 118 (simul flock 10000 (lambda (v) (modulo v flock-lcm))) 119 (print (score flock))))