If you have a lisp installation, emacs, org-mode, and org-babel support for lisp installed you can run this by:
- Starting slime (
M-x slime) - Typing
C-c C-cin the block initialize. - In the repl type
(in-package :aoc-2019-17) - Typing
C-c C-cin the block answers
(unless (find-package :cl-ppcre)
(ql:quickload "cl-ppcre"))
(unless (find-package :iterate)
(ql:quickload "iterate"))
(unless (find-package :parseq)
(ql:quickload "parseq"))
(unless (find-package :fiveam)
(ql:quickload "fiveam"))
(unless (find-package :series)
(ql:quickload "series"))
(unless (find-package :lparallel)
(ql:quickload "lparallel"))
(unless (find-package :cl-permutation)
(ql:quickload "cl-permutation"))
(unless (find-package :bordeaux-threads)
(ql:quickload "bordeaux-threads"))<<packages>>
(defpackage :aoc-2019-17
(:use :common-lisp
:iterate
:parseq
:lparallel.queue
:fiveam)
(:export :problem-a
:problem-b))
(in-package :aoc-2019-17)(defun read-input (file)
(with-open-file (s file)
(map 'vector #'parse-integer (cl-ppcre:split "," (read-line s)))))(defparameter *input*
(read-input "input/17.txt"))As expected, another intcode problem. This time, the robot writes out characters that, conveniently, print out what it sees.
(defun solve-a (program)
(intcode program :write-fn (lambda (c) (format t "~C" (code-char c)))))The task is to sum the “alignment parameters”. The alignment parameter is a value for an intersection described as the product of its horizontal distance (from top-left) and vertical. The top-left corner is (0,0).
Let’s put the input into a grid.
(defun solve-a (program)
(let ((grid (make-hash-table))
(x 0)
(y 0)
(max-x 0)
(max-y 0)
(position 0)
(direction #C(0 1)))
(labels ((camera (c)
(let ((c (code-char c)))
(format t "~C" c)
(setf (gethash (complex x y) grid) c)
(incf x)
(setf max-x (max max-x x))
(case c
((#\^ #\v #\> #\<)
(setf position (complex x y))
(setf (gethash position grid) #\#)))
(case c
(#\Newline (setf x 0)
(incf y)
(incf max-y))
(#\^ (setf direction #C(0 -1)))
(#\v (setf direction #C(0 1)))
(#\> (setf direction #C(1 0)))
(#\< (setf direction #C(-1 0)))))))
(intcode program :write-fn #'camera)
(iter outer
(for x from 0 to max-x)
(iter (for y from 0 to max-y)
(case (gethash (complex x y) grid #\.)
(#\#
(when
(iter (for d in (list #C(0 1) #C(0 -1) #C(-1 0) #C(1 0)))
(always (char= #\# (gethash (+ (complex x y) d) grid #\.))))
(in outer
(sum (* x y)))))))))))(defun problem-a () (format t "Problem 17 A: ~a~%" (solve-a *input*)))The next step is to plan a route and have the robot execute it. I’m just going to skip that and try to plan a route by hand, see what happens.
Via simple search and replace I arrived at this sequence of movements:
A,B,B,A,C,A,C,A,C,B R,6,R,6,R,8,L,10,L,4 R,6,L,10,R,8 L,4,L,12,R,6,L,10
All of this works, but I’d like to find the program automatically so that I could solve automatically for any input. I’m going to make a couple new things. One is as struct storing the grid from the initial execution (part 1), and the position and direction of the vacuum.
The below is a long ugly sequence of code that does the job. I could skip the string-to-list and back stuffs if I add in logic to ensure the subsequences break the initial sequence at the right spots, but I didn’t feel like doing that.
If there is more than one way to divide up the sequence of steps, this will find them all.
(defstruct vacuum
grid
position
direction)
(defun get-state (program)
(let ((vacuum (make-vacuum :grid (make-hash-table)))
(x 0)
(y 0))
(with-slots (grid position direction) vacuum
(labels ((camera (c)
(let ((c (code-char c)))
(incf x)
(case c
((#\^ #\v #\> #\<)
(setf position (complex x y))
(setf (gethash position grid) t))
(#\# (setf (gethash (complex x y) grid) t))
(#\Newline (setf x 0)
(incf y)))
(case c
(#\^ (setf direction #C(0 -1)))
(#\v (setf direction #C(0 1)))
(#\> (setf direction #C(1 0)))
(#\< (setf direction #C(-1 0)))))))
(intcode program :write-fn #'camera)
vacuum))))
(defun turn-left (d)
(* d #C(0 -1)))
(defun turn-right (d)
(* d #C(0 1)))
(defun all-visited-p (grid visited)
(iter (for (k v) in-hashtable grid)
(always (gethash k visited))))
(defun traverse-scaffold (program)
(let ((vacuum (get-state program))
(visited (make-hash-table))
(path nil))
(with-slots (grid position direction) vacuum
(setf (gethash position visited) t)
(iter (until (all-visited-p grid visited))
(cond ((gethash (+ position direction) grid)
(cond ((numberp (car path)) (incf (car path)))
(t (push 1 path)))
(incf position direction))
((gethash (+ position (turn-left direction)) grid)
(setf direction (turn-left direction))
(push 'L path))
((gethash (+ position (turn-right direction)) grid)
(setf direction (turn-right direction))
(push 'R path)))
(setf (gethash position visited) t)))
(reverse path)))
(defun path-to-string (path)
(format nil "~{~A~^,~}" path))
(defun is-digits (s)
(cl-ppcre:scan "^[0-9]+$" s))
(defun string-to-path (string)
(iter (for c in (cl-ppcre:split "," string))
(collect (if (is-digits c) (parse-integer c)
(intern c)))))
(defun compress-path (path)
(iter outer
(for i from 12 downto 1)
(for initial = (path-to-string path))
(for A = (path-to-string (subseq path 0 i)))
(for main-a = (cl-ppcre:regex-replace-all A initial "A"))
(when (<= (length A) 20)
(let* ((main-list (string-to-path main-a)))
(iter (until (not (eql (car main-list) 'A)))
(pop main-list))
(setf main-list (iter (for i in main-list)
(until (eql i 'A))
(collect i)))
(iter (for i from (length main-list) downto 1)
(for B = (path-to-string (subseq main-list 0 i)))
(for main-b = (cl-ppcre:regex-replace-all B main-a "B"))
(when (<= (length B) 20)
(let ((main-list (string-to-path main-b)))
(iter (while (or (eql 'B (car main-list))
(eql 'A (car main-list))))
(pop main-list))
(setf main-list (iter (for i in main-list)
(until (or (eql i 'A) (eql i 'B)))
(collect i)))
(let* ((C (path-to-string main-list))
(main-c (cl-ppcre:regex-replace-all C main-b "C")))
(when (and (<= (length C) 20)
(<= (length main-c) 20)
(every (lambda (c) (member c (list 'A 'B 'C))) (string-to-path main-c)))
(format t "~A~%" main-c)
(format t "~A~%" A)
(format t "~A~%" B)
(format t "~A~%" C))))))))))(defvar *path* (list "A,B,B,A,C,A,C,A,C,B"
"R,6,R,6,R,8,L,10,L,4"
"R,6,L,10,R,8"
"L,4,L,12,R,6,L,10"
"n"))
(defun solve-b (program)
(let* ((commands (make-queue))
(dust-collected 0)
(vacuum (bt:make-thread
(lambda ()
(let ((program (copy-seq program)))
(setf (aref program 0) 2)
(intcode program
:write-fn (lambda (c)
(cond ((<= c 128)
(format t "~C" (code-char c)))
(t (format t "~A" c)
(setf dust-collected c))))
:read-fn (lambda () (pop-queue commands))))))))
(iter (for l in *path*)
(iter (for c in-string l)
(push-queue (char-code c) commands))
(push-queue (char-code #\Newline) commands))
(bt:join-thread vacuum)
dust-collected))(defun problem-b () (format t "Problem 17 B: ~a~%" (solve-b *input*)))(defun intcode (program &key (read-fn #'read) (write-fn #'write))
(let ((memory (make-hash-table))
(relative-base 0))
(iter (for val in-vector program with-index i)
(setf (gethash i memory) val))
(flet ((fetch (mode address)
(gethash (ecase mode
(0 (gethash address memory 0))
(1 address)
(2 (+ relative-base
(gethash address memory 0))))
memory 0))
(store (mode address value)
(setf (gethash (ecase mode
(0 (gethash address memory 0))
(2 (+ relative-base
(gethash address memory 0))))
memory 0)
value)))
(iter (with pc = 0)
(for op = (fetch 1 pc))
(for instr = (mod op 100))
(for modes = (floor op 100))
(for (m1 m2 m3) = (list (mod modes 10)
(mod (floor modes 10) 10)
(mod (floor modes 100) 10)))
(for (o1 o2 o3) = (list (+ pc 1) (+ pc 2) (+ pc 3)))
(ecase instr
(1 (store m3 o3
(+ (fetch m1 o1)
(fetch m2 o2)))
(incf pc 4))
(2 (store m3 o3
(* (fetch m1 o1)
(fetch m2 o2)))
(incf pc 4))
(3 (store m1 o1 (funcall read-fn))
(incf pc 2))
(4 (funcall write-fn
(fetch m1 o1))
(incf pc 2))
(5 (if (not (zerop (fetch m1 o1)))
(setf pc (fetch m2 o2))
(incf pc 3)))
(6 (if (zerop (fetch m1 o1))
(setf pc (fetch m2 o2))
(incf pc 3)))
(7 (store m3 o3
(if (< (fetch m1 o1) (fetch m2 o2)) 1 0))
(incf pc 4))
(8 (store m3 o3
(if (= (fetch m1 o1) (fetch m2 o2)) 1 0))
(incf pc 4))
(9 (incf relative-base (fetch m1 o1))
(incf pc 2))
(99 (return-from intcode)))))))<<read-input>>
<<input>>
<<intcode>>
<<solve-a>><<initialize>>
<<structs>>
<<functions>>
<<input>>
<<problem-a>>
<<problem-b>>
(problem-a)
(problem-b)..^######.......................... ........#.......................... ........#.......................... ........#.......................... ........#.......................... ........#.......................... #########.......................... #.................................. #.................................. #.................................. #.................................. #.................................. #.................................. #.................................. #.................................. #.................................. #####.............................. ....#.............................. ....#.............................. ....#.............................. ....#.............................. ....#.............................. ....###########.................... ..............#.................... ..............#...........######### ..............#...........#........ ..............#...........#........ ..............#...........#........ ..............#...........#........ ..............#...........#........ ........#######...........#........ ........#.................#........ ........#.................#........ ........#.................#........ #######.#...........#######........ #.....#.#...........#.............. #.....#.#...........#.............. #.....#.#...........#.............. #.....#.#...#####...#.............. #.....#.#...#...#...#.............. #########...#...#...#.............. ......#.....#...#...#.............. ......###########...#.............. ............#.......#.............. ....#####...#.#######.............. ....#...#...#.#.................... ....#...#...#.#.................... ....#...#...#.#.................... ....#############.................. ........#...#.#.#.................. ......#######.#.#.................. ......#.#.....#.#.................. ......#.#.###########.............. ......#.#.#...#.#...#.............. #########.#...#.###########........ #.....#...#...#.....#.....#........ #.....#...#####.....#.....#........ #.....#.............#.....#........ #.....#.............#.....#........ #.....#.............#.....#........ #######.............#######........ Problem 17 A: 5740 Problem 17 B: 1022165
(def-suite aoc.2019.17)
(in-suite aoc.2019.17)
(run! 'aoc.2019.17)