From 43a821e3f89fc061f6bbfaa89844f5a78a727967 Mon Sep 17 00:00:00 2001 From: Alex Karle Date: Sun, 11 Dec 2022 14:58:18 -0500 Subject: [PATCH] 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! --- 2022/11/sol.scm | 187 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++------------------------------------------------------------------------------------------ 1 file changed, 97 insertions(+), 90 deletions(-) diff --git a/2022/11/sol.scm b/2022/11/sol.scm index 01bdcb0..b479b3f 100755 --- 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)))) -- libgit2 1.8.1