;; monkeys https://adventofcode.com/2022/day/11

(require 'cl-ppcre)
(defun parse-integer-or-symbol (str)
  (let ((maybe-int (parse-integer str :junk-allowed t)))
    (if maybe-int
        maybe-int
        (intern (string-upcase str)))))

(defun line-to-sexp (line)
  (mapcar (lambda (str)
            (mapcar #'parse-integer-or-symbol (cl-ppcre:split " " (string-trim " " str))))
          (cl-ppcre:split "\\n" line)))


(defun monkey-struct-to-instance (monkey-struct)
  (destructuring-bind
      ((monkey ordering-number)
       (starting items &rest inventory-list)
       (operation new eq old operation operation-number)
       (test divisible by divisible-number)
       (test tru th to monk true-monkey-number)
       (test fals th to monk false-monkey-number)) monkey-struct
    `(list 'monkey ,ordering-number 'inventory ',inventory-list 'operation '(lambda (item) (,operation item ,operation-number)) 'test ,divisible-number)))

(defclass monkey ()
    ((order-number :reader order-number :initarg :number)
     (inventory :accessor inventory :initarg :inventory)
     (operation :reader operation :initarg :operation)
     (test :reader test :initarg :test)
     (inspection-counter :reader inspection-counter :initform 0)
     (monkey-mod :reader monkey-mod :initarg :mod)
     (mod-reductor-2 :reader mod-reductor-2 :initform 1 :allocation :class)))

(defmethod print-object ((obj monkey)
                         stream)
  (print-unreadable-object (obj stream :type t)
    (with-accessors ((order-number order-number )
                     (inventory inventory)
                     (inspection-counter inspection-counter)
                     (monkey-mod monkey-mod)
                     (mod-reductor-2 mod-reductor-2))
        obj
      (format stream "~a, with objects: ~a; count: ~a; mod: ~a; common: ~a"
              order-number inventory inspection-counter monkey-mod mod-reductor-2))))

(defun new-from-old-function (operation operand1 operand2)
  (eval `(lambda (old)
           (,operation ,operand1 ,operand2)))) ; unhyginic macro


(defun monkey-struct-to-instance (monkey-struct)
  (destructuring-bind
      ((monkey ordering-number)
       (starting items &rest inventory-list)
       (operation new eq operand1 operation-sign operand2)
       (test divisible by divisible-number)
       (test tru th to monk true-monkey-number)
       (test fals th to monk false-monkey-number)) monkey-struct
    (let ((operation-fun (new-from-old-function operation-sign operand1 operand2))
          (test-fun (lambda  (item-worry)
                      (if (= 0 (mod item-worry divisible-number))
                          true-monkey-number
                          false-monkey-number))))
      (make-instance 'monkey
                     :test test-fun :operation operation-fun
                     :inventory inventory-list :number ordering-number
                     :mod divisible-number))))

(defun monkey-one-item-action (monkey)
  (let ((item-worry (first (inventory monkey) )))
    (when item-worry
      (setf (inventory monkey) (cdr (inventory monkey)))
      (setq item-worry (funcall (operation monkey) item-worry))
      ;; (setq item-worry (floor (/ item-worry 3)))
      (setq item-worry (mod item-worry (mod-reductor-2 monkey)))
      (incf (slot-value monkey 'inspection-counter))
      ;; returning (target-monkey-num thrown-item)
      (list (funcall (test monkey) item-worry) item-worry))))
(ql:quickload 'alexandria)

(defun monkey-turn (monkey)
  (let ((thrown-hash (make-hash-table :test 'equal)))
    (loop
      for i from 1 to (length (inventory monkey))
      do (let ((throw-result (monkey-one-item-action monkey)))
           ;; (format t "~s ~%" throw-result)
           (setf (gethash (first throw-result) thrown-hash) (push (second throw-result) (gethash (first throw-result) thrown-hash)))))
    (maphash (lambda (key value-list) (setf (gethash key  thrown-hash) (reverse (gethash key thrown-hash)))) thrown-hash)
    thrown-hash))
;; returns hashmap of which values go where

(defun monkeys-round (monkey-array)
  ;; for each monkey from array:
  ;; do it's turn, then for each record in resulting hashmap append list of transferred items to correct monkey
  (loop
    for monkey across monkey-array
    do (let ((turn-result (monkey-turn monkey)))
         (maphash
          (lambda (target-monkey-num items-list)
            (setf (inventory (aref monkey-array target-monkey-num)) (append (inventory (aref monkey-array target-monkey-num)) items-list)))
          turn-result))))

(progn
  (defparameter *11-test-structs*
    (coerce (mapcar #'monkey-struct-to-instance (mapcar #'line-to-sexp *11-test-input*)) 'vector))

  (loop
    for i from 1 to 20
    do (monkeys-round *11-test-structs*))

  (sort (mapcar #'inspection-counter (coerce *11-test-structs* 'list)) #'>))

;; PART 1 on input data

(progn
  (defparameter *11-input-paragraphs* (cl-ppcre:split "\\n\\n" (uiop:read-file-string "day11-input.txt")))

  (defparameter *11-input-structs*
    (coerce (mapcar #'monkey-struct-to-instance (mapcar #'line-to-sexp *11-input-paragraphs*)) 'vector))

  (loop
    for i from 1 to 20
    do (progn (monkeys-round *11-input-structs*)
              (format t "turn ~a~%" i)))

  (apply #'* (subseq (sort (mapcar #'inspection-counter (coerce *11-input-structs* 'list)) #'>) 0 2)))

;;; PART 2.
(progn
  (defparameter *11-test-input* (cl-ppcre:split "\\n\\n" (uiop:read-file-string "day11-test.txt")))
  (defparameter *11-test-structs*
    (coerce (mapcar #'monkey-struct-to-instance
                    (mapcar #'line-to-sexp *11-test-input*)) 'vector))
  ;; oh, i need to reset and recalculate the lowest common multiple for test input.
  ;; yup
  (setf (slot-value *test-monkey-instance* 'mod-reductor-2) 1)
  (loop
    for monkey across *11-test-structs*
    do (when (not (= 0 (mod (mod-reductor-2 monkey) (monkey-mod monkey))))
         (setf (slot-value monkey 'mod-reductor-2) (* (mod-reductor-2 monkey) (monkey-mod monkey)))))

  (loop
    for i from 1 to 10000
    do (progn (monkeys-round *11-test-structs*)
              (format t "turn ~a~%" i)))

  (print (apply #'* (subseq (sort
                             (mapcar #'inspection-counter
                                     (coerce *11-test-structs* 'list)) #'>) 0 2)))
  ;; that's the problem with sharing slots across class
  (setf (slot-value *test-monkey-instance* 'mod-reductor-2) 1)
  )

(progn
  (defparameter *11-input-input*
    (cl-ppcre:split "\\n\\n" (uiop:read-file-string "day11-input.txt")))
  (defparameter *11-input-structs*
    (coerce (mapcar #'monkey-struct-to-instance
                    (mapcar #'line-to-sexp *11-input-input*)) 'vector))
  ;; oh, i need to reset and recalculate the lowest common multiple for test input.
  ;; yup
  (setf (slot-value *test-monkey-instance* 'mod-reductor-2) 1)
  (loop
    for monkey across *11-input-structs*
    do (when (not (= 0 (mod (mod-reductor-2 monkey) (monkey-mod monkey))))
         (setf (slot-value monkey 'mod-reductor-2) (* (mod-reductor-2 monkey) (monkey-mod monkey)))))

  (loop
    for i from 1 to 10000
    do (progn (monkeys-round *11-input-structs*)
              (format t "turn ~a~%" i)))

  (print (apply #'* (subseq (sort
                             (mapcar #'inspection-counter
                                     (coerce *11-input-structs* 'list)) #'>) 0 2)))
  ;; that's the problem with sharing slots across class
  (setf (slot-value *test-monkey-instance* 'mod-reductor-2) 1)
  )