# HG changeset patch # User Steve Losh # Date 1575755912 18000 # Node ID baf889db8d40b6f67903182353bee57e17170540 # Parent bf4373f04499202e57427005f431b95219b944b3 2019/07 diff -r bf4373f04499 -r baf889db8d40 .lispwords --- a/.lispwords Sat Dec 07 00:59:04 2019 -0500 +++ b/.lispwords Sat Dec 07 16:58:32 2019 -0500 @@ -2,3 +2,4 @@ (3 define-problem) (1 opcase) (1 finding-first) +(1 rebind) diff -r bf4373f04499 -r baf889db8d40 advent.asd --- a/advent.asd Sat Dec 07 00:59:04 2019 -0500 +++ b/advent.asd Sat Dec 07 16:58:32 2019 -0500 @@ -31,6 +31,7 @@ :pileup :split-sequence :str + :jpl-queues ) diff -r bf4373f04499 -r baf889db8d40 data/2019/07.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/data/2019/07.txt Sat Dec 07 16:58:32 2019 -0500 @@ -0,0 +1,1 @@ +3,8,1001,8,10,8,105,1,0,0,21,34,51,64,81,102,183,264,345,426,99999,3,9,102,2,9,9,1001,9,4,9,4,9,99,3,9,101,4,9,9,102,5,9,9,1001,9,2,9,4,9,99,3,9,101,3,9,9,1002,9,5,9,4,9,99,3,9,102,3,9,9,101,3,9,9,1002,9,4,9,4,9,99,3,9,1002,9,3,9,1001,9,5,9,1002,9,5,9,101,3,9,9,4,9,99,3,9,102,2,9,9,4,9,3,9,101,1,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,101,1,9,9,4,9,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,102,2,9,9,4,9,99,3,9,101,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,1,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,1,9,9,4,9,99,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,101,1,9,9,4,9,3,9,101,2,9,9,4,9,3,9,101,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,2,9,4,9,3,9,1002,9,2,9,4,9,99,3,9,1001,9,1,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,101,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,1,9,4,9,3,9,1001,9,1,9,4,9,99,3,9,1002,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,2,9,4,9,3,9,101,2,9,9,4,9,3,9,102,2,9,9,4,9,3,9,1001,9,1,9,4,9,3,9,1002,9,2,9,4,9,3,9,1001,9,2,9,4,9,3,9,102,2,9,9,4,9,3,9,101,1,9,9,4,9,99 diff -r bf4373f04499 -r baf889db8d40 package.lisp --- a/package.lisp Sat Dec 07 00:59:04 2019 -0500 +++ b/package.lisp Sat Dec 07 16:58:32 2019 -0500 @@ -36,6 +36,8 @@ :first-character :let-result :let-complex + :queue-thunk + :rebind :ring :ring-prev diff -r bf4373f04499 -r baf889db8d40 src/2019/days/day-07.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/2019/days/day-07.lisp Sat Dec 07 16:58:32 2019 -0500 @@ -0,0 +1,67 @@ +(defpackage :advent/2019/07 #.cl-user::*advent-use* + (:shadow :queue)) +(in-package :advent/2019/07) + +(defun queue (&key initial-contents) + (let-result (queue (make-instance 'jpl-queues:synchronized-queue + :queue (make-instance 'jpl-queues:unbounded-fifo-queue))) + (dolist (el initial-contents) + (jpl-queues:enqueue el queue)))) + +(defun make-amplifier (program input-queue output-queue) + (advent/intcode:init program + :input (rcurry #'jpl-queues:dequeue input-queue) + :output (rcurry #'jpl-queues:enqueue output-queue))) + +(defun make-amplifiers (program phases) + (iterate + (with top-queue = (queue :initial-contents (list (first phases) 0))) + (for (nil next-phase) :on phases) + (for output-queue = (if next-phase + (queue :initial-contents (list next-phase)) + top-queue)) + (for input-queue :previous output-queue :initially top-queue) + (collect (make-amplifier program input-queue output-queue) :into amps) + (returning amps top-queue))) + +(defun run-amplifiers (program phases) + (multiple-value-bind (amplifiers queue) (make-amplifiers program phases) + (-<> amplifiers + (mapcar (lambda (amp) + (bt:make-thread (curry #'advent/intcode:run-machine amp) + :name "Amplifier Thread")) + <>) + (map nil #'bt:join-thread <>)) + (jpl-queues:dequeue queue))) + +(defun maximum-permutation (function sequence) + (iterate (alexandria:map-permutations + (lambda (el) + (maximizing (funcall function el))) + sequence) + (finish))) + +(define-problem (2019 7) (data read-numbers) (46248 54163586) + (values + (maximum-permutation (curry #'run-amplifiers data) '(0 1 2 3 4)) + (maximum-permutation (curry #'run-amplifiers data) '(5 6 7 8 9)))) + + +#; Scratch -------------------------------------------------------------------- + +(run '(3 15 3 16 1002 16 10 16 1 16 15 15 4 15 99 0 0)) + +(run '(3 23 3 24 1002 24 10 24 1002 23 -1 23 101 5 23 23 1 24 23 23 4 23 99 0 0)) + +(run '(3 26 1001 26 -4 26 3 27 1002 27 2 27 1 27 26 27 4 27 1001 28 -1 28 1005 28 6 99 0 0 5)) + +(run '(3 52 1001 52 -5 52 3 53 1 52 56 54 1007 54 5 55 1005 55 26 1001 54 -5 54 + 1105 1 12 1 53 54 53 1008 54 0 55 1001 55 1 55 2 53 55 53 4 53 1001 56 + -1 56 1005 56 6 99 0 0 0 0 10)) + +(defun kill-amplifiers () + (-<> (bt:all-threads) + (remove "Amplifier Thread" <> :test-not #'string= :key #'bt:thread-name) + (map nil #'bt:destroy-thread <>))) + +(kill-amplifiers) diff -r bf4373f04499 -r baf889db8d40 src/2019/intcode.lisp --- a/src/2019/intcode.lisp Sat Dec 07 00:59:04 2019 -0500 +++ b/src/2019/intcode.lisp Sat Dec 07 16:58:32 2019 -0500 @@ -1,27 +1,28 @@ (defpackage :advent/intcode #.cl-user::*advent-use* (:shadow :step :trace) - (:export :init :step :run)) + (:export :init :step :run :run-machine)) (in-package :advent/intcode) +(defparameter *trace-lock* (bt:make-lock "intcode trace lock")) ;;;; Data Structures ---------------------------------------------------------- (defclass* machine () - ((pc :type '(integer 0) :initform 0) - (memory :type 'vector) - (input :type 'function) - (output :type 'function))) + ((pc :type (integer 0) :initform 0) + (memory :type (vector integer)) + (input :type function) + (output :type function))) (define-with-macro machine pc memory input output) (defclass* operation () ((opcode :type (integer 0)) - (name :type 'symbol) - (size :type '(integer 1)) - (parameters :type 'list) - (perform :type 'function))) + (name :type symbol) + (size :type (integer 1)) + (parameters :type list) + (perform :type function))) (defun perform-operation (opcode parameter-modes machine) (funcall (perform (gethash opcode *operations*)) @@ -54,24 +55,26 @@ `(progn (defun ,function-name (,pmodes ,machine) (declare (ignorable ,pmodes)) - (flet ((pop-mode () - (multiple-value-bind (,pms ,pm) (truncate ,pmodes 10) - (setf ,pmodes ,pms) - ,pm))) - (with-machine (,machine) - (let (,@(iterate - (for (param kind) :in parameters) - (for offset :from 0) - (collect - (ecase kind - (in `(,param (retrieve ,machine - (pop-mode) - (aref memory (+ pc ,offset))))) - (out `(,param (progn - (pop-mode) - (aref memory (+ pc ,offset))))))))) - (incf pc ,(length parameters)) - ,@body)))) + (,@(if parameters + `(flet ((pop-mode () + (multiple-value-bind (,pms ,pm) (truncate ,pmodes 10) + (setf ,pmodes ,pms) + ,pm)))) + `(progn)) + (with-machine (,machine) + (let (,@(iterate + (for (param kind) :in parameters) + (for offset :from 0) + (collect + (ecase kind + (in `(,param (retrieve ,machine + (pop-mode) + (aref memory (+ pc ,offset))))) + (out `(,param (progn + (pop-mode) + (aref memory (+ pc ,offset))))))))) + (incf pc ,(length parameters)) + ,@body)))) (setf (gethash ,opcode *operations*) (make-instance 'operation :opcode ,opcode @@ -172,17 +175,21 @@ (defun step (machine &key trace) (with-machine (machine) (when trace - (disassemble-program (memory machine) :start pc :limit 1)) + (bt:with-lock-held (*trace-lock*) + (when (numberp trace) + (format t "~D: " trace)) + (disassemble-program (memory machine) :start pc :limit 1))) (multiple-value-bind (opcode parameter-modes) (parse-op (aref memory pc)) (incf pc) (perform-operation opcode parameter-modes machine)))) -(defun run (program &key input output trace) +(defun run-machine (machine &key trace) (iterate - (with machine = (init program :input input :output output)) (case (step machine :trace trace) (:halt (return (aref (memory machine) 0)))))) +(defun run (program &key input output trace) + (run-machine (init program :input input :output output) :trace trace)) ;; #; Scratch -------------------------------------------------------------------- diff -r bf4373f04499 -r baf889db8d40 src/utils.lisp --- a/src/utils.lisp Sat Dec 07 00:59:04 2019 -0500 +++ b/src/utils.lisp Sat Dec 07 16:58:32 2019 -0500 @@ -474,6 +474,17 @@ ,@body)) +(defun queue-thunk (&rest elements) + (lambda () (pop elements))) + + +(defmacro rebind ((&rest vars) &body body) + `(let (,@(iterate + (for var :in vars) + (collect `(,var ,var)))) + ,@body)) + + ;;;; A* Search ---------------------------------------------------------------- (defstruct path state