From 010aa30876456f03ac85bcecdbb45581d149c0a3 Mon Sep 17 00:00:00 2001
From: Oscar Najera <hi@oscarnajera.com>
Date: Sun, 11 Dec 2022 15:31:28 +0100
Subject: [AoC2022] Elisp Day 11

---
 AoC2022/11/solver.el | 100 +++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 100 insertions(+)
 create mode 100644 AoC2022/11/solver.el

(limited to 'AoC2022/11/solver.el')

diff --git a/AoC2022/11/solver.el b/AoC2022/11/solver.el
new file mode 100644
index 0000000..397b911
--- /dev/null
+++ b/AoC2022/11/solver.el
@@ -0,0 +1,100 @@
+;;; 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
+  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)
+                    (thread-first
+                      (funcall op item (or operand item)) ;; value item
+                      (floor 3)))                         ;; loose interest
+
+     :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 (monkeys rounds)
+  (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 (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))
+        ))
+    (solver-monkey-business monkey-work)))
+
+(= 10605
+   (thread-first
+     "eg-in"
+     (solver-get-monkeys)
+     (solver-monkey-rounds 20)))
+
+(= 50830
+   (thread-first
+     "input"
+     (solver-get-monkeys)
+     (solver-monkey-rounds 20)))
-- 
cgit v1.2.3