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-2018-13) - 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"))<<packages>>
(defpackage :aoc-2018-13
(:use :common-lisp
:iterate
:parseq
:fiveam)
(:export :problem-a
:problem-b))
(in-package :aoc-2018-13)The elves are still poor planners. They’ve devised an incredibly complex track-and-cart system.
A simple closed loop:
/----\ | | | | \----/
Two loops with intersections.
/-----\ | | | /--+--\ | | | | \--+--/ | | | \-----/
Also in the input are carts whose positions are given as <, >, v, or ^ (the arrow pointing in their direction of movement).
The only positions on the map that actually matter are the curves and the intersections. Those are stored as the keys in a hash table. The value of the hash table entries will be a function which can be passed a cart. The function returns the cart with appropriate state changes (heading and next-turn values).
For /, whether the cart is moving up or down it will “turn
right”. That is, its initial heading will be either (0,-1) or
(0,1) and its next heading will be (1,0) or (-1,0),
respectively. If it’s going horizontally, it will turn left. I call
this a “right-curve” because of the upward-and-right direction of the
/.
For \ the result is the opposite. I call this the “left-curve”.
(defun turn (cart direction)
(list (first cart)
(* (second cart) direction)
(third cart)))
(defun turn-right (cart)
(turn cart #C(0 1)))
(defun turn-left (cart)
(turn cart #C(0 -1)))
(defun left-curve (cart)
(if (= (realpart (second cart)) 0)
(turn-left cart)
(turn-right cart)))
(defun right-curve (cart)
(if (= (realpart (second cart)) 0)
(turn-right cart)
(turn-left cart)))
(defun inter (cart)
(destructuring-bind (position heading next-turn)
cart
(case next-turn
(:left (turn-left (list position heading :straight)))
(:straight (list position heading :right))
(:right (turn-right (list position heading :left))))))(defun cart-direction (c)
(case c
(#\< #C(-1 0))
(#\> #C(1 0))
(#\v #C(0 1))
(#\^ #C(0 -1))))
(defun is-cart (c)
(member c '(#\< #\> #\v #\^)))
(defun parse-input (lines)
(let* ((grid (make-hash-table))
(carts nil))
(iter (for y from 0)
(for line in lines)
(iter (for x from 0)
(for c in-string line)
(unless (is-cart c)
(case c
(#\\ (setf (gethash (complex x y) grid) 'left-curve))
(#\/ (setf (gethash (complex x y) grid) 'right-curve))
(#\+ (setf (gethash (complex x y) grid) 'inter))
(otherwise nil)))
(when (is-cart c)
(push (list (complex x y) (cart-direction c) :left) carts))))
(list grid carts)))(defun read-input (file)
(iter (for line in-file file using #'read-line)
(collect line)))(defparameter *input*
(parse-input (read-input "input/13.txt")))Part 1 asks for the coordinates of the first collision between carts.
Carts move 1 at a time starting at the top left, moving left to right and top to bottom. A time tick occurs after every cart has moved.
When a cart encounters an intersection it cycles through: left, straight, right, repeat.
A cart’s state consists of: position, heading, turn-state.
Before a tick can begin evaluating the movements and collisions the list needs to be sorted. Below is a simple sorting function that ensures carts are in order from upper-left first to lower-right last.
(defun sort-carts (carts)
(sort carts (lambda (p1 p2)
(or (< (imagpart p1) (imagpart p2))
(and (= (imagpart p1) (imagpart p2))
(< (realpart p1) (realpart p2)))
(= p1 p2)))
:key #'first))The carts don’t move simultaneously, instead they move one at a time based on the sorted order. Each cart gets popped off the sorted list one at a time. If there is no collision, it is kept in the result. If there is a collision (on either side) all carts in that position are removed from both the result and the sorted list.
(defun has-collision (carts)
(not (= (length carts)
(length (remove-duplicates carts :key #'first)))))
(defun move-cart (grid cart)
(destructuring-bind (position heading next-turn) cart
(incf position heading)
(if (gethash position grid)
(funcall (gethash position grid) (list position heading next-turn))
(list position heading next-turn))))
(defun tick (grid carts)
(let ((sorted (sort-carts (copy-seq carts)))
(result nil))
(iter (until (null sorted))
(let ((cart (move-cart grid (pop sorted))))
(cond ((or (has-collision (cons cart result))
(has-collision (cons cart sorted)))
(format t "Collision at ~A~%" (first cart))
(setf result (remove (first cart) result :key #'first))
(setf sorted (remove (first cart) sorted :key #'first)))
(t (push cart result)))))
result))NB: remove with the :key parameter doesn’t work quite like I’d
thought. From using remove-duplicates I had expected that the object
and contents of the sequence could share the same type, and the
function passed to :key would apply to them both. That’s wrong. For
remove, the type of the object should match the type of the sequence
contents after :key has been applied.
(remove-duplicates '((1 2) (3 2)) :key #'second)
;; => ((3 2))
(remove '(3 2) '((1 2) (3 2)) :key #'second)
;; => ((1 2) (3 2))
(remove 2 '((1 2) (3 2)) :key #'second)
;; => nilI don’t know where I got that confusion, but it meant my program was wrong. I was still reducing the total number of carts, but not by all the carts that should’ve been removed (only the one that had initiated the collision). So my program terminated, and I thought I had answers, but I didn’t.
(defun solve (scenario &optional (limit 1000))
(let ((grid (first scenario))
(carts (second scenario)))
(when *debug*
(format t "~A~%" carts))
(iter (for i from 0 to limit)
(setf carts (tick grid carts))
(when *debug*
(format t "~A~%" carts))
(when (= 1 (length carts))
(return carts))
(when (null carts)
(return nil)))))Initially I had the solve stop with the first collision or it reached a time limit. Now I have it continue until there are 0 or 1 carts remaining or the time limit is reached. I modified tick so that it would remove the colliding carts and return the now reduced list.
<<turning-and-intersection-handling>>
<<parse-input>>
<<read-input>>
<<sort-carts>>
<<tick>>
<<solve>>(defparameter *debug* nil)
<<initialize>>
<<functions>>
<<input>>
(format t "How many carts? ~A~%" (length (second *input*)))
(format t "~A~%" (solve *input* 12000))How many carts? 17 Collision at #C(83 121) Collision at #C(115 104) Collision at #C(8 57) Collision at #C(64 109) Collision at #C(101 22) Collision at #C(49 106) Collision at #C(136 87) Collision at #C(108 89) ((#C(102 144) -1 STRAIGHT))
/->-\ | | /----\ | /-+--+-\ | | | | | v | \-+-/ \-+--/ \------/
Above is a simple test case, its result is 7,3.
/>-<\ | | | /<+-\ | | | v \>+</ | | ^ \<->/
The above is the test case for Part 2, its result is 6,4
(let ((test-case
`("/->-\\ "
"| | /----\\"
"| /-+--+-\\ |"
"| | | | v |"
"\\-+-/ \\-+--/"
" \\------/ "))
(*debug* nil))
(format t "~{~A~%~}" test-case)
(format t "~A~%" (solve (parse-input test-case) 20)))
(let ((test-case
'("/>-<\\ "
"| | "
"| /<+-\\"
"| | | v"
"\\>+</ |"
" | ^"
" \\<->/")))
(format t "~{~A~%~}" test-case)
(format t "~A~%" (solve (parse-input test-case) 20)))/->-\ | | /----\ | /-+--+-\ | | | | | v | \-+-/ \-+--/ \------/ Collision at #C(7 3) NIL />-<\ | | | /<+-\ | | | v \>+</ | | ^ \<->/ Collision at 2 Collision at #C(2 4) Collision at #C(6 4) Collision at #C(2 4) ((#C(6 4) #C(0 -1) LEFT))