199 lines
7.5 KiB
Common Lisp
199 lines
7.5 KiB
Common Lisp
;; https://adventofcode.com/2022/day/14
|
|
(ql:quickload 'cl-ppcre)
|
|
(ql:quickload 'alexandria)
|
|
|
|
;; (defparameter *day14-input-file* "day14-test.txt")
|
|
(defparameter *day14-input-file* "day14-input.txt")
|
|
|
|
(defclass arena ()
|
|
((grid :initarg :grid :initform (error "supply value for :grid"))
|
|
(leftmost :initarg :left :accessor leftmost)
|
|
(bottommost :initarg :bottom :accessor bottommost)
|
|
(rightmost :initarg :right :accessor rightmost)))
|
|
|
|
(defun make-arena (left right bottom)
|
|
(let ((cols-num (1+ (- right left)))
|
|
(rows-num (1+ bottom)))
|
|
(make-instance 'arena :left left :right right :bottom bottom
|
|
:grid (make-array (list rows-num cols-num)
|
|
:initial-element #\.))))
|
|
|
|
(defparameter *test-arena* nil)
|
|
|
|
|
|
;; (x y) -> (row col) in grid
|
|
(defun translate-coords (arena x y)
|
|
(list y (- x (leftmost arena))))
|
|
|
|
(defun get-place (arena x y)
|
|
(destructuring-bind (row col) (translate-coords arena x y)
|
|
(when (and (<= 0 row) (<= 0 col)
|
|
(< row (array-dimension (slot-value arena 'grid) 0))
|
|
(< col (array-dimension (slot-value arena 'grid) 1))
|
|
)
|
|
(aref (slot-value arena 'grid) row col))))
|
|
|
|
(defun set-place (arena x y value)
|
|
(destructuring-bind (row col) (translate-coords arena x y)
|
|
(when (and (<= 0 row) (<= 0 col)
|
|
(< row (array-dimension (slot-value arena 'grid) 0))
|
|
(< col (array-dimension (slot-value arena 'grid) 1))
|
|
)
|
|
(setf (aref (slot-value arena 'grid) row col) value))))
|
|
|
|
(defun input-line-to-rock-coords (line)
|
|
(mapcar (lambda (coords) (mapcar #'parse-integer (cl-ppcre:split "," coords)))
|
|
(cl-ppcre:split " -> " line)))
|
|
|
|
(defparameter *test-input-flat-coords* nil)
|
|
|
|
|
|
(defun put-rock-line (arena start-x end-x start-y end-y)
|
|
(let ((start-x (min start-x end-x))
|
|
(end-x (max start-x end-x))
|
|
(start-y (min start-y end-y))
|
|
(end-y (max start-y end-y)))
|
|
(loop for x from start-x to end-x do
|
|
(progn
|
|
(loop for y from start-y to end-y
|
|
do (set-place arena x y #\#))))))
|
|
|
|
(defun put-rock-lines (arena rock-coords-lines)
|
|
(loop
|
|
for rock-coord-line in rock-coords-lines
|
|
do (put-rock-chain arena rock-coord-line)))
|
|
|
|
|
|
(defparameter *test-input-coords-chains* nil)
|
|
|
|
(defun put-rock-chain (arena rock-coods-chain)
|
|
(do* ((coords-list rock-coods-chain (cdr coords-list))
|
|
(first-coords (first rock-coods-chain) (first coords-list))
|
|
(second-coords (second rock-coods-chain) (second coords-list)))
|
|
((not second-coords) "end")
|
|
(destructuring-bind ((start-x start-y) (end-x end-y))
|
|
(list first-coords second-coords)
|
|
(put-rock-line arena start-x end-x start-y end-y) )))
|
|
|
|
;; reinit things
|
|
;; (init-arena)
|
|
(defun init-arena ()
|
|
|
|
(setq *test-input-flat-coords*
|
|
(alexandria:flatten (mapcar #'input-line-to-rock-coords
|
|
(uiop:read-file-lines *day14-input-file*))))
|
|
;; building empty arena
|
|
(setq *test-arena*
|
|
(let ((flat-coords
|
|
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*)))))
|
|
(destructuring-bind (leftmost rightmost bottommost)
|
|
(loop
|
|
for (x y) on flat-coords
|
|
by #'cddr
|
|
minimize x into leftmost
|
|
maximize x into rightmost
|
|
maximize y into bottommost
|
|
finally (return (list leftmost rightmost bottommost)))
|
|
(make-arena leftmost rightmost bottommost))))
|
|
|
|
(setq *test-input-coords-chains*
|
|
(mapcar #'input-line-to-rock-coords
|
|
(uiop:read-file-lines *day14-input-file*)))
|
|
|
|
; this is second step of initialization
|
|
(put-rock-lines *test-arena* *test-input-coords-chains*))
|
|
|
|
(defun is-point-air (x y arena)
|
|
(or (eq #\. (get-place arena x y))
|
|
(not (get-place arena x y))))
|
|
(defun sand-check-next-move (sand-x sand-y arena)
|
|
(let* ((next-y (1+ sand-y))
|
|
(possible-next-steps (list (list sand-x next-y)
|
|
(list (1- sand-x) next-y)
|
|
(list (1+ sand-x) next-y))))
|
|
(first (remove-if-not (lambda (coords)
|
|
(is-point-air (first coords) (second coords) arena))
|
|
possible-next-steps))))
|
|
(defun out-of-bounds (x y arena)
|
|
(not (get-place arena x y)))
|
|
|
|
|
|
(defun drop-sand-unit (arena)
|
|
(do*
|
|
((prev-coords nil sand-coords)
|
|
(sand-coords '(500 0) (sand-check-next-move
|
|
(first sand-coords) (second sand-coords) arena)))
|
|
((or (not sand-coords) ; sand rests
|
|
(out-of-bounds (first sand-coords) (second sand-coords) arena)) ; end condition - rest or out of bounds
|
|
(when (or (not sand-coords)
|
|
(equal prev-coords '(500 0))) ; if sand rests at entry point
|
|
(set-place arena (first prev-coords) (second prev-coords) #\x)))
|
|
;; (format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)
|
|
))
|
|
|
|
(defun drop-sand-unit-abyss (arena)
|
|
(do ((sand-units 0 (1+ sand-units))
|
|
(drop-result (drop-sand-unit arena) (drop-sand-unit arena)))
|
|
((not drop-result)
|
|
sand-units)))
|
|
|
|
;; ok, could return arena
|
|
(init-arena)
|
|
(drop-sand-unit-abyss *test-arena*) ; 901
|
|
|
|
;;; PART 2
|
|
|
|
(defun init-arena-2 ()
|
|
|
|
(setq *test-input-flat-coords*
|
|
(alexandria:flatten (mapcar #'input-line-to-rock-coords
|
|
(uiop:read-file-lines *day14-input-file*))))
|
|
;; building empty arena
|
|
(setq *test-arena*
|
|
(let ((flat-coords
|
|
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*)))))
|
|
(destructuring-bind (leftmost rightmost bottommost)
|
|
(loop
|
|
for (x y) on flat-coords
|
|
by #'cddr
|
|
minimize x into leftmost
|
|
maximize x into rightmost
|
|
maximize y into bottommost
|
|
finally (return (list leftmost rightmost bottommost)))
|
|
(let ((new-bottommost (+ 2 bottommost))
|
|
(new-leftmost (min leftmost
|
|
(- 500 (* 2 bottommost))))
|
|
(new-rightmost (max rightmost
|
|
(+ 500 (* 2 bottommost)))))
|
|
(make-arena new-leftmost new-rightmost new-bottommost)))))
|
|
;; and put floor
|
|
(let ((floor-y (bottommost *test-arena*))
|
|
(floor-x-start (leftmost *test-arena*))
|
|
(floor-x-end (rightmost *test-arena*)))
|
|
(put-rock-line *test-arena* floor-x-start floor-x-end floor-y floor-y))
|
|
|
|
(setq *test-input-coords-chains*
|
|
(mapcar #'input-line-to-rock-coords
|
|
(uiop:read-file-lines *day14-input-file*)))
|
|
|
|
; this is second step of initialization
|
|
(put-rock-lines *test-arena* *test-input-coords-chains*))
|
|
|
|
;; rewriting previous. otherwise endless loop
|
|
(defun drop-sand-unit (arena)
|
|
(do*
|
|
((prev-coords '(500 0) sand-coords)
|
|
(sand-coords (sand-check-next-move 500 0 arena)
|
|
(sand-check-next-move
|
|
(first sand-coords) (second sand-coords) arena)))
|
|
((or (not sand-coords) ; sand rests
|
|
(out-of-bounds (first sand-coords) (second sand-coords) arena)) ; end condition - rest or out of bounds
|
|
(when (and (not sand-coords)
|
|
(not (equal prev-coords '(500 0)))) ; if sand rests
|
|
(set-place arena (first prev-coords) (second prev-coords) #\x)))
|
|
;; (format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)
|
|
))
|
|
|
|
(init-arena-2)
|
|
(print (1+ (drop-sand-unit-abyss *test-arena*)))
|