Skip to content

Instantly share code, notes, and snippets.

@death

death/aoc2019-day25.lisp

Last active December 25, 2019 14:05
Download ZIP

Revisions

  1. death revised this gist Dec 25, 2019. 1 changed file with 5 additions and 3 deletions.
    8 changes: 5 additions & 3 deletions aoc2019-day25.lisp
    View file
    Original file line number Diff line number Diff line change
    @@ -49,8 +49,10 @@
    (funcall function output-read input-write)
    (when (bt:thread-alive-p thread)
    (ignore-errors (bt:destroy-thread thread)))))
    (ignore-errors (close output-write))))
    (ignore-errors (close input-write)))))
    (ignore-errors (close output-write))
    (ignore-errors (close output-read))))
    (ignore-errors (close input-write))
    (ignore-errors (close input-read)))))

    (defstruct room
    name
    @@ -228,4 +230,4 @@

    (defun day25 (input &optional verbose)
    (let ((*debug-io* (if verbose *debug-io* (make-broadcast-stream))))
    (take-em-all input)))
    (list (take-em-all input))))
  2. death created this gist Dec 25, 2019.
    231 changes: 231 additions & 0 deletions aoc2019-day25.lisp
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,231 @@
    ;;;; +----------------------------------------------------------------+
    ;;;; | Advent of Code 2019 |
    ;;;; +----------------------------------------------------------------+

    (defpackage #:snippets/aoc2019/day25
    (:use #:cl)
    (:import-from
    #:snippets/aoc2019/intcode
    #:intcode-run)
    (:shadow
    #:room)
    (:import-from
    #:snippets/slhelpers
    #:bfs)
    (:import-from
    #:snippets/pipe-streams
    #:make-pipe-streams)
    (:import-from
    #:alexandria
    #:emptyp
    #:make-keyword
    #:destructuring-ecase
    #:map-combinations
    #:starts-with-subseq)
    (:export
    #:day25))

    (in-package #:snippets/aoc2019/day25)

    (defun verbose (format-control &rest format-args)
    (apply #'format *debug-io* format-control format-args))

    (defun play (program &optional (input-stream *standard-input*)
    (output-stream *standard-output*))
    (intcode-run program
    :input (lambda () (char-code (read-char input-stream)))
    :output (lambda (x) (write-char (code-char x) output-stream))))

    (defun ai-play (program function)
    (multiple-value-bind (input-read input-write)
    (make-pipe-streams :element-type 'character)
    (unwind-protect
    (multiple-value-bind (output-read output-write)
    (make-pipe-streams :element-type 'character)
    (unwind-protect
    (let ((thread (bt:make-thread (lambda () (play program input-read output-write))
    :name "quest thread")))
    (unwind-protect
    (funcall function output-read input-write)
    (when (bt:thread-alive-p thread)
    (ignore-errors (bt:destroy-thread thread)))))
    (ignore-errors (close output-write))))
    (ignore-errors (close input-write)))))

    (defstruct room
    name
    extra
    doors
    items)

    (defstruct item
    name
    room)

    (defun explore (program)
    (ai-play program
    (lambda (see-stream do-stream)
    (let ((rooms (make-hash-table :test 'equal)))
    (explore-dfs (expect-room see-stream) see-stream do-stream rooms)
    rooms))))

    (defun explore-dfs (current see-stream do-stream rooms)
    (unless (gethash (room-name current) rooms)
    (setf (gethash (room-name current) rooms) current)
    (unless (equal (room-name current) "Security Checkpoint")
    (dolist (door (room-doors current))
    (when (null (cdr door))
    (write-line (string-downcase (car door)) do-stream)
    (let ((new (expect-room see-stream)))
    (explore-dfs new see-stream do-stream rooms)
    (setf (cdr door) new))
    (write-line (string-downcase (opposite-direction (car door))) do-stream)
    (let ((back (expect-room see-stream)))
    (assert (equal (room-name current) (room-name back)))))))))

    (defun read-event (see-stream)
    (loop for line = (read-line see-stream nil nil)
    while (and line (not (equal line "Command?")))
    do (cond ((emptyp line))
    ((starts-with-subseq "== " line)
    (return-from read-event
    (list :room (read-room (subseq line 3 (- (length line) 3)) see-stream))))
    ((starts-with-subseq "You take the " line)
    (loop while (peek-char nil see-stream nil)
    for extra = (read-line see-stream)
    do (cond ((emptyp extra))
    ((equal extra "Command?")
    (return))
    (t
    (verbose "Take Line: ~S~%" extra))))
    (return-from read-event
    (list :take (subseq line 13 (1- (length line))))))
    (t
    (verbose "Event Line: ~S~%" line))))
    (list :eof))

    (defun expect-room (stream)
    (destructuring-ecase (read-event stream)
    ((:room room) room)))

    (defun read-room (name stream)
    (let ((room (make-room :name name))
    (state :want-extra))
    (loop for line = (read-line stream nil nil)
    until (or (null line) (equal line "Command?"))
    do (verbose "Room Line: ~S~%" line)
    (cond ((emptyp line))
    ((starts-with-subseq "Doors here lead:" line)
    (setf state :want-doors))
    ((starts-with-subseq "Items here:" line)
    (setf state :want-items))
    ((starts-with-subseq "\"Oh, hello!" line)
    (throw :got-it (values (parse-integer line :start 51 :junk-allowed t))))
    ((eq state :want-extra)
    (push line (room-extra room)))
    ((starts-with-subseq "- " line)
    (ecase state
    (:want-doors
    (push (list (make-keyword (string-upcase (subseq line 2))))
    (room-doors room)))
    (:want-items
    (push (make-item :name (subseq line 2)
    :room room)
    (room-items room)))))))
    (setf (room-extra room) (nreverse (room-extra room)))
    room))

    (defun opposite-direction (dir)
    (ecase dir
    (:east :west)
    (:north :south)
    (:south :north)
    (:west :east)))

    (defun all-items (rooms)
    (loop for room being each hash-value of rooms
    append (room-items room)))

    (defun follow-plan (program plan &optional (rooms (explore program)))
    (ai-play program
    (lambda (see-stream do-stream)
    (plan-follower plan rooms see-stream do-stream))))

    (defun plan-follower (plan rooms see-stream do-stream)
    (let ((current-room (expect-room see-stream)))
    (verbose "Room: ~S~%" (room-name current-room))
    (loop while plan
    do (destructuring-ecase (pop plan)
    ((:go destination)
    (etypecase destination
    (symbol
    (write-line (string-downcase destination) do-stream)
    (let ((event (read-event see-stream)))
    (destructuring-ecase event
    ((:room room)
    (setf current-room room))))
    (verbose "Room: ~S~%" (room-name current-room)))
    (string
    (let ((target-room (gethash destination rooms)))
    (when (null target-room)
    (error "No room named ~S." destination))
    (push (list :go target-room) plan)))
    (room
    (setf plan (append (path-steps current-room destination rooms) plan)))))
    ((:take item)
    (cond ((stringp item)
    (let ((item-object (or (find item (room-items current-room) :key #'item-name :test #'equal)
    (find item (all-items rooms) :key #'item-name :test #'equal)
    (error "Can't find item ~S." item))))
    (push (list :take item-object) plan)))
    ((member (item-name item) (room-items current-room) :key #'item-name :test #'equal)
    (format do-stream "take ~A~%" (item-name item))
    (verbose "Take Event: ~S~%" (read-event see-stream)))
    (t
    (setf plan
    (list* (list :go (item-room item))
    (list :take item)
    plan)))))))))

    (defun path-steps (source destination rooms)
    (let ((path (bfs (cons :here source)
    (lambda (node)
    (equal (room-name (cdr node))
    (room-name destination)))
    (lambda (node)
    (let ((room (gethash (room-name (cdr node)) rooms)))
    (assert room)
    (loop for door in (room-doors room)
    when (cdr door)
    collect door)))
    :key (lambda (node) (room-name (cdr node)))
    :test #'equal)))
    (mapcar (lambda (node) (list :go (car node))) (cdr path))))

    (defun dangerous-item-p (item)
    (member (item-name item)
    '("infinite loop" "molten lava" "photons" "escape pod" "giant electromagnet")
    :test #'equal))

    (defun take-em-all (program)
    "Put them up against the wall and shoot'em..."
    (catch :got-it
    (let* ((rooms (explore program))
    (items (all-items rooms)))
    (setf items (remove-if #'dangerous-item-p items))
    (loop for n from 1 to (length items)
    do (map-combinations
    (lambda (to-take)
    (verbose "Taking: ~S~%" (mapcar #'item-name to-take))
    (follow-plan program
    (append (mapcar (lambda (item) (list :take item)) to-take)
    (list (list :go "Security Checkpoint")
    (list :go :west)))
    rooms))
    items
    :copy nil
    :length n)))))

    (defun day25 (input &optional verbose)
    (let ((*debug-io* (if verbose *debug-io* (make-broadcast-stream))))
    (take-em-all input)))