day 14, part 2 - endless pyramid

This commit is contained in:
efim 2022-12-15 17:40:22 +00:00
parent c82f5473ba
commit 6757e3ba23
2 changed files with 91 additions and 2 deletions

View File

@ -350,3 +350,36 @@
(drop-result (drop-sand-unit arena) (drop-sand-unit arena)))
((not drop-result)
sand-units)))
;;; PART 2
;; let's not do floor infinite.
;; let's just give it enough left-to-right?
;; since the triangle is 2 right angle triangles, then bottom is 2x height
;; so, let's add 4x height of the floor?
;;
;; new bottommost =
(+ 2 bottommost)
;; new leftmost =
(min leftmost
(- 500 (* 2 bottommost)))
;; new rightmost =
(max rightmost
(+ 500 (* 2 bottommost)))
;; and add new rock-line?
;; just through function that adds a rockline
(slot-value *test-arena* 'grid)
;; and now i'd like a more compact printing.
;; how'd i do that?
;; surely there's a way to get access ot a slice of the 2d array?
(let* ((arena *test-arena*)
(array (slot-value arena 'grid)))
(dotimes (row (array-dimension array 0))
(dotimes (col (array-dimension array 1))
(format t "~a" (aref array row col)))
(terpri)))
(drop-sand-unit *test-arena*)

View File

@ -2,6 +2,7 @@
(ql:quickload 'cl-ppcre)
(ql:quickload 'alexandria)
;; (defparameter *day14-input-file* "day14-test.txt")
(defparameter *day14-input-file* "day14-input.txt")
(defclass arena ()
@ -75,7 +76,7 @@
(put-rock-line arena start-x end-x start-y end-y) )))
;; reinit things
(init-arena)
;; (init-arena)
(defun init-arena ()
(setq *test-input-flat-coords*
@ -124,7 +125,8 @@
(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 (not sand-coords)
(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)
))
@ -140,3 +142,57 @@
(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*)))