commit - 3485ab4d7bc8df427f64ce0fdf79a9cdb55bccf5
commit + a94658845d70a2abb88f966d8378681a780ae91d
blob - bdbde5c5f965d870d6703adf32aa3f5e1cf7ee4f
blob + ab288264274f5a88f49c2671ad60723e051559ca
--- src/day-10.lisp
+++ src/day-10.lisp
when new-dir
do (return (values dir new-point))))
+(defun find-position-pipe-type (pos started-at finished-at)
+ (let ((diff-s (point- started-at pos))
+ (diff-e (point- finished-at pos)))
+ (or (switch (diff-s :test #'equal)
+ ((cons 1 0)
+ (switch (diff-e :test #'equal)
+ ((cons 0 1) #\F)
+ ((cons -1 0) #\-)
+ ((cons 0 -1) #\L)))
+ ((cons 0 1)
+ (switch (diff-e :test #'equal)
+ ((cons -1 0) #\7)
+ ((cons 0 -1) +char-pipe+)))
+ ((cons -1 0)
+ (when (equal diff-e (cons 0 -1)) #\J)))
+ (error "Invalid start and end nodes ~A / ~A" diff-s diff-e))))
+
(defun task-1 (map dir pos)
- (loop for steps from 1
+ (loop with loop = (make-hash-table :test 'equal)
+ with coming-from = nil
+ for steps from 1
for pipe = (map-cell map pos)
+ do (setf (gethash pos loop) pipe)
when (char= pipe #\S)
- do (return (/ steps 2))
+ do (return (values (/ steps 2)
+ loop
+ coming-from))
do (setf dir (walk dir pipe))
do (assert dir)
- do (setf pos (point+ pos dir))))
+ do (setf coming-from pos
+ pos (point+ pos dir))))
+(defun crossing-pipe-p (pipe)
+ (cond
+ ((char= pipe +char-pipe+) t)
+ ((char= pipe #\L) #\7)
+ ((char= pipe #\F) #\J)))
+
+(defun task-2 (map loop)
+ (loop for y from 0 below (input-map-height map)
+ for in-loop? = nil
+ for crossing-when = nil
+ sum (loop for x from 0 below (input-map-width map)
+ for point = (cons x y)
+ for pipe = (map-cell map point)
+ for loop-pipe = (gethash point loop)
+ for crossing-pipe? = (and loop-pipe
+ (or (eql loop-pipe crossing-when)
+ (crossing-pipe-p loop-pipe)))
+ when (characterp crossing-pipe?)
+ do (setf crossing-when crossing-pipe?
+ crossing-pipe? nil)
+ when crossing-pipe?
+ do (setf in-loop? (not in-loop?))
+ when (and in-loop? (not loop-pipe))
+ sum 1)))
+
(defun day-10 (input)
(let* ((map (make-map input))
(start-pos (find-start-pos map)))
(multiple-value-bind (dir pos)
(find-first-step map start-pos)
- (task-1 map dir pos))))
+ (multiple-value-bind (task-1 loop coming-from)
+ (task-1 map dir pos)
+ (setf (gethash start-pos loop)
+ (find-position-pipe-type start-pos pos coming-from))
+ (values task-1 (task-2 map loop))))))
blob - 1b1bf5c0c4e5bf66be9a275669b2ec6b4c5a0015
blob + c4be03cde4ff8cfbc13108129deb87cd12e04e6b
--- src/utils.lisp
+++ src/utils.lisp
#:map-cell
#:map-integer-at
#:point+
+ #:point-
#:point-x
#:point-y
#:point-neighbours
:width width
:height height))))
-(declaim (inline point+ point-x point-y)
+(declaim (inline point+ point- point-x point-y)
(ftype (function (cons) fixnum) point-x point-y))
(defun point-x (point)
(the fixnum (+ (point-y point-a)
(point-y point-b)))))
+(defun point- (point-a point-b)
+ (cons (the fixnum (- (point-x point-a)
+ (point-x point-b)))
+ (the fixnum (- (point-y point-a)
+ (point-y point-b)))))
+
(declaim (inline map-cell map-integer-at)
(ftype (function (input-map cons) character) map-cell))
blob - 6c28da88014fe29274f9e6a38b229c057ae9a2e5
blob + 521c91c6b6bd06d725c5581527571812e4b676fc
--- t/day-10.lisp
+++ t/day-10.lisp
SJ.L7
|F--J
LJ...")
- (assert= 8 task-1)))
+ (assert= 8 task-1))
+
+ (multiple-value-bind (task-1 task-2)
+ (aoc:run-day 10 "...........
+.S-------7.
+.|F-----7|.
+.||.....||.
+.||.....||.
+.|L-7.F-J|.
+.|..|.|..|.
+.L--J.L--J.
+...........")
+ (declare (ignore task-1))
+ (assert= 4 task-2))
+ (multiple-value-bind (task-1 task-2)
+ (aoc:run-day 10 "..........
+.S------7.
+.|F----7|.
+.||....||.
+.||....||.
+.|L-7F-J|.
+.|..||..|.
+.L--JL--J.
+..........")
+ (declare (ignore task-1))
+ (assert= 4 task-2))
+ (multiple-value-bind (task-1 task-2)
+ (aoc:run-day 10 ".F----7F7F7F7F-7....
+.|F--7||||||||FJ....
+.||.FJ||||||||L7....
+FJL7L7LJLJ||LJ.L-7..
+L--J.L7...LJS7F-7L7.
+....F-J..F7FJ|L7L7L7
+....L7.F7||L7|.L7L7|
+.....|FJLJ|FJ|F7|.LJ
+....FJL-7.||.||||...
+....L---J.LJ.LJLJ...")
+ (declare (ignore task-1))
+ (assert= 8 task-2))
+ (multiple-value-bind (task-1 task-2)
+ (aoc:run-day 10 "FF7FSF7F7F7F7F7F---7
+L|LJ||||||||||||F--J
+FL-7LJLJ||||||LJL-77
+F--JF--7||LJLJ7F7FJ-
+L---JF-JLJ.||-FJLJJ7
+|F|F-JF---7F7-L7L|7|
+|FFJF7L7F-JF7|JL---7
+7-L-JL7||F7|L7F-7F7|
+L.L7LFJ|||||FJL7||LJ
+L7JLJL-JLJLJL--JLJ.L")
+ (declare (ignore task-1))
+ (assert= 10 task-2)))
