;;; 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))))