180 lines
7.3 KiB
Common Lisp
180 lines
7.3 KiB
Common Lisp
;; 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)
|
|
)
|