day 14, falling sand part 1

day14.lisp

@@ -0,0 +1,142 @@
+;; https://adventofcode.com/2022/day/14
+(ql:quickload 'cl-ppcre)
+(ql:quickload 'alexandria)
+
+(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 (not sand-coords)
+      (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