Advent-of-Code/day14-scratch.lisp

386 lines
12 KiB
Common Lisp

;; https://adventofcode.com/2022/day/14
;; so, 2d space vertical and left-right. point from which sand falls down and lines (likely horizontal || vertical) that collide with falling sand
;; gathering input. i've only thought of doing initialization in two sweeps.
;;
;; one to get "leftmost" and "rightmost", top & bottom coords.
;; so that i'm putting it all into one class that has accessors that translate it to
;; ordinary 2d array
;;
;; sand is pouring from (500, 0) - (column, row) - from
;; columns : left -> right
;; rows : top to bottom
;; top is already 0
;;
;; chars: #\. - empty space
;; #\# - stone
;; #\o - falling sand ; will not be actually stored I suppose
;; #\x - resting sand
(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 #\.))))
(make-array '(2 5) :initial-element "hello")
;; now. translation for coordinates, and in a way that would allow writing into place?
;; can i just defmethod getf for nonexistent place?
(defparameter *test-arena* (make-arena 100 110 7))
(setf (aref (slot-value *test-arena* 'grid) 0 4) #\*)
;; or just do through macros? nah, try functions first, it's just i liked idea of aref
;; (x y) -> (row col) in grid
(defun translate-coords (arena x y)
(list y (- x (leftmost arena))))
(destructuring-bind (rrow ccol) (translate-coords *test-arena* 104 2)
(list rrow ccol))
(defun get-place (arena x y)
(destructuring-bind (row col) (translate-coords arena x y)
(aref (slot-value arena 'grid) row col)))
(get-place *test-arena* 104 0)
(defun set-place (arena x y value)
(destructuring-bind (row col) (translate-coords arena x y)
(setf (aref (slot-value arena 'grid) row col) value)))
(set-place *test-arena* 104 1 #\&)
(slot-value *test-arena* 'grid)
;; ok. now funciton that would add lines from input?
(ql:quickload 'cl-ppcre)
(defun input-line-to-rock-coords (line)
(mapcar (lambda (coords) (mapcar #'parse-integer (cl-ppcre:split "," coords)))
(cl-ppcre:split " -> " line)))
(input-line-to-rock-coords " 503,4 -> 502,4 -> 502,9 -> 494,9 ")
;; now. i want to do first pass and find leftmost, rightmost and bottommost
(defparameter *day14-input-file* "day14-test.txt")
(mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*))
;; now find flatten list in Alexandria
(ql:quickload 'alexandria)
(defparameter *test-input-flat-coords*
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*))))
;; well, it fully flattens it by default. maybe there it's configurable?
;; using destructuring of pairs would be better
(loop
for (x y) on *test-input-flat-coords*
by #'cddr
do (format t "x:~a y:~a~%" x y))
(loop
for (x y) on *test-input-flat-coords*
by #'cddr
minimize x
do (print x))
(loop
for (x y) on *test-input-flat-coords*
by #'cddr
minimize y
do (print y))
(loop
for (x y) on *test-input-flat-coords*
by #'cddr
collect x into x-es
collect y into y-es
finally (return (list (apply #'min x-es) (apply #'min y-es))))
;; this : I was forgetting :by #'cddr
;; here's limits
(let ((flat-coords
(alexandria:flatten (mapcar #'input-line-to-rock-coords (uiop:read-file-lines *day14-input-file*))
)))
(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))))
;; next - build arena
;; 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))))
(slot-value *test-arena* 'grid)
;; now adding rock lines from coord list
'(((498 4) (498 6) (496 6)) ((503 4) (502 4) (502 9) (494 9)))
;; and one line is
(defparameter *test-rock-line-coords* '((498 4) (498 6) (496 6)))
(loop
for (x y) in *test-rock-line-coords*
do (format t "x:~a y:~a~%" x y))
;; can i take two at a time?
;; well, maybe use DO
(do* ((coords-list *test-rock-line-coords* (cdr coords-list))
(first-coords (first *test-rock-line-coords*) (first coords-list))
(second-coords (second *test-rock-line-coords*) (second coords-list)))
((not second-coords) "end")
(format t "~a -> ~a, in ~a~%" first-coords second-coords coords-list))
;; yup.
;; now in this DO i have "start point" -> "end point"
;; let's do separate function that
(let ((start-x 10)
(start-y 1)
(end-x 25)
(end-y 1))
(loop for x from start-x to end-x do
(loop for y from start-y to end-y do
(format t "(~a, ~a), " x y)))
(terpri))
(let ((start-x 100)
(start-y 2)
(end-x 100)
(end-y 11))
(loop for x from start-x to end-x do
(loop for y from start-y to end-y do
(format t "(~a, ~a), " x y)))
(terpri))
;; that works
(defun put-rock-line (arena start-x end-x 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 #\#)))))
;; yas.
;; now do this for each pair of coords
(put-rock-line *test-arena* 101 109 1 1)
(setq *test-arena* (make-arena 100 110 7))
(slot-value *test-arena* 'grid)
(get-place *test-arena* 101 1)
(put-rock-line *test-arena* 101 109 1 1)
(set-place *test-arena* 101 1 #\#)
(set-place *test-arena* 102 1 #\#)
;; copy over previous per-2-coords-loop:
(loop
for (x y) in *test-rock-line-coords*
do (format t "x:~a y:~a~%" x y))
;; can i take two at a time?
;; well, maybe use DO
(do* ((coords-list *test-rock-line-coords* (cdr coords-list))
(first-coords (first *test-rock-line-coords*) (first coords-list))
(second-coords (second *test-rock-line-coords*) (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 *test-arena* start-x end-x start-y end-y) ))
;; yes
(array-dimension (make-array '(3 10)) 1)
(get-place *test-arena* 101 3)
(get-place *test-arena* 0 0)
(slot-value *test-arena* 'grid)
;; oh, it doesn't work when numbers are in wrong order.
;; ugh the LOOP for i from 9 to 3
;; how do i deal with that?
(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-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) )))
(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)
(setq *test-input-coords-chains*
(mapcar #'input-line-to-rock-coords
(uiop:read-file-lines *day14-input-file*)))
(slot-value *test-arena* 'grid)
(put-rock-lines *test-arena* *test-input-coords-chains*)
;; i think this works.
;; seems to be the complete initialization
;; now for the sand simulation part.
;; again, envision this as lots of loops
;; inner loop - one new sand
;; created at (500, 0), starts dropping
;; either until out-of-bounds
;; or settled by checks of lower-part
;; out-of-bounds is air
;; and . char is air
(defun is-point-air (x y arena)
(or (eq #\. (get-place arena x y))
(not (get-place arena x y))))
(is-point-air 498 4 *test-arena*)
(is-point-air 498 3 *test-arena*)
(is-point-air 500 0 *test-arena*)
(is-point-air 502 3 *test-arena*)
(is-point-air 502 4 *test-arena*)
(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))))
;; let's return next step or nil if it rests
(sand-check-next-move 502 3 *test-arena*)
(get-place *test-arena* 501 4)
(get-place *test-arena* 503 4)
(sand-check-next-move 500 7 *test-arena*)
(sand-check-next-move 500 8 *test-arena*)
(get-place *test-arena* 501 4)
(get-place *test-arena* 503 4)
(aref (slot-value *test-arena* 'grid) 0)
(array-storage-vector (slot-value *test-arena* 'grid))
(defun out-of-bounds (x y arena)
(not (get-place arena x y)))
;; well, this seems to work
;; now the one grain loop
(let ((arena *test-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 (not sand-coords)
(set-place arena (first prev-coords) (second prev-coords) #\x)))
(format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)))
(init-arena)
(slot-value *test-arena* 'grid)
(not (get-place *test-arena* 500 0 ))
(set-place *test-arena* 500 0 #\x)
(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 (not sand-coords)
(set-place arena (first prev-coords) (second prev-coords) #\x)))
(format t "sc: ~a, prev: ~a~%" sand-coords prev-coords)))
;; ok, i got inner loop
;; now what? run that loop until the grain of sand ends up our of bounds
;; what are we calculating?
;; "how many units of sand come to rest until they start falling into abyss"
;; so. do ?
(let ((arena *test-arena*))
(do ((sand-units 0 (1+ sand-units))
(drop-result (drop-sand-unit arena) (drop-sand-unit arena)))
((not drop-result)
sand-units)))
(slot-value *test-arena* 'grid)
(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)))
;;; 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*)