Advent-of-Code/day17-scratch.lisp

;; https://adventofcode.com/2022/day/17

;; so. cool.
;; one thought - i'd want to learn how to specify smaller argument types for optimizations
;; another - better think of optimizing checks
;; one more - reads from array should be faster, write new figure only after it comes to rest

;; thinking of checks. i could have separate methods that check 'possible left|right|down movement'

;; so. is there a cycle datastructure?
;; yes, but not in standart library, just cycle the list on itself
(defun circular (items)
              (setf (cdr (last items)) items)
              items)

(circular '(2 5 8 ))

(type-of '(1 . 7))
(typep '(1 . 7) '(cons fixnum fixnum))

(declaim (ftype (function (string (cons fixnum fixnum)) string) test-types))
(defun test-types (s tup)
  (format nil "~a here, sup ~a~%" tup s))
(test-types "hello" '(1 . 4))

;; cool, but i want for separate arguments, so that it could be also used in defgeneric ?

(defun test-types-2 (ss tt str)
  (declare (type string ss)
           (type (cons fixnum string) tt)
           ;; (type 'string str)
           )
  (format t "~a ~a ~a" ss tt str))
(test-types-2 "hello" '(1 . "yy") 13)
;; that works!

;; and will probably work with defgeneric?
(defgeneric test-types-3 (obj str)
  (declare (ignore str)))
;; doesn't work.
;; http://www.lispworks.com/documentation/HyperSpec/Body/m_defgen.htm
;; only allows "optimize" declaration
;; The special, ftype, function, inline, notinline, and declaration declarations are not permitted. Individual implementations can extend the declare option to support additional declarations.
;; OK


;; so, do i want to have separate classes and generic methods for checking left | bottom | right?
;; possibly, yes. and for printing
;; how do I select "anchor point"? from which i'd do checking?
;; well, HM. it could be always lowest point, i guess
;; how'd i do the check for moving left?
;; pass in array, and coord of the anchor, compute locally coords to check and check array content at that point

(defparameter *test-grid* nil)
(defun init-test-grid (height)
  (declaim (type fixnum height))
  (setq *test-grid*
        (let*
            ((grid (make-array `(,height 7) :initial-element #\.))
             (rownum (1- (array-dimension grid 0)))
             (rowsize (array-dimension grid 1))
             (row (make-array rowsize
                              :displaced-to grid
                              :displaced-index-offset (* rownum rowsize))))
          (loop for i from 0 below (array-total-size row) do
            (setf (aref row i) #\_))
          grid))
  nil)
(init-test-grid 200)

(defun print-grid (grid )
  (let ((rows (array-dimension grid 0))
        (rowsize (array-dimension grid 1)))
    (terpri)
    (loop for rownum from 0 below rows
          do (let ((row-arr
                     (make-array rowsize
                                 :displaced-to grid
                                 :displaced-index-offset (* rownum rowsize))))
               (format t "|~a|~%" (coerce row-arr 'string) )))
    (terpri)))
(print-grid *test-grid* )
(print-grid *test-grid* )               ; well, it will hardly be helpful without specifying slice. if we're to drop Ks and Ms of stones

*test-grid*
;; (ql:quickload 'array-operations)
;; what's displaced array? would it be easy to get rows from multidimentional that way?
;; https://lispcookbook.github.io/cl-cookbook/arrays.html
;; The reduce function operates on sequences, including vectors (1D arrays), but not on multidimensional arrays.
;; To get around this, multidimensional arrays can be displaced to create a 1D vector.
;; Displaced arrays share storage with the original array, so this is a fast operation which does not require copying data:
(setf  (aref  (make-array 7 :displaced-to *test-grid*) 0) #\!)
;; if i just to :displaced-to it makes linear array of size 7 from index 0
;; now let's try to take third row
(setf  (aref  (make-array 7 :displaced-to *test-grid* :displaced-index-offset (* 2 7)) 0) #\?)
;; so :displaced-index-offset (* row cols) would get me correct row. and i could iterate over it and write into the array i suppose
;; how do i best loop over array?

(let*
    ((grid *test-grid*)
     (rownum 2)
     (rowsize (array-dimension grid 1))
     (row (make-array rowsize
                      :displaced-to grid
                      :displaced-index-offset (* rownum rowsize))))
  (loop for i from 0 below (array-total-size row) do
    (setf (aref row i) #\%)))
*test-grid*

;; ok. and maybe i'd have to what? wrap grid in class that would translate the BOTTOM & Y into actual ROWNUM

;; ok, next problem - it can't really be infinite height, could need to shift down sometimes?
;; maybe every 1000 check 3 lines and if there's no vertical clearings - shift all down?

;;; GENERIC CODE for figures
(defclass figure () ())

;; maybe only for debugging and printing
(defgeneric all-points-from-hook (fig hook)) ; do i need that?
(defgeneric check-down-points (fig hook))
(defgeneric check-left-points (fig hook))
(defgeneric check-right-points (fig hook))
(defgeneric get-fig-top (fig hook))     ; for updating TOP

(defun points-into-array (points array ch)
  (loop for (row . col) in points
       do (setf (aref array row col) ch)))
(defmethod resting-into-array ((fig figure) array hook)
  (declare (type (cons fixnum fixnum) hook)) ; also would like to declare array type
  (loop for (row . col) in (all-points-from-hook fig hook)
       do (setf (aref array row col) #\#))) ; save figure points into array. can be common for all figures


;; the figures start with their lovest point 3 units higher than TOP
;; and leftmost point 2 units to the right of left wall
;; so that i guess a good HOOK location

;; how would common code work? 0 .. 6 array
;; - generate hook position: (2 . (top + 3 + 1))
;; - check down,
;;      if move - update hook, maybe update TOP & side-turn
;;      else - call finalize into arry; go into same loop for next figure
;;
;; side move - read in direction, select check, apply result of the check to the Y coord of the HOOK
;; if it's DO loop. then what are the VARS:
;; figure, hook, iterations
;; is-resting is exit check, exit Sexp is finalizing TOP and INTO-ARR
;; then next figure loop could continue
;; also DO would count the iterations? could return the iterations, i guess
;; NOPE: we're counting amount of rocks that stopped
;; so, return TOP i guess, or owerwrite TOP that's set up in external LOOP
;; which takes FIGURE from infinite figure looped list
;;
;; ok, i guess
;; let's impelement one figure first, and then generic code. and check that

;;; so, now i could write the generic looping movement down?
;;; hmmm. i could code 2000 size array, but yup. probably should code row calculation immediately
;;; and maybe add ##### flor at the -1 ?

;; oh, come on, let's just make a big array, i have 32Gb of ram, shouldn't that be enough for one time run?
(defmethod is-point-free (hook array)
  (declare (type (cons fixnum fixnum) hook))
  (destructuring-bind (row . col)
      hook
    (and (>= col 0)
         (>= row 0)
         (< row (array-dimension array 0))
         (< col (array-dimension array 1))
         (equal #\. (aref array row col)))))
  ;; really want to declare also array type
(is-point-free '(-1 . 2) *test-grid*)
(is-point-free '(0 . 2) *test-grid*)
(is-point-free '(9 . 2) *test-grid*)
(is-point-free '(1 . 9) *test-grid*)

(is-point-free '(2 . 0) *test-grid*)
(is-point-free '(2 . 1) *test-grid*)
(is-point-free '(2 . 2) *test-grid*)
(aref *test-grid* 2 2)
(equal #\. #\#)


(defmethod check-move ((fig figure) array hook direction)
  (declare (type (cons fixnum fixnum) hook)
           (type symbol direction))
  (let* ((points-to-check (case direction
                           (DOWN (check-down-points fig hook))
                           (LEFT (check-left-points fig hook))
                           (RIGHT (check-right-points fig hook))
                           (t nil)))
        (can-move (loop for check-point in points-to-check
                        always (is-point-free check-point array))))
    (if (not can-move)
        0
        (case direction
          (down 1)
          (left -1)
          (right 1)))))
;; https://sodocumentation.net/common-lisp/topic/1369/loop--a-common-lisp-macro-for-iteration thanks

(defun -check-fig (fig)
  (let ((hook '(7 . 2)))
    (init-test-grid 200)
    (resting-into-array fig *test-grid* hook)
    (print-grid *test-grid*)
    (points-into-array (check-down-points fig hook) *test-grid* #\D)
    (print-grid *test-grid*)
    (points-into-array (check-left-points fig hook) *test-grid* #\L)
    (print-grid *test-grid*)
    (points-into-array (check-right-points fig hook) *test-grid* #\R)
    (print-grid *test-grid*)
    (init-test-grid 200)
    ))

;; hook is left point
;;; First figure class Horizontal Line
(defclass h-line (figure) ())
(defparameter *test-h-line* (make-instance 'h-line))

(defmethod all-points-from-hook ((fig h-line) hook)
  (declare (type (cons fixnum fixnum) hook))
  (destructuring-bind (row . col)
      hook
    (list (cons row  col) (cons row  (1+ col)) (cons row (+ 2 col)) (cons row (+ 3 col)))))
(all-points-from-hook *test-h-line* '(1 . 3 ))

;; well, check-down could be a generic method over figure with 'down-check-points' being generic methods specialized for figures. ok, i guess
;; row 0 should be top. The higher row - the lower thing is.
(defmethod check-down-points ((fig h-line) hook)
  (declare (type (cons fixnum fixnum) hook))
  (mapcar (lambda (coord)
            (cons (1+  (car coord)) (cdr coord)))
          (all-points-from-hook fig hook)))
(check-down-points *test-h-line* '(1 . 2))


(resting-into-array *test-h-line* *test-grid* '(2 . 1))


;; if DOWN is from zero, then LEFT is also from zero
(defmethod check-left-points ((fig h-line) hook)
  (declare (type (cons fixnum fixnum) hook))
  (list (cons (car hook) (1- (cdr hook)))))
(check-left-points *test-h-line* '(1 . 2)) ; (ROW . COL) that's quite prone to errors

;; if DOWN is from zero, then RIGHT is to zero
(defmethod check-right-points ((fig h-line) hook)
  (declare (type (cons fixnum fixnum) hook))
  (list (cons (car hook) (+ 4 (cdr hook)))))
(check-right-points *test-h-line* '(1 . 2))

(defmethod get-fig-top ((fig h-line) hook)
    (declare (type (cons fixnum fixnum) hook))
  (car hook))     ; for updating TOP


*test-grid*
(resting-into-array *test-h-line* *test-grid* '(0 . 0))
(resting-into-array *test-h-line* *test-grid* '(2 . 0))
;; (resting-into-array *test-h-line* *test-grid* '(3 . 4))
;; (defgeneric get-fig-top (fig hook))     ; for updating TOP

;;; now I could try to build a generic inner loop;


;; NEXT classes
;; WHELP. figure appears +4 from lowest point and +2 from leftmost
;; that means that hook for cross would be not a part of figure, but leftbottom corner
(defclass cross (figure) ())
(defmethod all-points-from-hook ((fig cross) hook)
    (declare (type (cons fixnum fixnum) hook))
  (destructuring-bind (hook-row . hook-col)
      hook
    `(
      (,(- hook-row 2) . ,(1+ hook-col))
      (,(1- hook-row) . ,hook-col) (,(1- hook-row) . ,(1+ hook-col)) (,(1- hook-row) . ,(+ 2 hook-col))
      (,hook-row . ,(1+ hook-col))
      )
    )
  ) ; do i need that?
(defparameter *test-cross* (make-instance 'cross))
(init-test-grid 200)
(resting-into-array *test-cross* *test-grid* '(2 . 2))
(print-grid *test-grid*)
(defmethod check-down-points ((fig cross) hook)
  (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
    `(
      (,hook-row . ,hook-col)  (,hook-row . ,(+ 2 hook-col))
      (,(1+ hook-row) . ,(1+ hook-col))
      )
    )

  )
(defmethod check-left-points ((fig cross) hook)
   (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
    `(
      (,(- hook-row 2) . ,hook-col)
      (,(1- hook-row) . ,(1- hook-col))
      (,hook-row . ,hook-col)
      )
    )
 )

(check-left-points *test-cross* '(18 . 2))
;; hook:(18 . 2); moveLEFT -> 0
;; so why is this?

(defmethod check-right-points ((fig cross) hook)
   (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
    `(
      (,(- hook-row 2) . ,(+ 2 hook-col))
      (,(1- hook-row) . ,(+ 3 hook-col))
      (,hook-row . ,(+ 2 hook-col))
      )
    )
 )
(defmethod get-fig-top ((fig cross) hook)
   (declare (type (cons fixnum fixnum) hook))
  (- (car hook) 2)     ; for updating TOP

 )

(defclass bracket (figure) ())
(defparameter *test-bracket* (make-instance 'bracket))
(defmethod all-points-from-hook ((fig bracket) hook)
  (declare (type (cons fixnum fixnum) hook))
  (destructuring-bind (hook-row . hook-col)
      hook
    `(
      (,(- hook-row 2) . ,(+ 2 hook-col))
      (,(- hook-row 1) . ,(+ 2 hook-col))
      (,hook-row . ,hook-col)(,hook-row . ,(+ 1 hook-col))(,hook-row . ,(+ 2 hook-col))
      )
    )
  ) ; do i need that?
(defmethod check-down-points ((fig bracket) hook)
     (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
    `(
      (,(+ hook-row 1) . ,hook-col)(,(+ hook-row 1) . ,(+ 1 hook-col))(,(+ hook-row 1) . ,(+ 2 hook-col))
      )))

(defmethod check-left-points ((fig bracket) hook)
     (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
    `(
      (,(- hook-row 2) . ,(+ 1 hook-col))
      (,(- hook-row 1) . ,(+ 1 hook-col))
      (,hook-row . ,(- hook-col 1))
      )))
(defmethod check-right-points ((fig bracket) hook)
     (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
          `(
      (,(- hook-row 2) . ,(+ 3 hook-col))
      (,(- hook-row 1) . ,(+ 3 hook-col))
      (,hook-row . ,(+ 3 hook-col))
      )))
(defmethod get-fig-top ((fig bracket) hook)
   (declare (type (cons fixnum fixnum) hook))
  (- (car hook) 2)     ; for updating TOP

 )

(defclass v-line (figure) ())
(defparameter *test-v-line* (make-instance 'v-line))
(defmethod all-points-from-hook ((fig v-line) hook)
     (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
          `(
            (,(- hook-row 3) . ,hook-col)
            (,(- hook-row 2) . ,hook-col)
            (,(- hook-row 1) . ,hook-col)
            (,hook-row . ,hook-col)
      ))
  ) ; do i need that?
(defmethod check-down-points ((fig v-line) hook)
     (declare (type (cons fixnum fixnum) hook))
      (destructuring-bind (hook-row . hook-col)
      hook
          `(
            (,(+ hook-row 1) . ,hook-col)
      ))

)
(defmethod check-left-points ((fig v-line) hook)
     (declare (type (cons fixnum fixnum) hook))
      (destructuring-bind (hook-row . hook-col)
      hook
          `(
            (,(- hook-row 3) . ,(- hook-col 1))
            (,(- hook-row 2) . ,(- hook-col 1))
            (,(- hook-row 1) . ,(- hook-col 1))
            (,hook-row . ,(- hook-col 1))
      ))

)
(defmethod check-right-points ((fig v-line) hook)
     (declare (type (cons fixnum fixnum) hook))
      (destructuring-bind (hook-row . hook-col)
      hook
          `(
            (,(- hook-row 3) . ,(+ hook-col 1))
            (,(- hook-row 2) . ,(+ hook-col 1))
            (,(- hook-row 1) . ,(+ hook-col 1))
            (,hook-row . ,(+ hook-col 1))
      ))

)
(defmethod get-fig-top ((fig v-line) hook)
     (declare (type (cons fixnum fixnum) hook))
  (- (car hook) 3)     ; for updating TOP
)     ; for updating TOP


(defclass square (figure) ())
(defparameter *test-square* (make-instance 'square))
(defmethod all-points-from-hook ((fig square) hook)
  (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
          `(
            (,(- hook-row 1) . ,hook-col) (,(- hook-row 1) . ,(+ hook-col 1))
            (,hook-row . ,hook-col) (,hook-row . ,(+ hook-col 1))
      ))

  ) ; do i need that?
(defmethod check-down-points ((fig square) hook)
  (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
          `(
            (,(+ hook-row 1) . ,hook-col) (,(+ hook-row 1) . ,(+ hook-col 1))
      ))

  )
(defmethod check-left-points ((fig square) hook)
  (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
          `(
             (,(- hook-row 1) . ,(- hook-col 1))
             (,hook-row . ,(- hook-col 1))
      ))

  )
(defmethod check-right-points ((fig square) hook)
  (declare (type (cons fixnum fixnum) hook))
    (destructuring-bind (hook-row . hook-col)
      hook
          `(
             (,(- hook-row 1) . ,(+ hook-col 2))
             (,hook-row . ,(+ hook-col 2))
      ))

  )
(defmethod get-fig-top ((fig square) hook)
  (declare (type (cons fixnum fixnum) hook))
  (- (car hook) 1)     ; for updating TOP

  )     ; for updating TOP



;; COPY from above
;; how would common code work? 0 .. 6 array
;; - generate hook position: (2 . (top + 3 + 1))
;; - check down,
;;      if move - update hook, maybe update TOP & side-turn
;;      else - call finalize into arry; go into same loop for next figure
;;
;; side move - read in direction, select check, apply result of the check to the Y coord of the HOOK
;; if it's DO loop. then what are the VARS:
;; figure, hook, iterations
;; is-resting is exit check, exit Sexp is finalizing TOP and INTO-ARR
;; then next figure loop could continue
;; also DO would count the iterations? could return the iterations, i guess
;; NOPE: we're counting amount of rocks that stopped
;; so, return TOP i guess, or owerwrite TOP that's set up in external LOOP
;; which takes FIGURE from infinite figure looped list

(let* ((grid *test-grid*)
       (top (1- (array-dimension grid 0))) ; max row with stone, get's smaller. 0 on the TOP
       (figures (circular (list *test-h-line*)))
       ;; (fig *test-h-line*)
       ;; (hook (cons (- top 4) 2))
       (lateral-moves (circular '(left right))))
  ;; outer loop is simple dotimes for amount of figures we want to drop
  (dotimes (i 19)
    ;; let's do simple loop? returning when no longer can move down?
    ;; move down
    (let ((hook (cons (- top 4) 2))
          (fig (pop figures)))
      (loop
        ;; first check lateral move (just after apperaing)
        (let ((lateral-change (check-move fig grid hook (pop lateral-moves))))
          (setq hook (cons (car hook) (+ lateral-change  (cdr hook)))))
        ;; then check if possible to go down
        (when (= 0 (check-move fig grid hook 'down))
          ;; all moves down done, update TOP and exit for next FIG
          (setq top (min top (get-fig-top fig hook)))
          (resting-into-array fig grid hook)
          (return))
        ;; more moves down exist
        ;; do move down, and loop for the lateral change and possible exit
        (setq hook (cons (1+ (car hook)) (cdr hook)))))))

(init-test-grid 200)
(print-grid *test-grid*)
*test-grid*
(let ((my-list '(1 2 3 4)))
      `(returning ,(pop my-list) ,my-list))
;; well it seems to work maybe ok.

(defun print-intermediate-step (fig grid hook)
  (let ((fig-points (all-points-from-hook fig hook)))
    (points-into-array fig-points grid #\@)
    (print-grid grid)
    (points-into-array fig-points grid #\.)))

;; let's generalize this?
(defun try-dropping (figures lateral-moves
                     times grid height)
  ;; (print-grid grid)
  (let* ((top (1- (array-dimension grid 0))) ; max row with stone, get's smaller. 0 on the TOP
         (percent-index (floor (/ times 100)))
         (running-percent-index 0)
         (additional-count 0))
    ;; outer loop is simple dotimes for amount of figures we want to drop
    (dotimes (i times)
      ;; fuck i forgot about my inverted TOP. it goes to 0
      (when (< top (/ height 20))
        ;; ok. let's think about this.
        ;; my "TOP" for 10 rows is 8, overall indices start from 0
        ;; but "TOP" would be what?
        ;; it would start on 9. on the "already occupied" line
        ;; (by the floor, which we don't want to count)
        ;; so if TOP is 2, then 2 is "already occupied"
        ;; and only 2 left, so it's 7 elements
        ;; 10 - 2 - 1 how much we're need to count
        ;; which row i want to copy? the TOP, right?
        ;; if top is 9, then
        ;;
        ;; ok. let's count TOP at the moment of TRUNCATE
        ;; that would leave us with 1 unnecessary - the manual "floor"
        (incf additional-count 
              (- (array-dimension *test-grid* 0) top 1))
        (format t "Truncating~%" )
        (setq grid (truncate-grid grid top height))
        (setq top (1- (array-dimension grid 0)))
        )

      (when (= percent-index running-percent-index)
        (setq running-percent-index 0)
        (format t "One more: ~a%,  , intermediate height: ~a; the step is ~a; the times is ~a~%"
                (floor (* 100 (/ i times))) (- (array-dimension grid 0) top 1) i times)
        )
      (incf running-percent-index)

      ;; let's do simple loop? returning when no longer can move down?
      ;; move down
      (let ((hook (cons (- top 4) 2))
            (fig (pop figures)))
        ;; (print-intermediate-step fig grid hook)
        (loop
          ;; first check lateral move (just after apperaing)
          ;; (print-intermediate-step fig grid hook)
          (let* ((lat-move (pop lateral-moves))
                 (lateral-change (check-move fig grid hook lat-move)))
            (setq hook (cons (car hook) (+ lateral-change  (cdr hook))))
            ;; (format t "Looping for ~a figure ~a~%hook:~a; move~a -> ~a~%"
            ;;         i fig hook lat-move lateral-change)
            )
          ;; (print-intermediate-step fig grid hook)
          ;; then check if possible to go down
          (when (= 0 (check-move fig grid hook 'down))
            ;; all moves down done, update TOP and exit for next FIG
            (setq top (min top (get-fig-top fig hook)))
            (resting-into-array fig grid hook)
            (return))
          ;; more moves down exist
          ;; do move down, and loop for the lateral change and possible exit
          (setq hook (cons (1+ (car hook)) (cdr hook))))))
    (+ additional-count (- (array-dimension grid 0) top 1)))

  ;; (print-grid grid)
  )

;; (init-test-grid 200)
;; (try-dropping (circular (list *test-h-line*)) (circular '(right left)) 9 *test-grid*)
;; (try-dropping (circular (list *test-h-line*)) (circular '(right)) 9 *test-grid*)
;; (try-dropping (circular (list *test-h-line*)) (circular '(right right left)) 9 *test-grid*)
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;;               (circular '(right right left)) 1 *test-grid*)
;; ;; seems maybe ok.
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;;               (circular '(right left left left left left)) 4 *test-grid*)
;; ;; now to implement the other figures. it's not quite fun

;; (try-dropping (circular (list *test-cross* *test-h-line*))
;;               (circular '(left)) 1 *test-grid*) ; this is not right. no lateral moves done

;; (init-test-grid 200)
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;;               (circular '(right right left right)) 5 *test-grid*) ; this is not right. no lateral moves done
;; (try-dropping (circular (list *test-cross* *test-h-line*))
;;               (circular '(left left right right right right left right)) 5 *test-grid*) ; this is not right. no lateral moves done

;; this is failure
;; ugh. this is failure. i'd rather take all points and shift them down \ left \ right
;; than do this manually
;; or - have better visual testing.
;; do (put-to-array) for left and for right and for down, and for figure

(-check-fig *test-cross*)
(-check-fig *test-h-line*)
(-check-fig (make-instance 'bracket))
(-check-fig *test-v-line*)
(-check-fig *test-square*)
;; ok, with this things would have to be better

;; and with this check fig, could at least visually check 3 other figures

;; (init-test-grid 20)
;; (try-dropping (circular (list *test-cross* *test-h-line* *test-bracket*))
;;               (circular '(left left right right right right left right)) 5 *test-grid*) ; this is not right. no lateral moves done
;; ;; ok, i guess

;; (init-test-grid 100)
;; (try-dropping (circular (list *test-cross* *test-h-line* *test-bracket* *test-v-line*))
;;               (circular '(left left right right right right left right)) 55 *test-grid*) ; this is not right. no lateral moves done

;; ok, maybe. but overall - ugh.

;; so, run the test data? oh, i havent' yet consumed the data. but it's in few lines,
;; right

(defparameter *test-lat-chars* ">>><<><>><<<>><>>><<<>>><<<><<<>><>><<>>")
(defparameter *test-lat-symbs*
  (mapcar (lambda (ch) (case ch
                         (#\< 'LEFT)
                         (#\> 'RIGHT))) (coerce *test-lat-chars* 'list)))

(defparameter *shapes-order*
  (list *test-h-line* *test-cross* *test-bracket* *test-v-line* *test-square*))

(defparameter *endless-shapes* (circular *shapes-order*))
(defparameter *endless-test-laterals* (circular *test-lat-symbs*))

;; now, i'd want to drop 2022 rocks. in example it should yield 3068 height

(typep 1 'fixnum)
(init-test-grid 10000)
(defparameter *test-run-result* 0)
;; (setq *test-run-result*
;;       (try-dropping *endless-shapes*
;;                     *endless-test-laterals* 2022 *test-grid*)) ; this is not right. no lateral moves done
(print-grid *test-grid*)
;; ok my 7010 is to be deducted from 10000
(- (array-dimension *test-grid* 0) *test-run-result* 1)

;; well, something is wrong with the square
;; how could i test square without printing intermediate steps? well, i could add that, yeah

;;; let's add per-turn printing as well.

(init-test-grid 50)
;; (defparameter *test-run-result*
;;   (try-dropping *endless-shapes*
;;                 *endless-test-laterals* 15 *test-grid*)) ; this is not right. no lateral moves done

;; well, let's run 2022 for my own input?

(defparameter *input-lat-chars* (uiop:read-file-string "day17-input.txt"))
(length (coerce *input-lat-chars* 'list))
(defparameter *input-lat-symbs*
  (remove-if-not #'identity (mapcar (lambda (ch) (case ch
                                                   (#\< 'LEFT)
                                                   (#\> 'RIGHT))) (coerce *input-lat-chars* 'list))))
(print *input-lat-symbs*)               ; cool, it has NIL in the end. why?
(defparameter *endless-input-laterals* (circular *input-lat-symbs*))
(type-of *input-lat-symbs*)
(typep *input-lat-symbs* 'list)
(length *input-lat-symbs* )
(init-test-grid 10000)
;; (defparameter *task-run-result*
;;   (try-dropping *endless-shapes*
;;                 *endless-input-laterals* 2022 *test-grid*)) ; this is not right. no lateral moves done
(- (array-dimension *test-grid* 0) *task-run-result* 1)

;; PART 2
;; In the example above, the tower would be 1514285714288 units tall!
;; How tall will the tower be after 1000000000000 rocks have stopped?
;; so. let's print out intermediate? each 1% ?

;; 866549760 bytes available, 112800000000144 requested.
(floor (/ 112800000000144 866549760))
(floor (/ 910721024 1024 1024 1024))    ; available
(floor (/ 112800000000144 1024 1024 1024)) ; 105000 iGb requested
;; so, no
;; so, how'd i print report each 1% ?
(init-test-grid 10000)
(defparameter
    *task-2-run-result* 0)
;; (setq *task-2-run-result*
;;       (try-dropping *endless-shapes*
;;                     *endless-input-laterals* 2022 *test-grid*)) ; this is not right. no lateral moves done
(- (array-dimension *test-grid* 0) *task-2-run-result* 1)

(mod 7 4)

;; ok. i'd want to what? maybe every million size truncate?
;; when size get to 1M, get last row (height - 1?)
;; copy that last row to the first, add to the

(defun truncate-grid (grid top-row height)
  (let*
      ((rownum (1- (array-dimension grid 0))) ; bottom row
       (new-grid (make-array `(,height 7) :initial-element #\.))
       (rowsize (array-dimension grid 1))
       (row-bottom (make-array rowsize
                               :displaced-to new-grid
                               :displaced-index-offset (* rownum rowsize)))
       (row-top (make-array rowsize
                             :displaced-to grid
                             :displaced-index-offset (* top-row rowsize))))
    (gc :full t)
    (loop for i from 0 below (array-total-size row-bottom) do
      (setf (aref row-bottom i) (aref row-top i)))
    new-grid))

;;; well, it will not work.
;; but let's try? first on test, and then maybe cancel
(/ 56000512 1024 1024)                  ; 54 Mb, that's WTF
(gc :full t)

(init-test-grid 100)
(defparameter *test-run-result* 0)
(setq *test-run-result*  (try-dropping *endless-shapes*
                                       *endless-test-laterals* 2022 *test-grid* 100)) ; this is not right. no lateral moves done
;; ok my 7010 is to be deducted from 10000
;; oh and one more transformation. hmmm hmmm

;; with enough grid 3068 - ok
;; when doing by 1000 - nok 3063. i'm missing rows somewhere
;;
;; i'm looking height when i'm truncating

(room t)

(init-test-grid 700)
(defparameter *test-run-result* 0)
(setq *test-run-result*  (try-dropping *endless-shapes*
                                       *endless-test-laterals* 2022 *test-grid* 700)) ; this is not right. no lateral moves done
;; but loosing 2 when do 1 truncating
;; 3087 when doing how many truncating?
;; for 500 600 700 wildly different numbers, so

;; yup. fuck if i only transfer last row - then hole in that last row is considered what?
;; yuck. i'd need to transfer serveral layers and still no guarantee
;;
;; how about i transfer 100 rows?
;; i'd init grid on my own, keep 100 rows below this is ugly as hell
;;
;; so, only good way is to actually trigger TRANSFER when there's possibility in
;; good enough floor
;;
;; and to know how to calculate correct amount of "negative space" below.
;; yuk.

;;; PART 2, again.

;; so the advice was to "find the loop"
;; loop would depend on 3 things that should match exactly: the current item, the current left-right movement, the last N (100, 200?) lines of the tower,
;; so that any falling figures would stop at same levels.

;; let's try to discover how could i compute hashes from collections and other things in CL?
;; maybe i could just use a triplet as a hash-key?

;; so, let's try with the hmmmm, i'd need to take first N of 'left and 'right, in order not to break hashmap
(defparameter *test-hashing-map* (make-hash-table :test #'equalp))
(setf (gethash '(left left right) *test-hashing-map*) 1)
(gethash '(left left right) *test-hashing-map*)
;; for lists it seems to work

;; then how about slices of the 2d array?

(defparameter *test-big-array* (make-array '(7 4) :initial-element #\.))
(defparameter *test-array-line-3* (make-array 4 :displaced-to *test-big-array* :displaced-index-offset (* 4 2)))
(defparameter *test-array-line-4* (make-array 4 :displaced-to *test-big-array* :displaced-index-offset (* 4 3)))

(setf (gethash *test-array-line-3* *test-hashing-map*) 111)
(gethash *test-array-line-4* *test-hashing-map*) ; nope, with arrays - not by contents, even when they are identical. so. i'd want a hashing funciton?
                                        ; for the contencts of the displaced array that takes 100 previous rows (including the top filled)
                                        ; so with #'equalp arrays seem to point to same thing?
                                        ; and if i change one array, then only by the new key value i retrieve the stored data.
                                        ; seems ok, i guess
(setf (aref *test-array-line-3* 3) #\?)

(sxhash *test-array-line-3*)
;; => 1193941381096739655 (61 bits, #x1091BB5C3EE91347)
(sxhash *test-array-line-4*)
(equalp *test-array-line-3* *test-array-line-4*) ; equal not good enough, with #'equalp - contents are checked
;; => 1193941381096739655 (61 bits, #x1091BB5C3EE91347)
;; ;; wait! it's the same!, but even after i changed contents?

;; so, i could do what? can i create list of left and right?

(defparameter *test-list-for-circ* '(left left right left left right right right))
(defparameter *test-circ* (copy-list '(left left right left left right right right)))
;; oh, this modifies in place, not nice
(circular *test-circ*)                  ; hehe, and calling it twice - it starts to look for the end. whops
(defparameter *test-0-offset-circ*
  (subseq *test-circ* 0 (length *test-list-for-circ*))) ; seems ok.
(defparameter *test-2-offset-circ*
  (progn
    (pop *test-circ*)
    (pop *test-circ*)
      (subseq *test-circ* 0 (length *test-list-for-circ*))
    ))

*test-0-offset-circ*
*test-2-offset-circ*

;; i think that's ok.
;; so, gather these things into a list:
;; the offset 100 previous rows of the array
;; the current 'left 'right list subseq
;; and the current shape
;; could do this only on steps that start new shape
;; and check hashmap \ put into hashmap for future. for the previous line that had same structure.
;;
;; so, maybe 10M? 20M of lines to check?

;; create hashmap outside.
;; take initial slice of lateral-moves, mix with current-shape, and last 100 lines of grid (including top-filled-line-index)
;; create hashmap on the outside, with :test #'equalp
;;
;; now. if 0 is what? top. how would i calculate index from which to start TOP 100 lines?
;; if index 0, and i want 0th line - 0 * lineleng
;; so if index is 115 and i want TOP 5 it will be 111 112 113 114 115. so -5 + 1
;; so (- top-filled-line-index 4) is what should get multiplied by line len to get start of the start of TOP 100 lines
;; and if 0 is the bottom, then 1st line is 1 * 7
;;
;; now. hashtable returns second return value that signifies whether value was present in the hashtable
;;
(defun check-for-loop (top-filled-line-index lateral-moves
                       lateral-moves-initial-number current-shape grid states-hashmap)
  (let* ((cur-moves (subseq lateral-moves 0 lateral-moves-initial-number))
         (top-100-lines-lements-amount (* 7 100))
         (start-index-of-top-100-lines (* 7  (- top-filled-line-index 99)))
         (last-100-lines (make-array top-100-lines-lements-amount :displaced-to grid :displaced-index-offset start-index-of-top-100-lines))
         (full-state (list current-shape cur-moves last-100-lines))
         (hashmap-check (gethash full-state states-hashmap)))
    (if (nth-value 1 hashmap-check)
        ;; state WAS previously saved
        ;; return the previous index where that was the case
        (nth-value 0 hashmap-check)
        ;; first time seeing this state
        (progn
          (setf (gethash full-state states-hashmap) top-filled-line-index)
          nil))))

;; now in our shitty throwing contest, let's call that function and whenever it finds a loop
;; print it out

(defparameter *found-loop-info* nil)
(defun try-dropping-search-loop (figures initial-lateral-moves
                                 times grid)
  ;; (print-grid grid)
  (format t "starting~%")
  (let* ((top (1- (array-dimension grid 0))) ; max row with stone, get's smaller. 0 on the TOP
         (percent-index (floor (/ times 100)))
         (running-percent-index 0)
         (additional-count 0)
         (states-for-100-lines (make-hash-table :test #'equalp))
         (endless-lateral-moves (circular initial-lateral-moves)))
    ;; outer loop is simple dotimes for amount of figures we want to drop
    (dotimes (i times)
      ;; fuck i forgot about my inverted TOP. it goes to 0

      (when (= percent-index running-percent-index)
        (setq running-percent-index 0)
        (format t "One more: ~a%,  , intermediate height: ~a; the step is ~a; the times is ~a~%"
                (floor (* 100 (/ i times))) (- (array-dimension grid 0) top 1) i times)
        )
      (incf running-percent-index)

      (let* ((hook (cons (- top 4) 2))
             (fig (pop figures))
             (check-result (check-for-loop top endless-lateral-moves (length initial-lateral-moves)
                                           fig grid states-for-100-lines)))

        (when (check-result)
          (setq *found-loop-info* `(found ,check-result start point at ,top check
                                    with ,fig ))
          (format t "found loop previously recorded at ~a
now it's ~a" check-result top)
          )

        ;; (print-intermediate-step fig grid hook)
        (loop
          ;; first check lateral move (just after apperaing)
          ;; (print-intermediate-step fig grid hook)
          (let* ((lat-move (pop lateral-moves))
                 (lateral-change (check-move fig grid hook lat-move)))
            (setq hook (cons (car hook) (+ lateral-change  (cdr hook))))
            ;; (format t "Looping for ~a figure ~a~%hook:~a; move~a -> ~a~%"
            ;;         i fig hook lat-move lateral-change)
            )
          ;; (print-intermediate-step fig grid hook)
          ;; then check if possible to go down
          (when (= 0 (check-move fig grid hook 'down))
            ;; all moves down done, update TOP and exit for next FIG
            (setq top (min top (get-fig-top fig hook)))
            (resting-into-array fig grid hook)
            (return))
          ;; more moves down exist
          ;; do move down, and loop for the lateral change and possible exit
          (setq hook (cons (1+ (car hook)) (cdr hook))))))
    (+ additional-count (- (array-dimension grid 0) top 1)))

  ;; (print-grid grid)
  )


(gc :full t)
(room t)
;; (/ (- sb-vm:dynamic-space-end sb-vm:dynamic-space-start) (expt 1024 2))
(init-test-grid 200000000)
;; 991133696 bytes available,
;; 5600000016 requested.
(sb-vm::dynamic-space-size)
;; 1073741824 (31 bits, #x40000000)
;; is that in bytes?
(sb-ext:dynamic-space-size)
;; 1073741824 (31 bits, #x40000000)

(/ 1073741824 1024 1024 1024 1024) ; 1/1024
;; so maybe in megabites
(/ 1073741824 1024 1024 1024) ; 1/1024
;; it seems that it's 1 Gb, not funny

;; (/ 981172224 1024 1024 1024 1024)
;; (* 10 1024 )
;; (* 1024 3)
;; ok, this is ridiculous
;; let's forget this
;;
;; i can't get more than 1 Gb
;; CL-USER> (sb-ext:dynamic-space-size)
;; 1073741824 (31 bits, #x40000000)
;; ok.
;;
;; Ugh. So. what? what do you do Sly. why not passing?
;;
;; so, with just inferior lisp it works. when i do it without "="
;;
;; ok. let's again, forget all that? ugh. so hard to just move on
;; yes, just move on. 1 Gb is what i get. can't figure out the configuration.
;; ugh
;;
;; UGH! I'm kind of hating it.
;; Interactively, both COMMAND and CODING-SYSTEM are nil and the
;; sly-restart-inferior-lisp didn't restart the underlying sbcl,
;; i suppose it should have asked.
;; oh, but I haven't even tried the M-x sly command
;;
;; so, maybe even just the
;; (setq inferior-lisp-program "sbcl --dynamic-space-size 10240")
;; could have been enough, if I actually killed the sbcl, not just restart
;;
;; well, this is strange
;; it does seem that it should "reastart" inferior lisp
;;
;; YUP, that's it. Thanks i hate it.
;; do i want to try to run this thing?


(defparameter *test-run-result* 0)
(setq *test-run-result*  (try-dropping-search-loop *endless-shapes*
                                       *input-lat-symbs* 10 *test-grid* )) ; this is not right. no lateral moves done

;; well, i think NOW i can let it go.
;; and return back LATER, to REWRITE THIS ANEW WITH MY UPDATED KNOWLEDGE.
;; SO HERE I GO, LEAVING THIS BEHIND