blob: 6b0c4363185f260df5e5c06f340d996c2e11cfe0 (
plain)
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
|
;;; solver.el --- Day 11 -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2022 Óscar Nájera
;;
;; Author: Óscar Nájera <hi@oscarnajera.com>
;; Maintainer: Óscar Nájera <hi@oscarnajera.com>
;; Created: December 11, 2022
;; Modified: December 11, 2022
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;; Day 11
;;
;;; Code:
(require 'subr-x)
(require 'cl-lib)
(cl-defstruct (monkey (:constructor monkey--create)
(:copier nil))
"Monkey container"
id
items
worry-level
divisor
throw-to)
(defun solver-monkey-make (id items operation divisor true-target false-target)
(let ((op (if (string-prefix-p "*" operation) #'* #'+))
(operand (unless (string-suffix-p "old" operation)
(string-to-number (substring operation 1))))
(div (string-to-number divisor))
(true (string-to-number true-target))
(false (string-to-number false-target)))
(monkey--create
:id (string-to-number id)
:items (nreverse (mapcar #'string-to-number (split-string items ", ")))
:worry-level (lambda (item) (funcall op item (or operand item))) ;; value item
:divisor div
:throw-to (lambda (item)
(thread-first item
(mod div) ;; throw input
(= 0) ;; divisble
(if true false))))))
(defun solver-parse-monkey-entry ()
(when
(re-search-forward (rx bol "Monkey " (group digit) ":" (+ space)
"Starting items: " (group (+ (1+ digit) (? ", "))) (+ space)
"Operation: new = old " (group (1+ any)) (+ space)
"Test: divisible by " (group (1+ digit)) (+ space)
"If true: throw to monkey " (group digit) (+ space)
"If false: throw to monkey " (group digit) eol)
nil t)
(apply #'solver-monkey-make
(mapcar #'match-string (number-sequence 1 6)))))
(defun solver-monkey-business (works)
(let ((ranks (sort works #'>)))
(* (aref ranks 0) (aref ranks 1))))
(defun solver-get-monkeys (filename)
(with-temp-buffer
(insert-file-contents filename)
(goto-char (point-min))
(cl-loop for monkey = (solver-parse-monkey-entry) while monkey collect monkey)))
(defun solver-monkey-rounds (rounds relaxation &rest monkeys)
(let ((monkey-work (make-vector (length monkeys) 0)))
;; play round
(dotimes (_ rounds)
(dolist (monkey monkeys)
(let ((items (nreverse (monkey-items monkey))))
(setf (monkey-items monkey) nil)
(cl-incf (aref monkey-work (monkey-id monkey)) (length items))
(mapc (lambda (item)
(let* ((item-concern (funcall relaxation (funcall (monkey-worry-level monkey) item)))
(target-monkey (funcall (monkey-throw-to monkey) item-concern)))
(push item-concern (monkey-items (cl-find target-monkey monkeys :key #'monkey-id)))))
items))
;; (message "monkey %d - items: %s\n all: %S" (monkey-id monkey) (monkey-items monkey)
;; (mapcar #'monkey-items monkeys))
))
monkey-work))
(defun solver-constant-slice (monkeys)
(cons (lambda (x) (floor x 3)) monkeys))
(defun solver-monkey-field (monkeys)
(let ((prime-field (apply #'* (mapcar #'monkey-divisor monkeys))))
(cons (lambda (x) (mod x prime-field)) monkeys)))
(defun solver (filename rounds relaxer)
(thread-last
filename
(solver-get-monkeys)
(funcall relaxer)
(apply #'solver-monkey-rounds rounds)
(solver-monkey-business)))
(ert-deftest test-solver ()
(should (= 10605 (solver "eg-in" 20 #'solver-constant-slice)))
(should (= 50830 (solver "input" 20 #'solver-constant-slice)))
(should (= 2713310158 (solver "eg-in" 10000 #'solver-monkey-field)))
(should (= 14399640002 (solver "input" 10000 #'solver-monkey-field))))
|
