~necaris/advent-of-code

f33f3745cb9f89e680434ee2cb739102a7af0eb0 — Rami Chowdhury 2 years ago 34105c5 + 1ce2faa
Merge branch 'day-7-part-2'

* day-7-part-2:
  Implement Day 7 Part 1 and working on Part 2
3 files changed, 288 insertions(+), 17 deletions(-)

A 2019/07/amplifiers.lisp
M 2019/07/intcode.lisp
A 2019/07/test.lisp
A 2019/07/amplifiers.lisp => 2019/07/amplifiers.lisp +201 -0
@@ 0,0 1,201 @@
(in-package #:cl-user)

(require "asdf")  ;; for uiop:split-string
;; Initialize Quicklisp
(load (merge-pathnames ".quicklisp/setup.lisp" (user-homedir-pathname)))
;; I like arrows
(ql:quickload :arrows :silent t)
;; utilities
(ql:quickload :alexandria :silent t)

(defpackage #:net.necaris.aoc.2019.07
  (:use #:cl #:arrows #:alexandria))

(in-package #:net.necaris.aoc.2019.07)

;; load up then Intcode interpreter
(load "./intcode.lisp")

;; https://stackoverflow.com/a/2087771
(defun all-permutations (list)
  (cond ((null list) nil)
        ((null (cdr list)) (list list))
        (t (loop for element in list
             append (mapcar (lambda (l) (cons element l))
                            (all-permutations (remove element list)))))))

;; define opcodes in a hash table -- copied and modified from Day 5
;; NOTE: new addition! all operations take the initial-input and the output
;; register to write outputs to
(loop for c in
     (list
      (make-opcode :code 1 :operation (named-lambda op-plus (first second r w)
                                        (+ first second))
                   :num-params 3 :takes-output-address t)
      (make-opcode :code 2 :operation (named-lambda op-times (first second r w)
                                        (* first second))
                   :num-params 3 :takes-output-address t)
      (make-opcode :code 3 :operation (named-lambda op-input (read write)
                                        (let ((input (funcall read)))
                                          ;; (format t "loaded input: ~a~%" input)
                                          input))
                   :num-params 1 :takes-output-address t)
      (make-opcode :code 4 :operation (named-lambda op-output (value read write)
                                        ;; (format t "[out]: ~a~%" value)
                                        (funcall write value))
                   :num-params 1 :takes-output-address nil)
      (make-opcode :code 5 :operation (named-lambda op-jump-if-true (test new-pointer-value r w)
                                        (if (not (= test 0)) new-pointer-value nil))
                   :num-params 2 :takes-output-address nil
                   :modifies-instruction-pointer t)
      (make-opcode :code 6 :operation (named-lambda op-jump-if-false (test new-pointer-value r w)
                                        (if (= test 0) new-pointer-value nil))
                   :num-params 2 :takes-output-address nil
                   :modifies-instruction-pointer t)
      (make-opcode :code 7 :operation (named-lambda op-lt (first second r w)
                                        (if (< first second) 1 0))
                   :num-params 3 :takes-output-address t)
       (make-opcode :code 8 :operation (named-lambda op-eq (first second r w)
                                        (if (= first second) 1 0))
                   :num-params 3 :takes-output-address t)
      ;; operation being nil means to halt
      (make-opcode :code 99 :operation nil :num-params 0 :takes-output-address nil))
   do (setf (gethash (opcode-code c) *opcodes*) c))

(defun run-amplifier-chain (code phase-settings &optional (initial-output-register 0))
  (let* ((io-buffer (list initial-output-register))
         (read-fn (lambda ()
                    (let ((v (car io-buffer)))
                      ;; (format t "reading ~a from ~a ~%" v io-buffer)
                      (setf io-buffer (cdr io-buffer))
                      v)))
         (write-fn (lambda (v)
                     ;; (format t "-> writing ~a to ~a" v io-buffer)
                     (push v io-buffer)
                     ;; (format t "-> wroted ~a to ~a" v io-buffer)
                     )))
    (loop for s in phase-settings do
      (progn
        (push s io-buffer)
        (execute code 0
                 read-fn
                 write-fn)))
    ;; should be the top of the io buffer
    (car io-buffer)))

(defun find-max-thruster-output (code initial-settings)
  (let ((max-output 0)
        (chosen-permutation nil))
    (loop for permutation in (all-permutations initial-settings) do
      (let ((output (run-amplifier-chain code permutation)))
        (if (> output max-output)
            (progn
              (setf max-output output)
              (setf chosen-permutation permutation)))))
    (values max-output chosen-permutation)))


(defmacro make-reader (buffer-name index lock)
  `(lambda ()
     (loop while (equal nil ,buffer-name) do
       (progn
         (sb-thread:with-mutex (,lock)
           (format t " ... waiting on [~a] ~%" ,index)
           (format t "   (state of all buffers: ~a ~a ~a ~a ~a ~%" buffer0 buffer1 buffer2 buffer3 buffer4)
           (format t "   (state of all buffers: ~a ~a ~a ~a ~a ~%" buffer0 buffer1 buffer2 buffer3 buffer4))
         (sleep 0.05))) ;; schedule work on another thread that can proceed
     (sb-thread:with-mutex (,lock)
       (format t "pop from [~a] ~a ~%" ,index ,buffer-name)
       (let ((v (car ,buffer-name)))
         (format t "   popped ~a ~%" v)
         (setf ,buffer-name (cdr ,buffer-name))
         v))))

(defmacro make-writer (buffer-name index lock)
  `(lambda (v)
     (sb-thread:with-mutex (,lock)
       ;; would seem that this is where we need to yield to the next executor,
       ;; but ... how to do this?
       (format t " push ~a to ~a ~a ~%" v ,index ,buffer-name)
       (setf ,buffer-name (append ,buffer-name (list v))))))

(defun find-looped-max-thruster-output (code initial-settings)
  (let ((-lock- (sb-thread:make-mutex))
        (max-output 0)
        (chosen-permutation nil))
    (loop for permutation in (all-permutations initial-settings) do
      (format t "permutation ~a~%" permutation)
      ;; can't figure out how to do this neatly so i won't bother
      (let* ((buffer0 (list))
             (buffer1 (list))
             (buffer2 (list))
             (buffer3 (list))
             (buffer4 (list))
             (reader0 (make-reader buffer0 0 -lock-))
             (reader1 (make-reader buffer1 1 -lock-))
             (reader2 (make-reader buffer2 2 -lock-))
             (reader3 (make-reader buffer3 3 -lock-))
             (reader4 (make-reader buffer4 4 -lock-))
             (writer0 (make-writer buffer0 0 -lock-))
             (writer1 (make-writer buffer1 1 -lock-))
             (writer2 (make-writer buffer2 2 -lock-))
             (writer3 (make-writer buffer3 3 -lock-))
             (writer4 (make-writer buffer4 4 -lock-)))

        ;; initialize
        (push (nth 0 permutation) buffer0)
        (push (nth 1 permutation) buffer1)
        (push (nth 2 permutation) buffer2)
        (push (nth 3 permutation) buffer3)
        (push (nth 4 permutation) buffer4)

        (setf buffer0 (append buffer0 (list 0))) ;; set up A

        (let ((a (sb-thread:make-thread (lambda () (execute code 0 reader0 writer1 t))))
              (b (sb-thread:make-thread (lambda () (execute code 0 reader1 writer2))))
              (c (sb-thread:make-thread (lambda () (execute code 0 reader2 writer3))))
              (d (sb-thread:make-thread (lambda () (execute code 0 reader3 writer4))))
              (e (sb-thread:make-thread (lambda () (execute code 0 reader4 writer0)))))
          ;;
          (sb-thread:join-thread a)
          (sb-thread:join-thread b)
          (sb-thread:join-thread c)
          (sb-thread:join-thread d)
          (sb-thread:join-thread e))

        (let ((output (vector-pop buffer1)))
          (if (> output max-output)
              (progn
                (setf max-output output)
                (setf chosen-permutation permutation))))))
    (values max-output chosen-permutation)))

(defun main ()
  (with-open-file (in "input.txt")
    (let* ((raw-input (read-line in nil))
           (raw-codes (uiop:split-string raw-input :separator '(#\,)))
           (intcode (map 'vector #'parse-integer raw-codes)))

      (multiple-value-bind (max-output settings)
          (find-max-thruster-output intcode (list 0 1 2 3 4))
        (format t "max output: ~a permutation: ~a~%" max-output settings)))))

;; (main)

    ;; (let* ((input-line "3,15,3,16,1002,16,10,16,1,16,15,15,4,15,99,0,0")
    ;;        (raw-codes (uiop:split-string input-line :separator '(#\,)))
    ;;        (intcode (map 'vector #'parse-integer raw-codes))
    ;;        (output-register nil))instr
    ;;   (multiple-value-bind (max-output settings)
    ;;       (find-max-thruster-output intcode (list 3 1 2 4 0))
    ;;     (format t "first thangs ~a ~a ~%" max-output settings)))



(let* ((input-line "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")
       (raw-codes (uiop:split-string input-line :separator '(#\,)))
       (intcode (map 'vector #'parse-integer raw-codes))
       (output-register nil))
  (multiple-value-bind (max-output settings)
      (find-looped-max-thruster-output intcode (list 9 8 7 6 5))
    (format t "thangs ~a ~a ~%" max-output settings)))

M 2019/07/intcode.lisp => 2019/07/intcode.lisp +24 -17
@@ 10,7 10,7 @@

(defstruct instruction
  "Capture a specific instruction."
  opcode parameter-modes params out-pos) ;; TODO -- do i just compute the next memory location to jump to?
  opcode parameter-modes params out-pos)

(defun get-params-for (instr memory ptr)
  "Given the INSTRuction type, MEMORY and instruction PoinTeR, return parameter list & output location."


@@ 56,19 56,26 @@
          (setf (instruction-out-pos instr) out-pos)
          instr))))

(defun execute (memory inst-ptr)
  "Execute the Intcode program in MEMORY, starting at INST-PTR."
  (loop
    (let* ((instr (parse-instruction memory inst-ptr))
           (opcode (instruction-opcode instr)))
      ;; (format t "Executing: ~a~%" instr)
      ;; special case for halting -- operation is nil
      (if (eq (opcode-operation opcode) nil)
          (return-from execute memory)
          (let ((result (apply (opcode-operation opcode) (instruction-params instr))))
            (if (instruction-out-pos instr)
                (setf (aref memory (instruction-out-pos instr)) result))
            (if (and (not (eql result nil))
                     (opcode-modifies-instruction-pointer opcode))
                (setf inst-ptr result)
                (incf inst-ptr (+ 1 (opcode-num-params opcode)))))))))
(defun execute (memory inst-ptr read-input-fn write-output-fn &optional (noisy nil))
  "Execute the Intcode program in MEMORY, starting at INST-PTR, and using
READ-INPUT-FN and WRITE-OUTPUT-FN to communicate."
  (let ((io-fns (list read-input-fn write-output-fn)))
    (loop
      (let* ((instr (parse-instruction memory inst-ptr))
             (opcode (instruction-opcode instr)))
        (if noisy
            (progn
              (format t "Executing: ~a~%" instr)
              (format t "  memory: ~a~%" memory)))
        ;; special case for halting -- operation is nil
        (if (eq (opcode-operation opcode) nil)
            (return-from execute memory))
        (let ((result (apply
                       (opcode-operation opcode)
                       (append (instruction-params instr) io-fns))))
          (if (instruction-out-pos instr)
              (setf (aref memory (instruction-out-pos instr)) result))
          (if (and (not (eql result nil))
                   (opcode-modifies-instruction-pointer opcode))
              (setf inst-ptr result)
              (incf inst-ptr (+ 1 (opcode-num-params opcode)))))))))

A 2019/07/test.lisp => 2019/07/test.lisp +63 -0
@@ 0,0 1,63 @@
;; Initialize Quicklisp
(load (merge-pathnames ".quicklisp/setup.lisp" (user-homedir-pathname)))
;; Add some unit testing so that we know it all works
(require "asdf")
(ql:quickload :lisp-unit :silent t)
;; Load the actual file under test
(load "./amplifiers.lisp")

(in-package #:net.necaris.aoc.2019.07)

(lisp-unit:define-test test-amplifier-chain1
    (let* ((input-line "3,15,3,16,1002,16,10,16,1,16,15,15,4,15,99,0,0")
           (raw-codes (uiop:split-string input-line :separator '(#\,)))
           (intcode (map 'vector #'parse-integer raw-codes))
           (output-register nil))
      (multiple-value-bind (max-output settings)
          (find-max-thruster-output intcode (list 3 1 2 4 0))
        (lisp-unit:assert-equalp max-output 43210)
        (lisp-unit:assert-equalp settings (list 4 3 2 1 0)))))

(lisp-unit:define-test test-amplifier-chain2
    (let* ((input-line "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")
           (raw-codes (uiop:split-string input-line :separator '(#\,)))
           (intcode (map 'vector #'parse-integer raw-codes))
           (output-register nil))
      (multiple-value-bind (max-output settings)
          (find-max-thruster-output intcode (list 3 1 2 4 0))
        (lisp-unit:assert-equalp max-output 54321)
        (lisp-unit:assert-equalp settings (list 0 1 2 3 4)))))

(lisp-unit:define-test test-amplifier-chain3
    (let* ((input-line "3,31,3,32,1002,32,10,32,1001,31,-2,31,1007,31,0,33,1002,33,7,33,1,33,31,31,1,32,31,31,4,31,99,0,0,0")
           (raw-codes (uiop:split-string input-line :separator '(#\,)))
           (intcode (map 'vector #'parse-integer raw-codes))
           (output-register nil))
      (multiple-value-bind (max-output settings)
          (find-max-thruster-output intcode (list 3 1 2 4 0))
        (lisp-unit:assert-equalp max-output 65210)
        (lisp-unit:assert-equalp settings (list 1 0 4 3 2)))))

;; (lisp-unit:define-test test-amplifier-loop1
;;     (let* ((input-line "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")
;;            (raw-codes (uiop:split-string input-line :separator '(#\,)))
;;            (intcode (map 'vector #'parse-integer raw-codes))
;;            (output-register nil))
;;       (multiple-value-bind (max-output settings)
;;           (find-looped-max-thruster-output intcode (list 5 6 7 8 9))
;;         (lisp-unit:assert-equalp max-output 139629729)
;;         (lisp-unit:assert-equalp settings (list 9 8 7 6 5)))))

;; (lisp-unit:define-test test-amplifier-loop2
;;     (let* ((input-line "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")
;;            (raw-codes (uiop:split-string input-line :separator '(#\,)))
;;            (intcode (map 'vector #'parse-integer raw-codes))
;;            (output-register nil))
;;       (multiple-value-bind (max-output settings)
;;           (find-looped-max-thruster-output intcode (list 5 6 7 8 9))
;;         (lisp-unit:assert-equalp max-output 18216)
;;         (lisp-unit:assert-equalp settings (list 9 7 8 5 6)))))

(setf lisp-unit:*print-failures* t)
(setf lisp-unit:use-debugger t)
(lisp-unit:run-tests :all)