Advent-of-Code/day14-scratch.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*)