2022.14.org

Day 14

Executing this code

If you have a lisp installation, emacs, org-mode, and org-babel support for lisp installed you can run this by:

1. Starting slime (M-x slime)
2. Typing C-c C-c in the block initialize.
3. In the repl type (in-package :aoc-2022-14)
4. Typing C-c C-c in the block answers

Initial stuffs

Packages to load

(unless (find-package :priority-queue)
  (ql:quickload "priority-queue"))
(unless (find-package :cl-ppcre)
  (ql:quickload "cl-ppcre"))
(unless (find-package :parseq)
  (ql:quickload "parseq"))
(unless (find-package :lparallel)
  (ql:quickload "lparallel"))
(unless (find-package :fiveam)
  (ql:quickload "fiveam"))
(unless (find-package :series)
  (ql:quickload "series"))
(unless (find-package :cl-permutation)
  (ql:quickload "cl-permutation"))
(unless (find-package :bordeaux-threads)
  (ql:quickload "bordeaux-threads"))

Create package for this day

<<packages>>
(defpackage :aoc-2022-14
  (:use :common-lisp
        :parseq
        :fiveam)
  (:export :problem-a
           :problem-b))
(in-package :aoc-2022-14)

Input

(defun parse-line (line)
  (loop for (x y) on (cl-ppcre:all-matches-as-strings "\\d+" line) by #'cddr
        collect (list (parse-integer x) (parse-integer y))))

(defun process-stream (in)
  (loop for line = (read-line in nil)
        while line
        collect (parse-line line)))
(defun read-input (file)
  (with-open-file (in file)
    (process-stream in)))

(defparameter *input*
  (read-input "input/14.txt"))

Part 1

(defun paths-to-map (paths)
  (loop for path in paths
        with map = (make-hash-table)
        with max-y = sb-ext:double-float-negative-infinity
        finally (return (list map max-y))
        do (loop for ((a b) (c d)) on path
                 while (and a b c d)
                 do (setf max-y (max max-y b d))
                 if (= a c)
                   do (loop for y from (min b d) to (max b d)
                            for point = (complex a y)
                            do (setf (gethash point map) #\#))
                 else
                   do (loop for x from (min a c) to (max a c)
                            for point = (complex x b)
                            do (setf (gethash point map) #\#)))))

(defun next-point (map sand)
  (cond ((not (gethash (+ sand #C(0 1)) map))
         (+ sand #C(0 1)))
        ((not (gethash (+ sand #C(-1 1)) map))
         (+ sand #C(-1 1)))
        ((not (gethash (+ sand #C(1 1)) map))
         (+ sand #C(1 1)))
        (t sand)))


(defun falling-sand (map y &optional (source #C(500 0)))
  (loop with sand = 0
        for s = source
        finally (return sand)
        do (loop for next = (next-point map s)
                 while (/= next s)
                 while (< (imagpart s) y)
                 finally (when (= next s) (incf sand))
                 do (setf s next))
        do (setf (gethash s map) t)
        while (< (imagpart s) y)))

(defun solve-a (paths)
  (destructuring-bind (map y) (paths-to-map paths)
    (falling-sand map y)))

(defun problem-a () (format t "Problem 14 A: ~a~%" (solve-a *input*)))

Part 2

(defun next-point-floor (map y sand)
  (cond ((= (imagpart sand) (+ y 1))
         sand)
        ((not (gethash (+ sand #C(0 1)) map))
         (+ sand #C(0 1)))
        ((not (gethash (+ sand #C(-1 1)) map))
         (+ sand #C(-1 1)))
        ((not (gethash (+ sand #C(1 1)) map))
         (+ sand #C(1 1)))
        (t sand)))

(defun falling-sand-floor (map y &optional (source #C(500 0)))
  (loop with sand = 0
        for s = source
        finally (return (values sand map))
        do (loop for next = (next-point-floor map y s)
                 while (/= next s)
                 finally (when (= next s) (incf sand))
                 do (setf s next))
        do (setf (gethash s map) #\o)
        while (/= s source)))


(defun faster-falling-sand-floor? (map y &optional (source #C(500 0)))
  (loop with sand = 0
        with path = (list source)
        with s = source
        for next = (next-point-floor map y s)
        until (gethash source map)
        finally (return (values sand map))
        if (= next s)
          do (setf (gethash s map) #\o)
             (incf sand)
             (setf s (pop path))
        else
          do
             (push s path)
             (setf s next)))

(defun solve-b (paths)
  (destructuring-bind (map y) (paths-to-map paths)
    (faster-falling-sand-floor? map y)))

(defun time-b (paths)
  (time (destructuring-bind (map y) (paths-to-map paths)
          (print (faster-falling-sand-floor? map y))))
  (time (destructuring-bind (map y) (paths-to-map paths)
          (print (falling-sand-floor map y)))))

(defun problem-b () (format t "Problem 14 B: ~a~%" (solve-b *input*)))

Putting it all together

<<read-input>>
<<input>>

<<initialize>>
<<structs>>
<<functions>>
<<input>>
<<problem-a>>
<<problem-b>>
(problem-a)
(problem-b)

Answer

Problem 14 A: 655
Problem 14 B: 26484

Test Cases

(def-suite aoc.2022.14)
(in-suite aoc.2022.14)

(defparameter *sample-input*
  "498,4 -> 498,6 -> 496,6
503,4 -> 502,4 -> 502,9 -> 494,9")

(defparameter *sample*
  (with-input-from-string (in *sample-input*)
    (process-stream in)))

(test samples-match
  (is (= 24 (solve-a *sample*)))
  (is (= 93 (solve-b *sample*))))

(run! 'aoc.2022.14)

Test Results

Running test suite AOC.2022.14
 Running test SAMPLES-MATCH ..
 Did 2 checks.
    Pass: 2 (100%)
    Skip: 0 ( 0%)
    Fail: 0 ( 0%)

Thoughts