day 20 part 2, yay

day 20 kicking me with duplicates
at least part 1 of day 19
2022-12-25 09:40:10 +00:00 · 2022-12-25 09:10:19 +00:00 · 2022-12-24 12:45:54 +00:00 · 2022-12-24 10:11:53 +00:00 · 2022-12-23 22:58:50 +00:00 · 2022-12-22 20:41:17 +00:00
16 changed files with 10510 additions and 1 deletions
--- a/day16-scratch-graph-utils.lisp
+++ b/day16-scratch-graph-utils.lisp
@ -741,7 +741,8 @@
-(visit-each-once-recursive-max-vented 'aa 30 *test-graph* *test-vertices-map* *test-shortest-paths*)
+;; Calculating PART 1
 ;; (visit-each-once-recursive-max-vented 'aa 30 *test-graph* *test-vertices-map* *test-shortest-paths*)
 ;; well 1570 is not correct 1651
 ;; what am i missing?
 ;; i am opening starting Node with 0 flow
@ -753,3 +754,279 @@
 ;; CC : #<VERTICLE-DATA CC with flow: 1; is opened NIL {1004C57E33}>
 ;; DD : #<VERTICLE-DATA DD with flow: 1; is opened NIL {1004C57EB3}>
 ;; EE : #<VERTICLE-DATA EE with flow: 1; is opened T {1004C57F33}>
 ;;; PART 2
 ;; need to compare 2 cases:
 ;; me running solo for 30 minutes
 ;; or two persons - me and elephant running for 26 minutes
 ;; oh, shit. now i'd need coordination between recusive calls? for them to share the actual state.
 ;; or what? do i just on each step do twice decisions and not share state
 ;; just a separate function, for 2 actors, would call both and compare
 ;; but it takes 1 turn to open valve. is that a problem?
 ;; it can be! because no guarantee that both start opening at same moment.
 ;; lots of changes then. need to iterate one step at a time
 ;; so person can be "in state, i just came in, turning the gas", i'm tired. let's go outside
 ;; so it's still better to be recursive, since calling for all possibilities.
 ;; but need to do iteration one tick at a time. setting state for p1 and p2 (for the next iteration)
 ;; and only adding value of cur-node-1|2 when it actually becoming turned on
 ;; and additional filtering out of other player's node
 ;;
 ;;
 ;; so, also "moving to other room" is not instantaneous
 ;; let's do:
 ;; cur-node-p1
 ;; p1-state
 ;; cur-node-p2
 ;; p2-state
 ;;
 ;; p.-state is current state or next state and should be excluded
 ;;
 ;; exit condition - if no more next nodes AND both players done opening
 ;; so let's do also DONE state, which is set to player when there's no more next nodes
 ;; and exit condition - both in DONE
 ;;
 ;; check that before DONE we added last room of the player to total
 ;;
 ;; I want to see if I could use lists and sybols as states:
 ;; OPENING '(GOING n) DONE where n should be readable number of how many turns of going left.
 ;; on (GOING 0) set next OPENING
 ;; on OPENING - since it's 1 turn - we should add target node to tally and set new GOING or DONE
 ;;
 ;; let's see if there's such thing as DESTRUCTURING CASE
 (let
    ;; ((x 'opening))
    ;; ((x '(going 0)))
    ((x '(going 5)))
  (cond
    ((eq x 1) "one")
    ((eq  'opening x) "opening")
    ((equal x '(going 0))
     (format nil "were here! ~a~%" (second x)))
    ((and (listp x)
          (eq (first x) 'going))
     (format nil "going, ~a turns left" (second x)))
    (t "default")))
 (let ((x '(going 5)))
  (case x
    (1 "one")
    ('opening "opening")
    ((list going b) (format nil "going, ~a turns left~%" (second x)))
    ((list going 0) (format nil "were here! ~a~%" (second x)))
    (t "default")))
 ;; now what would I want to do baced on the state of the player?
 ;; set next state and do what? modify the state passing further
 ;; that's possible i think
 ;; ugh. ugh.
 ;; so, what - generate all next states for the player
 ;; and in addition i guess mutate the vertices-data-map for next call? ugh.
 ;;
 ;; if one player finished OPENING, then we for each of their possible next move create separate v-data-map
 ;;
 ;; what if we operate players sequentially, doing 2 player move ticks per 1 time tick.
 ;; that might be nice. then only need to update 1 player state.
 ;; could have "steping player state & node" as first two arguments, always switching them.
 ;; it would keep lots of logic same, as one player update.
 ;;
 ;; exit when both are done. that could be nice, yeah.
 ;; and if active player is done - just pass the turn to another.
 ;; when do I increment time? store "turn" increment it by 1 every recursion, and / 2 to deduct from total time
 ;; i guess it's ok
 ;; removing other player node from possible nodes
 (remove 'bb '((aa 5) (bb 7) (cc 1)) :test (lambda (removing-name name-and-dist) (eq removing-name (first name-and-dist))))
 (remove 'cc '((aa 5) (bb 7) (cc 1)) :test (lambda (removing-name name-and-dist) (eq removing-name (first name-and-dist))))
 (remove 'ee '((aa 5) (bb 7) (cc 1)) :test (lambda (removing-name name-and-dist) (eq removing-name (first name-and-dist))))
 (defparameter *max-so-far* 0)
 (defun 2-persons-visit-each-once-recursive-max-vented (active-pl-node active-pl-state
                                                       inactive-pl-node inactive-pl-state
                                                       current-turn total-allotted-time
                                                       freed-to-end-gas-accum
                                                       graph vertices-data-map shortest-paths)
  (let* ((time-left (- total-allotted-time (floor (/ current-turn 2))))
         (not-opened-possible-nodes (get-possible-next-vs active-pl-node graph vertices-data-map shortest-paths time-left))
         (possible-next-nodes (remove inactive-pl-node not-opened-possible-nodes ; remove other player target node from available
                                      :test (lambda (removing-name name-and-dist)
                                              (eq removing-name (first name-and-dist)))))
         (cur-node-gas-per-turn (flow (gethash active-pl-node vertices-data-map)))
         (for-open-current-total-release (max 0 ; in case we get to -1 time remaining
                                              (* cur-node-gas-per-turn time-left)
                                        ; freed gas after opening and staying
                                              ))
         (next-turn (1+ current-turn)))
    ;;     (format t "Turn:~%
    ;; active pl:      state ~a, node ~a
    ;; inactive pl:    state ~a, node ~a
    ;; accum: ~a
    ;; possible next: ~a
    ;; current turn: ~a; time remaining ~a~%"
    ;;             active-pl-state active-pl-node
    ;;             inactive-pl-state inactive-pl-node
    ;;             freed-to-end-gas-accum
    ;;             possible-next-nodes
    ;;             current-turn time-left)
    (when (> freed-to-end-gas-accum *max-so-far*)
      (setq *max-so-far* freed-to-end-gas-accum)
      (format t "updating max so far to: ~a~%" *max-so-far*)
        )
    (cond
      ((and (eq active-pl-state 'DONE)
            (eq inactive-pl-state 'DONE))
       ;; (print "Total DONE processing")
       ;; recursion EXIT condition - both are done,
       ;; before becoming DONE and yielding turn previous player
       ;; counted how much steam is added "until the end of allotted-time" and added to accum
       freed-to-end-gas-accum)
      ((eq active-pl-state 'DONE)
       ;; (print "One player DONE")
       ;; active player is DONE but not another, tick the turn and yield the turn
       (2-persons-visit-each-once-recursive-max-vented
        inactive-pl-node inactive-pl-state
        active-pl-node 'DONE            ; keep staying DONE
        next-turn total-allotted-time
        freed-to-end-gas-accum
        graph vertices-data-map shortest-paths))
      ((and (listp active-pl-state)
            (equal active-pl-state '(going 1))) ; am i here off by one?
       ;; (print "Processing ARRIVAL")
       ;; active player came to target state, set to OPENING
       (2-persons-visit-each-once-recursive-max-vented
        inactive-pl-node inactive-pl-state
        active-pl-node 'OPENING         ; for one turn
        next-turn total-allotted-time
        freed-to-end-gas-accum
        graph vertices-data-map shortest-paths))
      ((and (listp active-pl-state)
            (listp inactive-pl-state)
            (equal (first active-pl-state) 'going)
            (equal (first inactive-pl-state) 'going)
            (not (= 1 (second inactive-pl-state))))
       ;; both are GOING, can find amount to decrement, decrement both and add 2*n to turn
       (let ((common-skip (1- (min  (second active-pl-state) (second inactive-pl-state)))))
                                        ; for 5 and 3; min is 3, common diminish 2 - to get one of them to 1
         (2-persons-visit-each-once-recursive-max-vented
          active-pl-node `(going ,(- (second active-pl-state) common-skip))
          inactive-pl-node `(going ,(- (second inactive-pl-state) common-skip))
          (+ current-turn (* 2 common-skip)) total-allotted-time
          freed-to-end-gas-accum
          graph vertices-data-map shortest-paths)
         )
       )
      ((eq active-pl-state 'OPENING)
       ;; (print "in OPENING processing")
       ;; active player is OPENING, so it's already done. add current steam to final tally accum
       ;; then select next state OR set to done
       (let ((for-open-current-vertices-map (let ((table (alexandria:copy-hash-table vertices-data-map)))
                                              (maphash (lambda (k v)
                                                         (setf (gethash k table)
                                                               (copy-instance v)))
                                                       table)
                                              (setf (is-opened-p (gethash active-pl-node table))
                                                    t )
                                              ;; well, this is still done on every turn, lazy would be nice
                                              table)))
         (if (not possible-next-nodes)
             ;; set state to DONE
             (2-persons-visit-each-once-recursive-max-vented
              inactive-pl-node inactive-pl-state
              active-pl-node 'DONE      ; will exit recursion when both DONE
              next-turn total-allotted-time
              (+ freed-to-end-gas-accum for-open-current-total-release)
                                        ; updated accum
              graph
              for-open-current-vertices-map ; updated State map
              shortest-paths)
             ;; call recursively for all possible states with the added accumulator
             ;; else - there are some possible nodes to visit
             ;; main loop - check if OPENING, GOING or what
             (loop for (next-node dist)
                     in possible-next-nodes
                   for next-max = (if (= 0 cur-node-gas-per-turn)
                                      ;; if we for some reason (for example on start) get to node with 0 flow
                                      (2-persons-visit-each-once-recursive-max-vented
                                       inactive-pl-node inactive-pl-state
                                       next-node `(going ,dist)
                                        ; starting to GO to selected NODe
                                       next-turn total-allotted-time
                                       freed-to-end-gas-accum ; same accum
                                       graph
                                       vertices-data-map ; for 0 flow - NOT updated State map
                                       shortest-paths)
                                      ;; if were in NONZERO FLOW node - add to accum
                                      (2-persons-visit-each-once-recursive-max-vented
                                       inactive-pl-node inactive-pl-state
                                       next-node `(going ,dist)
                                        ; starting to GO to selected NODe
                                       next-turn total-allotted-time
                                       (+ freed-to-end-gas-accum for-open-current-total-release)
                                        ; updated accum
                                       graph
                                       for-open-current-vertices-map ; updated State map
                                       shortest-paths)
                                      )
                   maximize next-max into max-freed
                   finally (return max-freed)))))
      ((and (listp active-pl-state)
            (eq (first active-pl-state)
                'going))
       ;; (print "Processing GOING")
       ;; active player is still going
       ;; switch active player and increment turn
       (2-persons-visit-each-once-recursive-max-vented
        inactive-pl-node inactive-pl-state
        active-pl-node `(going ,(1- (second active-pl-state)))
                                        ; one step less
        next-turn total-allotted-time
        freed-to-end-gas-accum
        graph vertices-data-map shortest-paths)
       )
      (t "SHOULD NOT HAPPEN")
      )))
 ;; to start up - set turn 0, allotted time 24. both players as OPENING 'aa starting turn
 ;; HERE INIT
 (defparameter *test-graph* (graph-utils:make-graph))
 (defparameter *test-vertices-map* (make-hash-table))
 (read-file-data "day16-input.txt" *test-graph* *test-vertices-map*)
 ;; (read-file-data "day16-test.txt" *test-graph* *test-vertices-map*)
 ;; (read-file-data "day16-simpler-test.txt" *test-graph* *test-vertices-map*)
 ;; (read-file-data "day16-even-simpler-test.txt" *test-graph* *test-vertices-map*)
 (defparameter *test-shortest-paths* (graph-utils:all-pairs-shortest-paths *test-graph*))
 (print-hashmap *test-shortest-paths*)
 (get-possible-next-vs 'aa *test-graph* *test-vertices-map* *test-shortest-paths* 30)
 ;; FINAL CALCULATION
 ;; (2-persons-visit-each-once-recursive-max-vented 'aa 'opening 'aa 'opening
 ;;                                                 0 26 0
 ;;                                                 *test-graph* *test-vertices-map* *test-shortest-paths*)
 ;; 1482 is less than 1707
 ;; not 1500 is less than 1707
 ;; now 1581 is still less than 1707
 ;; yep, off-by-one in OPENING -> GOING n. should be n-1
 ;; so, after 2 ticks, we have 26 - / 2 2 25 time remaining
 ;; now let's calculate for main task
 ;; Turn:
 ;; active pl:      state (GOING 4), node DO
 ;; inactive pl:    state (GOING 4), node UX
 ;; accum: 1336
 ;; possible next: ((KZ 3) (JM 5) (NO 3))
 ;; current turn: 37; time remaining 8
 ;;
 ;; what were you doing for 24-8 = 16 turns each? well, walking between rooms, yeah
 ;;
 ;; while it runs, let's add printing "max so far"?
 ;;; another recommendation from people in Matrix : https://github.com/michaelw/cl-dot for graphs
--- a/day17-input.txt
+++ b/day17-input.txt
--- a/day17-scratch.lisp
+++ b/day17-scratch.lisp
@ -0,0 +1,998 @@
 ;; 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
--- a/day18-input.txt
+++ b/day18-input.txt
--- a/day18-scratch.lisp
+++ b/day18-scratch.lisp
@ -0,0 +1,166 @@
 ;; ;; https://adventofcode.com/2022/day/18
 ;; so, 1x1x1 cubes on grid, given by x-y-z coords,
 ;; so each line is 1 cube.
 ;;
 ;; my guess is 1,1,1 is cube [0,1]x[0,1]x[0,1]
 ;; and 2,1,1 is cube [1,2]x[0,1]x[0,1]
 ;;
 ;; for cubes to have "joint" side - two dimentions should be totally same
 ;;
 ;; so, could do what? put into 3d array?
 ;; have 3 hash tables?
 ;;
 ;; allright, looking at discussions already.
 ;; i "could" consider these as graph nodes, but what would be the edges?
 ;;
 ;; the 3d array would be 'connectivity' matrix
 ;; then i'd want what ? go through all the nodes.
 ;; and for each node know how many neighbors it has.
 ;; that would directly transform into how many sides are open.
 ;; ok, i guess
 (defparameter *day-18-test-input*
  (mapcar
   (lambda (line)
     (mapcar #'parse-integer (cl-ppcre:split "," line)))
   (uiop:read-file-lines "day18-test.txt")))
 (setq *day-18-test-input* (coords-from-input  "day18-test.txt"))
 ;; so. init array and fill with nodes
 ;; figure out maximal values?
 (loop
  for (x y z) in *day-18-test-input*
  maximize x into xs
  maximize y into ys
  maximize z into zs
  finally (return (list xs ys zs)))
 ;; => (3 3 6)
 (defparameter *day-18-test-graph-connectivity*
  (make-array '(4 4 7) :initial-element 0))
 ;; fill the array with nodes
 (loop
  for (x y z) in *day-18-test-input*
  do (setf (aref *day-18-test-graph-connectivity* x y z) 1))
 ;; and now would have to do full scan? that's not very fun =/
 ;; well, it's not quite what a connectivity matrix is, isn't it?
 ;; connectivity has 1 in (i j) if from node i to node j there's edge
 ;; and it current case we have only 1 unit length connections.
 ;; here's that
 (neighbors-for '(2 2 2) *day-18-test-graph-connectivity*)
 (neighbors-for '(1 1 1) *day-18-test-graph-connectivity*)
 (neighbors-for '(2 3 5) *day-18-test-graph-connectivity*)
 ;; and now to iterate over all of the array?
 ;; how'd i do safer aref?
 ;; well, i guess ok.
 (apply #'aref *day-18-test-graph-connectivity* '(2 3 5))
 ;; this is first time i see something like this
 ;; how to use that correctly though?
 ;; so, last value must be a list, and all values are appended
 ;; so just numbers and nil in the end would work?
 ;; and more importatntly passing array as just self works.
 ;; and splitting points as two lists should work, right?
 (apply #'aref *day-18-test-graph-connectivity* 2 3 '(5))
 ;; no, it doesn't, only one by one with last thing as list
 ;; now loop over all elements as ask amount of neighbors and sum 6-neighbors?
 (loop for x from 0 to 3 sum
                        (loop for y from 0 to 3 sum
                                                (loop for z from 0 to 6
                                                      when (= 1 (aref *day-18-test-graph-connectivity* x y z))
                                                      summing (- 6
                                                                 (length (neighbors-for (list x y z)
                                                                                        *day-18-test-graph-connectivity*)))
                                                        ;; into the-sum
                                                      ;; collecting (list x y z)
                                                      ;;   into nodes
                                                      ;; finally (return (list the-sum nodes))
                                                      )
                              ))
 ;; => (42 ((0 0 0) (0 0 1) (0 0 2) (0 0 3) (0 0 4) (0 0 5) (0 0 6)))
 (neighbors-for '(2 2 2) *day-18-test-graph-connectivity*)
 ;; well it's not quite so pliant to use multiple 'summing 'collecting 'max 'into
 ;; when working with nested loops then
 ;; for those cases DO macro? =C
 (count-open-sides *day-18-test-graph-connectivity*)
 ;; now for my own input?
 (defparameter *day-18-input-coords* nil)
 (setq *day-18-input-coords*
      (coords-from-input "day18-input.txt"))
 (defparameter *day-18-input-connectivity*
  (make-array (find-maxes *day-18-input-coords*) :initial-element 0))
 (fill-connectivity-array *day-18-input-coords* *day-18-input-connectivity*)
 (count-open-sides *day-18-input-connectivity*)
 ;; now. how could i only include surface area
 ;; did i need to model points as what?
 ;;
 ;; well, i could start with 0th layer. there's no stone there, only air
 ;; and start filling with 2
 ;; then count for all points as previously, but only neighbors which are 2
 ;; i guess
 ;; so. start at '(0 0 0)
 ;; then get neighbors, filter those that are 0
 ;; put into queue / list - actually dfs is good enough, so just recurse?
 (point-at-is '(0 0 0) *day-18-test-graph-connectivity* 0)
 (point-at-is '(0 0 0) *day-18-test-graph-connectivity* 2)
 (fill-outside-with-2 '(0 0 0) *day-18-test-graph-connectivity*)
 ;; this seems to work.
 ;; now i want to cound only outside that contacts 2?
 ;; so, same cound but look for neighbors 2 and count them, not 6 - stone-neighbors
 (count-open-sides-to-outside *day-18-test-graph-connectivity*)
 ;; well, now i need to add 1 to all sides
 (setq *day-18-test-input*
      (coords-from-input "day18-test.txt"))
 (setq *day-18-test-graph-connectivity*
 (make-array (find-maxes *day-18-test-input*) :initial-element 0))
 (fill-connectivity-array *day-18-test-input* *day-18-test-graph-connectivity*)
 (fill-outside-with-2 '(0 0 0) *day-18-test-graph-connectivity*)
 (count-open-sides-to-outside *day-18-test-graph-connectivity*)
 ;; and now it's 58
 ;; so, let's cound for full input?
 ;;; part 2
 (setq *day-18-input-coords*
      (coords-from-input "day18-input.txt"))
 (setq *day-18-input-connectivity*
  (make-array (find-maxes *day-18-input-coords*) :initial-element 0))
 (fill-connectivity-array *day-18-input-coords* *day-18-input-connectivity*)
 (fill-outside-with-2 '(0 0 0) *day-18-input-connectivity*)
 (count-open-sides-to-outside *day-18-input-connectivity*)
 ;; 2484  -  not correct, too low
 ;; there's 1 at the edge of the array. whoops. so there are 0s in the input?
 ;; yep. so now what, shift all by 1? and add one more +1 to the find max?
 ;; hahaha, this is stupid.
 ;; but let's do it
 (coords-from-input "day18-test.txt")    ; yep. +1
 ;; 2490
--- a/day18-test.txt
+++ b/day18-test.txt
@ -0,0 +1,13 @@
 2,2,2
 1,2,2
 3,2,2
 2,1,2
 2,3,2
 2,2,1
 2,2,3
 2,2,4
 2,2,6
 1,2,5
 3,2,5
 2,1,5
 2,3,5
--- a/day18.lisp
+++ b/day18.lisp
@ -0,0 +1,71 @@
 ;; https://adventofcode.com/2022/day/18
 (ql:quickload 'cl-ppcre)
 (defun coords-from-input (file-name)
  (mapcar
   (lambda (line)
     (mapcar #'parse-integer (cl-ppcre:split "," line)))
   (uiop:read-file-lines file-name)))
 (defun find-maxes (all-coords)
 (loop
  for (x y z) in all-coords
  maximize (+ x 3) into xs
  maximize (+ y 3) into ys
  maximize (+ z 3) into zs
  finally (return (list xs ys zs))) )
 (defun fill-connectivity-array (all-coords connectivity-matrix)
  (loop
    for (x y z) in all-coords
    do (setf (aref connectivity-matrix x y z) 1)))
 ;; 1 - rock, 0 - initial empty, 2 - outside air
 (defun neighbors-for (coords connectivity-matrix &key (type 1))
  (labels ((coords-fit (potential-point)
             (loop for i from 0 to 2
                   always (and (< (nth i potential-point)
                                  (array-dimension connectivity-matrix i))
                               (>= (nth i potential-point) 0)))))
    (loop
      for deltas in  `((1 0 0) (-1 0 0)
                       (0 1 0) (0 -1 0)
                       (0 0 1) (0 0 -1))
      for neighbor = (mapcar #'+ coords deltas)
      when
      (and (coords-fit neighbor)
           (= type (apply #'aref connectivity-matrix neighbor)))
      collect neighbor)))
 (defun count-open-sides (connectivity-matrix)
  (destructuring-bind (n m k)
      (array-dimensions connectivity-matrix)
    (loop for x from 0 below n sum
          (loop for y from 0 below m sum
                (loop for z from 0 below k
                      when (= 1 (aref connectivity-matrix x y z))
                      summing (- 6
                      (length (neighbors-for (list x y z) connectivity-matrix))))))))
 (defun point-at-is (coords connectivity-matrix elem)
  (= elem (apply #'aref connectivity-matrix coords)))
 ;; call with initial coord '(0 0 0)
 (defun fill-outside-with-2 (coord connectivity-matrix)
  (when (point-at-is coord connectivity-matrix 0)
    (setf (apply #'aref connectivity-matrix coord) 2)
    (mapcar (lambda (neighbor) (fill-outside-with-2 neighbor connectivity-matrix))
            (neighbors-for coord connectivity-matrix :type 0))))
 (defun count-open-sides-to-outside (connectivity-matrix)
  (destructuring-bind (n m k)
      (array-dimensions connectivity-matrix)
    (loop for x from 0 below n sum
          (loop for y from 0 below m sum
                (loop for z from 0 below k
                      when (= 1 (aref connectivity-matrix x y z))
                      summing (length (neighbors-for
                                       (list x y z)
                                       connectivity-matrix
                                       :type 2)))))))
--- a/day19-2-input.txt
+++ b/day19-2-input.txt
@ -0,0 +1,3 @@
 Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 12 clay. Each geode robot costs 4 ore and 19 obsidian.
 Blueprint 2: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 11 clay. Each geode robot costs 4 ore and 12 obsidian.
 Blueprint 3: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 18 clay. Each geode robot costs 2 ore and 11 obsidian.
--- a/day19-input.txt
+++ b/day19-input.txt
@ -0,0 +1,30 @@
 Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 12 clay. Each geode robot costs 4 ore and 19 obsidian.
 Blueprint 2: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 11 clay. Each geode robot costs 4 ore and 12 obsidian.
 Blueprint 3: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 18 clay. Each geode robot costs 2 ore and 11 obsidian.
 Blueprint 4: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 15 clay. Each geode robot costs 4 ore and 20 obsidian.
 Blueprint 5: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 16 clay. Each geode robot costs 4 ore and 17 obsidian.
 Blueprint 6: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 19 clay. Each geode robot costs 2 ore and 12 obsidian.
 Blueprint 7: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 9 clay. Each geode robot costs 2 ore and 10 obsidian.
 Blueprint 8: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 5 clay. Each geode robot costs 3 ore and 7 obsidian.
 Blueprint 9: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 11 clay. Each geode robot costs 4 ore and 8 obsidian.
 Blueprint 10: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 16 clay. Each geode robot costs 2 ore and 15 obsidian.
 Blueprint 11: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 20 clay. Each geode robot costs 2 ore and 19 obsidian.
 Blueprint 12: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 16 clay. Each geode robot costs 3 ore and 20 obsidian.
 Blueprint 13: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 20 clay. Each geode robot costs 3 ore and 14 obsidian.
 Blueprint 14: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 20 clay. Each geode robot costs 2 ore and 15 obsidian.
 Blueprint 15: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 15 clay. Each geode robot costs 3 ore and 12 obsidian.
 Blueprint 16: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 17 clay. Each geode robot costs 3 ore and 19 obsidian.
 Blueprint 17: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 14 clay. Each geode robot costs 4 ore and 9 obsidian.
 Blueprint 18: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 6 clay. Each geode robot costs 3 ore and 16 obsidian.
 Blueprint 19: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 6 clay. Each geode robot costs 2 ore and 14 obsidian.
 Blueprint 20: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 4 ore and 11 clay. Each geode robot costs 3 ore and 15 obsidian.
 Blueprint 21: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 18 clay. Each geode robot costs 4 ore and 19 obsidian.
 Blueprint 22: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 15 clay. Each geode robot costs 2 ore and 20 obsidian.
 Blueprint 23: Each ore robot costs 4 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 5 clay. Each geode robot costs 2 ore and 10 obsidian.
 Blueprint 24: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 10 clay. Each geode robot costs 2 ore and 14 obsidian.
 Blueprint 25: Each ore robot costs 4 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 7 clay. Each geode robot costs 4 ore and 13 obsidian.
 Blueprint 26: Each ore robot costs 3 ore. Each clay robot costs 3 ore. Each obsidian robot costs 2 ore and 20 clay. Each geode robot costs 2 ore and 20 obsidian.
 Blueprint 27: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 18 clay. Each geode robot costs 2 ore and 19 obsidian.
 Blueprint 28: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 3 ore and 10 clay. Each geode robot costs 2 ore and 7 obsidian.
 Blueprint 29: Each ore robot costs 3 ore. Each clay robot costs 4 ore. Each obsidian robot costs 2 ore and 15 clay. Each geode robot costs 3 ore and 7 obsidian.
 Blueprint 30: Each ore robot costs 2 ore. Each clay robot costs 4 ore. Each obsidian robot costs 4 ore and 20 clay. Each geode robot costs 4 ore and 18 obsidian.
--- a/day19-scratch.lisp
+++ b/day19-scratch.lisp
@ -0,0 +1,462 @@
 ;; https://adventofcode.com/2022/day/19
 ;; whelp. do i do somehow DP? generic over parameters of blueprints somehow
 ;; we could potentially calculate optimal step in forward time, but i'm not sure how.
 ;; and backward time - no easy way to know which robots will be available?
 ;;
 ;; intuitive idea, have some state of (resource1, recource2, robot1, robot2)
 ;; and have 2 types of steps, one - production is simple
 ;; then we can have different types of actions - build robot1 \ build robot2 - parallel these out
 ;; somehow prune ideally, but then move forward in time and get max of these. i guess it's ok plan
 ;; so.
 ;; - each robot collects 1 of it's own resource per minute
 ;; so function to update state with new resources is common
 ;; - cost of one new robot, consumed immediately, robot is produced in 1 minute
 ;;      costs are different and listed in the bluerint
 ;; i suppose overall format of the blueprint is the same, only numbers change.
 ;; so could hardcode the translation
 ;;
 ;; and i guess i'd have one class of "blueprint" and several instances,
 ;; each instance does the updating of the state.
 (in-package :day-19)
 (defclass state ()
  ((geodes :initform 0 :initarg :geodes)
   (ore :initform 0 :initarg :ore)
   (clay :initform 0 :initarg :clay)
   (obsidian :initform 0 :initarg :obsidian)
   (geodes-robot :initform 0 :initarg :geodes-robot)
   (ore-robot :initform 1 :initarg :ore-robot)
   (clay-robot :initform 0 :initarg :clay-robot)
   (obsidian-robot :initform 1 :initarg :obsidian-robot)))
 (defclass blueprint ()
  ((ore-robot-cost :initarg :ore)
  (clay-robot-cost :initarg :clay)
  (obsidian-robot-cost :initarg :obsidian)
   (geode-robot-cost :initarg :geode)))
 ;; wrote like this initially
 (make-instance 'state)
 ;; i'd like to have code across building robots, checking whether robot can be build
 ;; to be shared. would i want to do it with classes?
 ;; state could have hashmaps from symbol to the amount
 ;; do i want to have plists?
 (defparameter *my-plist* '(:ore 1 :clay 15))
 *my-plist*
 (getf *my-plist* :ore)
 (getf *my-plist* :clay)
 (setf (getf *my-plist* :clay) 3)
 ;; i guess i like that
 ;; then i could have robot costs as plists as well?
 ;; i could iterate over the plist with destructuring
 ;; and blueprint can just be plist of plists
 ;; we don't really need generic method dispatch
 ;; but for state - i'd kind of want to have static field
 ;; to share found max and pruning
 (loop
  for (resource cost) on '(:ore 3 :clay 14) by #'cddr
  ;; for (resource cost) in (getf *test-blueprint* :obsidian)
  collect (list (* 2 cost) 'is 'cost resource) )
 ;; yes. comprehension is possible
 (defparameter *test-state* (make-instance 'state))
 (setf  (getf  (resources *test-state*) :ore 0) 5)
 (setf  (getf  (robots *test-state*) :ore 0) 2)
 (setf  (getf  (robots *test-state*) :obsidian 0) 5)
 ;; now let's check my function for can-create
 (print *test-state*)
 (can-create-robot *test-blueprint* :ore *test-state*)
 (can-create-robot *test-blueprint* :clay *test-state*)
 (can-create-robot *test-blueprint* :geode *test-state*)
 (can-create-robot *test-blueprint* :obsidian *test-state*)
 ;; yay, i guess
 ;;
 ;; i had the error of putting quoted lists into the quoted list
 ;;
 ;; and now function to create new state with resources for a particular robot deducted?
 ;; and i guess with that robot already increased.
 ;; that function would signify passing of one turn \ minute
 (setq *test-state* (make-instance 'state))
 (setf  (getf  (resources *test-state*) :ore 0) 3)
 (defparameter *another-state*
  (create-robot *test-blueprint* :clay *test-state*))
 ;; well, that seems to work.
 ;; now i'd need to create blueprints from the lines.
 ;; then for each of the blueprint, calculate maximum of geodes.
 ;; multiply with the :id and sum.
 ;;
 ;; ok, i guess. i'd want a function that takes in blueprint.
 ;; gets initial state. and recurses searching for maximum
 ;; maybe even saving into blueprint as well.
 ;; how would that recursion look?
 ;; ore is added at the end of the minute.
 ;; resources for building is taken out at the beginning of the minute
 ;; built bot is added at the end of the minute
 ;;
 ;; so, i could
 ;; - calculate resources to be added
 ;; - for each possible (on old resources) bot build
 ;;      recurse with bot cost deducted and new resources added
 ;; so next functions would be
 ;; - resources-to-be-collected :: just the plist of additional resources that would be
 ;; generated in 1 turn
 ;; and
 ;; - add-resources :: modifying operation that would update state
 *test-state*
 (calc-resources-to-be-collected *test-state*)
 ;; lol.
 (add-resources '(:spagetty 1 :tuna 2) *test-state*)
 ;; and it works
 ;; so, now only main loop i suppose. and maybe-maybe later-later pruning
 (get-possible-bot-builds *test-blueprint* *test-state*)
 (defmethod find-max-geod (blueprints (s state) minute)
  ;; (format t "in step for ~a; with ~a~%" minute s)
  (if (= 25 minute)
      (getf (resources s) :geode 0)
      (progn
        (let* ((will-collect-this-minute (calc-resources-to-be-collected s))
              (max-if-building
                (loop
                  for bot-type in (get-possible-bot-builds blueprints s)
                  for state-with-new-bot = (create-robot blueprints bot-type s)
                  when state-with-new-bot
                  maximize (progn
                               (add-resources will-collect-this-minute state-with-new-bot)
                               (find-max-geod blueprints state-with-new-bot (1+ minute)))))
               (if-not-building (let ((state-copy (copy-state s)))
                                  ;; (break)
                                  (add-resources will-collect-this-minute state-copy)
                                  (find-max-geod blueprints state-copy (1+ minute)))))
          (max (or max-if-building 0) if-not-building)))))
 ;; Blueprint 1:
 ;;   Each ore robot costs 4 ore.
 ;;   Each clay robot costs 2 ore.
 ;;   Each obsidian robot costs 3 ore and 14 clay.
 ;;   Each geode robot costs 2 ore and 7 obsidian.
 ;; Blueprint 2:
 ;;   Each ore robot costs 2 ore.
 ;;   Each clay robot costs 3 ore.
 ;;   Each obsidian robot costs 3 ore and 8 clay.
 ;;   Each geode robot costs 3 ore and 12 obsidian.
 ;; do i just test this?
 (setq *test-blueprint* '(:ore (:ore 4)
                         :clay (:ore 2)
                         :obsidian (:ore 3 :clay 14)
                         :geode (:ore 2 :obsidian 7)))
 (setq *test-state* (make-instance 'state))
 ;; (print (find-max-geod *test-blueprint* *test-state* 1))
 ;; => 0
 ;; that's because i have no ability to "wait"
 ;; whoops
 ;; so. do i want, um. add one more attempted call after the loop in the iteration?
 ;; now. the looping is serious.
 ;; would it work for me to order keys geode first
 ;; now we seem to get geodes first, yay
 ;; maybe just run without printing?
 ;; let's check manually that when i do state copy, the plists are independent?
 (setq *test-state* (make-instance 'state))
 *test-state*
 (setq *another-state* (copy-state *test-state*))
 (incf (getf (resources *another-state*) :ore 0))
 *another-state*
 (add-resources '(:seeds 151) *another-state*)
 (incf (getf (robots *another-state*) :obsidian 0))
 ;; oh, i didn't check that state returned from the "create bot" is independent
 (setq *test-state* (make-instance 'state))
 (add-resources '(:ore 10) *test-state*)
 (setq *another-state* (create-robot *test-blueprint* :clay *test-state*))
 ;; ugh. resources stays shared.
 ;; WTF, why
 ;; manually create new list, i guess then then do set to the 'copied state'?
 ;; this is unpleasant
 ;; so, i guess use (copy-list
 ;; ok. the numbers seem ok. but this is long.
 ;; how do i trim this?
 ;; if on step 10 there's already a state with 3 obsidian machines.
 ;; does this state would always be ahead of
 ;; state on step 10 with 1 obsidian machine?
 ;;
 ;; it seems so!
 ;; for which reason? because if the state got 3 geode machines, it will be able to get more?
 ;; i suppose only when i reach case where each new step can add one more geod machine
 ;; only then i can guess the state is actually domeeneering?
 ;; but only over states with same amount of steps?
 ;; ok. let's commit what i have right now and try to trim?
 ;; how could i compare with that "cur-max" and update that cur-max?
 ;; no, i don't understand
 (format t "some result ~a~%" (find-max-geod *test-blueprint* *test-state* 1))
 ;; well, yes one optimizaiton - stop building robots, when resource is to the top of
 ;; max daily expense
 ;; that would reduce a lot
 ;; 1)
 ;; would be nice to put these into (possible-robots-to-build)
 ;; so that it would also filtered out unnecessary new robots
 ;;
 ;; 2)
 ;; "keep global current max state" how would i compare and check if it's impossible to beat?
 ;; with "even if i could to build geod machine every day for rest N days"
 *test-blueprint*
 *test-state*
 (add-resources '(:ore 10) *test-state*)
 (incf (getf (robots *test-state*) :ore)  2)
 (any-use-of-creating-robot *test-blueprint* *test-state* :ore)
 (any-use-of-creating-robot *test-blueprint* *test-state* :clay)
 (any-use-of-creating-robot *test-blueprint* *test-state* :obsidian)
 (any-use-of-creating-robot *test-blueprint* *test-state* :geode)
 (max-need *test-blueprint* *test-state* :ore)
 (max-need *test-blueprint* *test-state* :clay)
 (max-need *test-blueprint* *test-state* :obsidian)
 (max-need *test-blueprint* *test-state* :geode)
 ;; and this is not good for :geode, we want as much as possible
 (get-possible-bot-builds *test-blueprint* *test-state*)
 ;; and now let's add static "max state"?
 ;; i'd need comparison like "can catch up" with that found max "is dominated by"
 ;; and also way to update that maximal state?
 ;;
 ;; so, what will that be?
 ;; comparison for update, should it also be if i found a state that dominates?
 ;; only for satiated states?
 ;;
 ;; if day is same or more
 ;; but the amount of geode robots and geodes is smaller?
 (is-satiated-p *test-blueprint* *test-state*)
 (incf (getf (robots *test-state*) :obsidian 0)  20)
 ;; seems to work,
 ;; but i already want to utilize some test framework
 ;; whelp. i do want to test this
 ;; 4 14 7 to be satisfied
 (is-satiated-p
 *test-blueprint*
 (make-instance 'state :robots '(:ore 4 :clay 14 :obsidian 7 :geode 2)))
 (is-satiated-p
 *test-blueprint*
 (make-instance 'state :resources '(:ore 4 :clay 14 :obsidian 7 :geode 2))) ; not, need robots
 (is-satiated-p
 *test-blueprint*
 (make-instance 'state :robots '(:ore 4 :clay 14 :obsidian 7 :geode 2)))
 ;; now for checking is-dominated. ugh.
 (a-dominates-b-p
 *test-blueprint*
 (make-instance 'state :robots '(:ore 4 :clay 14 :obsidian 7 :geode 2))
 (make-instance 'state :robots '(:ore 4 :clay 14 :obsidian 7 :geode 2)))
 ;; both satiated, but second bigger
 (a-dominates-b-p
 *test-blueprint*
 (make-instance 'state :robots '(:ore 5 :clay 17 :obsidian 7 :geode 2))
 (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2)))
 ;;
 ;; both satiated, but second not always bigger
 (a-dominates-b-p
 *test-blueprint*
 (make-instance 'state :robots '(:ore 5 :clay 17 :obsidian 9 :geode 2))
 (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 8 :geode 2)))
 ;;
 ;; first not satiated, even though second is bigger - nil
 (a-dominates-b-p
 *test-blueprint*
 (make-instance 'state :robots '(:ore 2 :clay 17 :obsidian 9 :geode 2))
 (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 8 :geode 2)))
 ;; and that's not right. if we have on same amount of steps
 ;; reference as satiated and checking as not - wouldn't keep up
 ;; so big check should be whether steps are even in imagination permit
 ;; ugh. that would mean putting minute\step into state.
 ;; um, let's not do it right now?
 ;; for both satiated is a very weak check, but let's try it like this?
 (setq *test-state* (make-instance 'state))
 (setf (cur-found-max *test-state*) (make-instance 'state))
 ;; so whelp
 ;; should have committed after doing the "build makes sence list"
 ;;
 ;; my problems are because "is dominated by" is not simmetrical to "dominates"
 ;; and i want both
 ;;
 ;; now in the loop set first satiated as domination
 ;; after that compare if our set dominates that one and swap
 ;; and compare if it's dominated by that one and prune
 ;; so, only if ref earlier than checked state.
 ;; and then - if checked not saitated, or by all resources less than
 ;; but i do want tests
 ;; both satiated, but second bigger
 (a-dominates-b-p
 *test-blueprint*
 (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2) :minute 2)
 (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2) :minute 3))
 ;; should be NIL
 ;; now want to check for different amount of steps.
 ;; so if same resources but first is earlier - it dominates
 (minute (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2) :minute 2))
 ;; i was putting :minute 2 into :robots plist, cool, no thanks to you types
 (minute (make-instance 'state :robots '(:ore 6 :clay 18 :obsidian 7 :geode 2) :minute 2))
 ;; ok. this also seems well.
 ;; then main loop? on fisrt satiated set as `cur-found-max`
 ;; and after that always check -
 (defmethod find-max-geod-2 (blueprints (s state))
  ;; (declare (optimize (debug 3)))
  ;; (format t "in step for ~a; with ~a~%" (minute s) s)
  (cond
    ((= 25 (minute s))                  ; exit condition fully calculated
     (getf (resources s) :geode 0))
    ((< (estimate s) (cur-found-max s))
     ;; (print "pruning")
     0)                           ; pruning this branch
    (t                                  ; default check
     (progn
       (let* ((will-collect-this-minute (calc-resources-to-be-collected s))
              (possible-bot-builds (get-possible-bot-builds blueprints s))
              (max-if-building
                (when possible-bot-builds
                  (loop
                    for bot-type in possible-bot-builds
                    for state-with-new-bot = (create-robot blueprints bot-type s)
                    when state-with-new-bot
                      maximize (progn
                                 (add-resources will-collect-this-minute state-with-new-bot)
                                 (incf (minute state-with-new-bot))
                                 (find-max-geod-2 blueprints state-with-new-bot )))))
              (if-not-building
                (let ((state-copy (copy-state s)))
                  ;; (break)
                  (add-resources will-collect-this-minute state-copy)
                  (incf (minute state-copy))
                  (find-max-geod-2 blueprints state-copy )))
              (recursed-max (max (or max-if-building 0) if-not-building)))
         ;; (break)
         ;; (format t "would build ~a~%" possible-bot-builds)
         (when (> recursed-max (cur-found-max s))
           (setf (cur-found-max s) recursed-max))
         recursed-max
         )))))
 (setq *test-state* (make-instance 'state))
 (setf (cur-found-max *test-state*) 0)
 (timing (print (find-max-geod-2 *test-blueprint* *test-state*)))
 (timing (let ((a 1) (b 2)) (* a b 15)))
 ;; thank you CL-Cookbook: https://cl-cookbook.sourceforge.net/dates_and_times.html
 (defmacro timing (&body forms)
  (let ((real1 (gensym))
 	    (real2 (gensym))
 	    (run1 (gensym))
 	    (run2 (gensym))
 	    (result (gensym)))
    `(let* ((,real1 (get-internal-real-time))
 	        (,run1 (get-internal-run-time))
 	        (,result (progn ,@forms))
 	        (,run2 (get-internal-run-time))
 	        (,real2 (get-internal-real-time)))
 	   (format *debug-io* ";;; Computation took:~%")
 	   (format *debug-io* ";;;  ~f seconds of real time~%"
 		       (/ (- ,real2 ,real1) internal-time-units-per-second))
 	   (format t ";;;  ~f seconds of run time~%"
 		       (/ (- ,run2 ,run1) internal-time-units-per-second))
 	   ,result)))
 ;; so, why doesn't it ever builds obsidian?
 *test-blueprint*
 ;; because is "has to build something if it can" whops
 ;; wow 20 seconds. cool
 ;; last things:
 ;; read in the line for the blueprints into plist
 ;; then loop over lines in file
 ;; for each line compute max, multiply by index
 ;; and sum
 ;; ok, i guess
 (rest (remove-if-not #'identity
                     (mapcar (lambda (str) (parse-integer str :junk-allowed t))
                             (ppcre:split " "
                                          "Blueprint 2: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 8 clay. Each geode robot costs 3 ore and 12 obsidian."))))
 (blueprint-line-to-plist "Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 2 ore. Each obsidian robot costs 3 ore and 14 clay. Each geode robot costs 2 ore and 7 obsidian.")
 ;; and now loop over file.
 (print (with-open-file (in "day19-test.txt")
         (loop
           for line = (read-line in nil nil)
           for n from 1
           for blueprints = (when line  (progn
                                          (format t "Starting processing for ~a~%" line)
                                          (blueprint-line-to-plist line)))
           for max-geo = 0
           ;; for max-geo = (when blueprints
           ;;                 (progn
           ;;                   (setf (cur-found-max *test-state*) 0)
           ;;                   (timing (find-max-geod-2 blueprints (make-instance 'state)))))
           while blueprints
           do (format t "processed ~a : ~a. its max is ~a~%" n blueprints max-geo)
           summing (* n max-geo))))
 (format t "and the result is : ~a~%" (read-and-calc-part-1 "day19-test.txt"))
 (format t "and the result is : ~a~%" (read-and-calc-part-1 "day19-input.txt"))
 ;; wtf is taking so long in between the processings?
 (apply #'* (list 2 3 5))
 ;; but before that - change exit point
 (format t "and the result is : ~a~%" (read-and-calc-part-2 "day19-2-input.txt"))
 ;; 261 is too low. so
 ;; but in previous my maxes were 0 1 2
 ;; and current are 3 3 29
 ;; but still not good
 ;; ugh. what about test input?
 (format t "and the result is : ~a~%" (read-and-calc-part-2 "day19-test.txt"))
 ;; my calc : 18 and 55
 ;; correct : 56 and 62
 ;; coooool. let's move on.
--- a/day19-test.txt
+++ b/day19-test.txt
@ -0,0 +1,2 @@
 Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 2 ore. Each obsidian robot costs 3 ore and 14 clay. Each geode robot costs 2 ore and 7 obsidian.
 Blueprint 2: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 8 clay. Each geode robot costs 3 ore and 12 obsidian.
--- a/day19.lisp
+++ b/day19.lisp
@ -0,0 +1,193 @@
 ;; https://adventofcode.com/2022/day/19
 (defpackage :day-19
  (:use :cl))
 (in-package :day-19)
 (ql:quickload 'cl-ppcre)
 (defparameter *all-types* '(:geode :obsidian :clay :ore))
 (defclass state ()
  ((resources :accessor resources :initform nil :initarg :resources)
   (robots :accessor robots :initform (list :ore 1) :initarg :robots)
   (minute :accessor minute :initarg :minute :initform 1 )
   (cur-found-max :initform nil :accessor cur-found-max :allocation :class) ; would be nice to add types
   ))
 (defmethod print-object ((obj state) stream)
  (print-unreadable-object (obj stream :type t)
    (with-slots (resources robots)
        obj
      (format stream "collected: ~a, with robots: ~a"
              resources robots))))
 ;; example of blueprint:
 (defparameter *test-blueprint*
  '(:ore (:ore 4)
    :clay (:ore 2)
    :obsidian (:ore 3 :clay 14)
    :geode (:ore 2 :obsidian 7)))
 ;; thank you blambert & stackoverflow
 ;; https://stackoverflow.com/questions/11067899/is-there-a-generic-method-for-cloning-clos-objects
 ;; oh, but this is shallow copy and lists reused. crap
 (defmethod copy-state ((s state))
  (make-instance 'state :resources (copy-list (resources s))
                        :robots (copy-list (robots s))
                        :minute (minute s)))
 (defmethod can-create-robot (blueprints type (s state))
  (let ((this-robot-costs (getf blueprints type)))
    (loop for (resource amount) on this-robot-costs by #'cddr
          always (>= (getf (resources s) resource 0) amount))))
 (defmethod create-robot (blueprints type (s state))
  (when (can-create-robot blueprints type s)
    (let ((this-robot-costs (getf blueprints type))
          (copied-state (copy-state s)))
      (loop for (resource amount) on this-robot-costs by #'cddr
            do (incf (getf (resources copied-state) resource 0) (- amount)))
      (incf (getf (robots copied-state) type 0))
      copied-state)))
 (defmethod calc-resources-to-be-collected ((s state))
  (robots s))
 (defmethod add-resources (new-resources (s state))
  (loop for (resource amount) on new-resources by #'cddr
        do (incf (getf (resources s) resource 0) amount)))
 ;; robot is unnecessary if resouce it brings is alreay produced
 ;; at amount of maximal possible per-turn expence
 (defmethod max-need (blueprints (s state) resource-type)
  (loop
    for (la blueprint) on blueprints by #'cddr
    ;; do (print blueprint)
    maximize (getf blueprint resource-type 0)))
 (defmethod any-use-of-creating-robot (blueprints (s state) robot-type)
  (if (eq :geode robot-type)
      t                                 ; always reason to build more geode robots
      (let ((max-need (max-need blueprints s robot-type))
            (state-production (getf (robots s) robot-type 0)))
        ;; (format t "comparing need ~a with prod ~a" max-need state-production)
        (> max-need state-production))))
 (defmethod get-possible-bot-builds (blueprints (s state))
  (remove-if-not (lambda (robot-type)
                   (any-use-of-creating-robot blueprints s robot-type))
                 (remove-if-not (lambda (robot-type)
                                  (can-create-robot blueprints robot-type s))
                                *all-types*)))
 ;; true when no longer need to build secondary robots
 (defmethod is-satiated-p (blueprints (s state))
  (loop for type in '(:ore :clay :obsidian)
        never (any-use-of-creating-robot blueprints s type)))
 (defmethod a-dominates-b-p (blueprints (a state) (b state))
  ;; (declare (optimize (debug 3)))
  (when (is-satiated-p blueprints a) ; when not a satiated - don't know
    (and
     (<= (minute a) (minute b))         ; a earlier than b
     (or
      (not (is-satiated-p blueprints b))
      (loop for resource-type in *all-types* ; for both satiated compare all resources
            always (and (>= (getf (resources a) resource-type 0)
                            (getf (resources b) resource-type 0))
                        (>= (getf (robots a) resource-type 0)
                            (getf (robots b) resource-type 0))))))))
 ;; loose bound on geodes
 (defmethod estimate ((s state))
  (let ((time-left (- 25 (minute s))))
    (+ (getf (resources s) :geode 0)
       (* time-left (getf (robots s) :geode 0))
       (/ (* time-left (1- time-left)) 2))))
 (defmethod find-max-geod-2 (blueprints (s state))
  (declare (optimize (speed 3)))
  ;; (declare (optimize (debug 3)))
  ;; (format t "in step for ~a; with ~a~%" (minute s) s)
  (cond
    (
     (= 33 (minute s))                  ; exit condition fully calculated
     ;; (= 25 (minute s))                  ; exit condition fully calculated
     (getf (resources s) :geode 0))
    ((< (estimate s) (cur-found-max s))
     ;; (print "pruning")
     0)                           ; pruning this branch
    (t                                  ; default check
     (progn
       (let* ((will-collect-this-minute (calc-resources-to-be-collected s))
              (possible-bot-builds (get-possible-bot-builds blueprints s))
              (max-if-building
                (when possible-bot-builds
                  (loop
                    for bot-type in possible-bot-builds
                    for state-with-new-bot = (create-robot blueprints bot-type s)
                    when state-with-new-bot
                      maximize (progn
                                 (add-resources will-collect-this-minute state-with-new-bot)
                                 (incf (minute state-with-new-bot))
                                 (find-max-geod-2 blueprints state-with-new-bot )))))
              (if-not-building
                (let ((state-copy (copy-state s)))
                  ;; (break)
                  (add-resources will-collect-this-minute state-copy)
                  (incf (minute state-copy))
                  (find-max-geod-2 blueprints state-copy )))
              (recursed-max (max (or max-if-building 0) if-not-building)))
         ;; (break)
         ;; (format t "would build ~a~%" possible-bot-builds)
         (when (> recursed-max (cur-found-max s))
           (setf (cur-found-max s) recursed-max))
         recursed-max
         )))))
 (defun blueprint-line-to-plist (line)
  (destructuring-bind
      (ore-cost-in-ore clay-cost-in-ore obs-cost-in-ore obs-cost-in-clay
       geod-cost-in-ore geod-cost-in-obs)
      (rest (remove-if-not #'identity
                           (mapcar (lambda (str) (parse-integer str :junk-allowed t))
                                   (ppcre:split " " line))))
    `(:ore (:ore ,ore-cost-in-ore)
      :clay (:ore ,clay-cost-in-ore)
      :obsidian (:ore ,obs-cost-in-ore :clay ,obs-cost-in-clay)
      :geode (:ore ,geod-cost-in-ore :obsidian ,geod-cost-in-obs))))
 (defun read-and-calc-part-1 (filename)
  (with-open-file (in filename)
    (loop
      for line = (read-line in nil nil)
      for n from 1
      for blueprints = (when line  (blueprint-line-to-plist line))
      for max-geo = (when blueprints
                      (progn
                        (setf (cur-found-max *test-state*)
                              0)
                        (format t "Starting processing for ~a" line)
                        (timing (find-max-geod-2 blueprints (make-instance 'state)))))
      while blueprints
      do (format t "processed ~a. its max is ~a~%" n max-geo)
      summing (* n max-geo))))
 (defun read-and-calc-part-2 (filename)
  (with-open-file (in filename)
    (loop
      for line = (read-line in nil nil)
      for n from 1
      for blueprints = (when line  (progn
                                     (format t "Starting processing for ~a~%" line)
                                     (blueprint-line-to-plist line)))
      for max-geo = (when blueprints
                      (progn
                        (setf (cur-found-max *test-state*) 0)
                        (timing (find-max-geod-2 blueprints (make-instance 'state)))))
      while blueprints
      do (format t "processed ~a. its max is ~a~%" n max-geo)
      collecting max-geo into maxes
      finally (return (apply #'* maxes)))))
--- a/day20-input.txt
+++ b/day20-input.txt
--- a/day20-scratch.lisp
+++ b/day20-scratch.lisp
@ -0,0 +1,257 @@
 ;; https://adventofcode.com/2022/day/20
 (in-package :day-20)
 ;; so. how would i do moves in a list?
 ;; and are there duplicate numbers?
 ;; it's possible but not sure.
 ;; also in the input numbers are 4k 5k.
 ;; i guess on during the moving it would be best to figure out their index?
 ;; could i insert into list at index?
 ;; it could be nice to use just cycled list. but.
 ;; maybe use array?
 '(1 2 -3 3 -2 0 4)
 ;; calculating index and then modifying array. is it easy to do shifts on array?
 ;; and i'd sometimes need to
 ;; and how multiple passes work with going over self?
 ;; let's take a break
 ;; i guess i could copy part of array with the offset arrays
 ;;
 ;; the stupid version seems to be 4 cases :
 ;; - to right inside of array
 ;; - to right over with overflow
 ;; - to left inside of array
 ;; - to left over with overflow
 ;; but when overflow - could stop to the left or to the right of self.
 (defparameter *my-arr*
  (aops:linspace 0 9 10))
 ;; imagine i'm displacing 345 by 1 to right
 ;; ( that would mean 6 moving 3 to the left)
 (setq *my-arr* (aops:linspace 0 9 10))
 (let ((to-be-moved (make-array 3  :displaced-to *my-arr* :displaced-index-offset 3))
      (into-these-move (make-array 3  :displaced-to *my-arr* :displaced-index-offset 4)))
  (loop
    for i from 2 downto 0
    do (setf (aref into-these-move i) (aref to-be-moved i))))
 *my-arr*
 ;; now displacing 345 by 1 to left
 (setq *my-arr* (aops:linspace 0 9 10))
 (let ((to-be-moved (make-array 3  :displaced-to *my-arr* :displaced-index-offset 3))
      (into-these-move (make-array 3  :displaced-to *my-arr* :displaced-index-offset 2)))
  (loop
    for i from 0 below 3
    do (setf (aref into-these-move i) (aref to-be-moved i))))
 *my-arr*
 ;; now let's also remember "moved" element and put it to the "freed up space"
 ;; moving 6 by 3 to the left
 (setq *my-arr* (aops:linspace 0 9 10))
 (let* ((index-of-moved 6)
       (moved-value (aref *my-arr* index-of-moved))
       (move-by -3)
       (to-be-moved (make-array 3  :displaced-to *my-arr*
                                   :displaced-index-offset (+ index-of-moved move-by)))
       (into-these-move (make-array 3  :displaced-to *my-arr*
                                       :displaced-index-offset (+ index-of-moved move-by 1))))
  (loop
    for i from 2 downto 0
    do (setf (aref into-these-move i) (aref to-be-moved i)))
  (setf (aref *my-arr* (+ index-of-moved move-by)) moved-value))
 *my-arr*
 ;; ok. but these 2 downto 0 || 0 to 2 dependent on -3 +3 and that's ugh
 ;; moving 2 by 3 to the right (now displacing 345 by 1 to left)
 (setq *my-arr* (aops:linspace 0 9 10))
 (let* ((index-of-moved 2)
       (moved-value (aref *my-arr* index-of-moved))
       (move-by 3)
       (to-be-moved (make-array 3  :displaced-to *my-arr*
                                   :displaced-index-offset (+ index-of-moved 1)))
       (into-these-move (make-array 3  :displaced-to *my-arr*
                                       :displaced-index-offset index-of-moved)))
  (loop
    for i from 0 to 2
    do (setf (aref into-these-move i) (aref to-be-moved i)))
  (setf (aref *my-arr* (+ index-of-moved move-by)) moved-value))
 *my-arr*
 ;; so also difference in displaced indexes.
 ;; shift to LEFT (move item left):
 ;;
 ;; shift to RIGHT (move item right):
 ;; well, i could just save this code as two separate functions
 ;; would be nice to immediately start doing the repeatable tests
 (move-item-to-left (aops:linspace 0 9 10) 6 6)
 ;; and a separate function for swithing to the right?
 (move-item-to-right (aops:linspace 0 9 10) 6 1)
 (move-item-to-right (aops:linspace 0 9 10) 6 2)
 (move-item-to-right (aops:linspace 0 9 10) 6 3)
 ;; next what? calculation of the target index through modulo
 '(1 2 3 4 5 6 7 8 9)
 ;; if we're moving 2 by -2 how does that work?
 ;; we have starting index 1, we have length 9.
 ;; my guess is that take MOD by 9-1
 ;; how many swaps to the right until the element returns to its original place?
 '(1 2 3 4 5 6 7 8 9)
 '(2 1 3 4 5 6 7 8 9)
 '(1 3 4 5 6 7 8 9 2)
 '(1 3 4 5 6 7 8 2 9)
 '(1 3 4 5 6 7 2 8 9)
 '(1 3 4 5 6 2 7 8 9)
 '(1 3 4 5 2 6 7 8 9)
 '(1 3 4 2 5 6 7 8 9)
 '(1 3 2 4 5 6 7 8 9)
 '(1 2 3 4 5 6 7 8 9)
 ;; so, if moving by 9. hm
 ;; then moving by 12 is 9 + 3
 (mod 9 3)
 (mod 10 3)
 (length (make-array 7))
 (move-item-to-left (aops:linspace 0 9 10) 6 9)
 ;; ok, now join into one function that moves the element by it's value?
 (find 4 '(1 4 3 2 9))
 (position 4 '(1 4 3 2 9))
 (defparameter *test-array* (make-array 7 :initial-contents '(1 2 -3 3 -2 0 4)))
 *test-array*
 (move-elem-by-itself *test-array* -2)
 ;; whelp. my movements are ugh.
 ;; so. "i'd want additional move on top of my move-left and move-right"?
 (mod -1 3)
 (move-item *test-array* 3 3)
 (move-item *test-array* 3 4)
 (defparameter *test-array* (make-array 7 :initial-contents '(1 2 -3 3 -2 0 4)))
 *test-array*
 (move-elem-by-itself *test-array* -2)
 ;; this seems to work.
 ;; now back to the loop?
 (defparameter *test-array* (make-array 7 :initial-contents '(1 2 -3 3 -2 0 4)))
 (mixing-array *test-array*)
 ;; after moving 2, arr: #(1 -3 2 3 -2 0 4)
 ;; after moving -3, arr: #(1 2 3 -2 0 -3 4)
 ;; -3 move wasn't correct
 (loop for elem across *test-array*
      do (print elem))
 (defparameter *test-array* (make-array 7 :initial-contents '(1 -3 2 3 -2 0 4)))
 (move-elem-by-itself *test-array* -3)
 ;; 0 -> 0
 ;; -1 -> (len - 1)
 ;; -2 -> (len - 2)
 (mod -1 7)
 ;; so, just hack it? when we move to the left, we add one more?
 ;; so, ugh and when moving to positive, but going over the what
 ;; the number is not "switched" with the neighbor, it's jumping over the neighbor...
 ;; so, if we go to 0 or to len-1 then we jump to the other side?
 (defparameter *test-array* (make-array 7 :initial-contents '(1 -3 3 -2 2 0 4)))
 (move-elem-by-itself *test-array* 2)
 (defparameter *test-array* (make-array 7 :initial-contents '(1 -3 3 -2 2 4 0)))
 (move-elem-by-itself *test-array* 4)
 (defparameter *test-array* (make-array 7 :initial-contents '(1 2 -3 0 3 4 -2)))
 (move-item *test-array* 5 4)
 (move-elem-by-itself *test-array* 4)
 ;; now this incorrect:
 ;; after moving 3, arr: #(1 2 -2 -3 0 3 4)
 ;; after moving -2, arr: #(-2 1 2 -3 0 3 4)
 ;; -2 should have went instead of to 0 straight to the end. so
 ;;
 ;; and now it works
 ;; god i also need to take 1000th value with overbound. ugh.
 (get-ugh-nth (mixing-array *test-array*) 1000)
 (get-ugh-nth (mixing-array *test-array*) 2000)
 (get-ugh-nth (mixing-array *test-array*) 3000)
 ;; uh. after the value 0...
 ;; so first find index of 0
 (let* ((nums (mapcar #'parse-integer (uiop:read-file-lines "day20-input.txt")))
      (input-arr (make-array (length nums) :initial-contents nums))
      (mixed (mixing-array input-arr)))
  (+ (get-ugh-nth (mixing-array mixed) 1000)
     (get-ugh-nth (mixing-array mixed) 2000)
     (get-ugh-nth (mixing-array mixed) 3000)))
 ;; 1797 is too low,
 (part-1-ans "day20-test.txt")
 (part-1-ans "day20-input.txt")
 ;; well, do we have duplicates?
 (ql:quickload :fset)
 (fset:set 1 2 3)
 (fset:set '(1 2 3))
 (print (let* ((nums (mapcar #'parse-integer (uiop:read-file-lines "day20-input.txt")))
              (input-arr (make-array (length nums) :initial-contents nums))
              (input-set (fset:convert 'fset:set nums))
              )
         (list 'arr (length input-arr) 'set (fset:size input-set))
         ))
 ;; (ARR 5000 SET 3613)
 ;; well, yupikayey
 ;; how should i be doint that?
 ;; AND i should have checked that from the start.
 ;; so. there are duplicates.
 (fset:convert 'fset:bag '(1 2 3 2 4 5))
 ;; what should i do about the duplicates?
 ;; i'd need to store elements with their initial indexes i suppose
 ;; and then what? iterate not over initial collection, but just over "initial" indexes
 ;; so, how'd i do that?
 ;; #'move-item works with index and move-by
 ;; so shouldn't depent on type of elements
 ;; so just #'move-elem-by-itself should take in "original index"
 ;; then find position in the array by the index.
 ;; and array would be (index value)
 (zip-with-index '(2 14 1 3 5))
 (input-arr "day20-test.txt")
 (mixing-array (input-arr "day20-test.txt"))
 ;; and it works, now.
 ;;
 ;; next - extract the values from the 1000th etc
 ;; wait what. why did i do the mixing again. ugh
 ;; was that the problem, not the duplicates? will revert after getting to the answer,
 ;; but yikes
 ;; oh, i need to find 0 by value in new array
 (part-1-ans "day20-test.txt")
 (part-1-ans "day20-input.txt")
 ;; and i get a gold star.
 ;; let's commit and try with revert?
--- a/day20-test.txt
+++ b/day20-test.txt
@ -0,0 +1,7 @@
 1
 2
 -3
 3
 -2
 0
 4
--- a/day20.lisp
+++ b/day20.lisp
@ -0,0 +1,136 @@
 ;; https://adventofcode.com/2022/day/20
 (defpackage :day-20
  (:use :cl))
 (in-package :day-20)
 (ql:quickload :array-operations)
 (ql:quickload "fiveam")
 (ql:quickload 'alexandria)
 (5am:def-suite day20-tests)
 ;; and shift some slice 1 to right
 (defun move-item-to-left (array moved-index move-size)
  (declare (optimize (debug 3)))
  (let* ((move-size (mod move-size (1- (length array))))
         (moved-value (aref array moved-index))
         (move-by (- (mod move-size (length array))))
         (moving-slice-size move-size)
         (to-be-moved (make-array moving-slice-size  :displaced-to array
                                                     :displaced-index-offset (+ moved-index move-by)))
         (into-these-move (make-array moving-slice-size  :displaced-to array
                                                         :displaced-index-offset (+ moved-index move-by 1))))
    (loop
      for i from (1- move-size) downto 0
      do (setf (aref into-these-move i)
               (aref to-be-moved i)))
    (setf (aref array (+ moved-index move-by)) moved-value)
    array))
 (5am:def-test move-left-inside-of-array (:suite day20-tests)
  (5am:is (equalp (make-array 10 :initial-contents '(0 1 2 6 3 4 5 7 8 9))
                 (move-item-to-left (aops:linspace 0 9 10) 6 3))))
 (5am:def-test move-left-to-edge (:suite day20-tests)
  (5am:is (equalp (make-array 10 :initial-contents '(6 0 1 2 3 4 5 7 8 9))
                 (move-item-to-left (aops:linspace 0 9 10) 6 6))))
 (5am:def-test move-by-arr-size-leaves-intact (:suite day20-tests)
  (5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 6 7 8 9))
                 (move-item-to-left (aops:linspace 0 9 10) 6 9))))
 (5am:def-test move-by-more-than-arr-size (:suite day20-tests)
  (5am:is (equalp (make-array 10 :initial-contents '(0 1 2 6 3 4 5 7 8 9))
                 (move-item-to-left (aops:linspace 0 9 10) 6 12))))
 (defun move-item-to-right (array moved-index move-by)
  (declare (optimize (debug 3)))
  (let* ((move-by (mod move-by (1- (length array))))
         (moved-value (aref array moved-index))
         (moving-slice-size move-by)
         (to-be-moved (make-array moving-slice-size
                                  :displaced-to array
                                  :displaced-index-offset (+ moved-index 1)))
         (into-these-move (make-array moving-slice-size
                                      :displaced-to array
                                      :displaced-index-offset moved-index)))
    (loop
      for i from 0 below move-by
      do (setf (aref into-these-move i)
               (aref to-be-moved i)))
    (setf (aref array (+ moved-index move-by)) moved-value)
    array))
 (5am:def-test move-right-inside-of-array (:suite day20-tests)
  (5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 7 6 8 9))
                  (move-item-to-right (aops:linspace 0 9 10) 6 1))))
 (5am:def-test move-right-to-edge (:suite day20-tests)
  (5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 7 8 9 6))
                  (move-item-to-right (aops:linspace 0 9 10) 6 3))))
 (5am:def-test move-right-by-arr-size-leaves-intact (:suite day20-tests)
  (5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 6 7 8 9))
                 (move-item-to-right (aops:linspace 0 9 10) 6 9))))
 (5am:def-test move-right-by-more-than-arr-size (:suite day20-tests)
  (5am:is (equalp (make-array 10 :initial-contents '(0 1 2 3 4 5 7 8 9 6))
                 (move-item-to-right (aops:linspace 0 9 10) 6 12))))
 (defun move-item (array move-index move-by)
  (let* ((raw-target-index (if (>= move-by 0)
                               (+ move-index move-by)
                               (+ move-index move-by)))
         (in-array-target-index (mod raw-target-index (1- (length array))))
         (in-array-target-index (if (= 0 in-array-target-index)
                                    (1- (length array))
                                    in-array-target-index ; a hack
                                    ))
         (safe-move-by (- in-array-target-index move-index)))
    ;; (list move-index move-by
    ;;       'raw-target raw-target-index
    ;;       'in-array-target in-array-target-index
    ;;       'safe-move-by safe-move-by)
    (if (> safe-move-by 0)
        (move-item-to-right array move-index safe-move-by)
        (move-item-to-left array move-index (- safe-move-by)))
    ))
 ;; we know the element value, but not it's place
 (defun move-elem-by-itself (array initial-index)
  (declare (optimize (debug 3)))
  (let ((i (position initial-index array :test (lambda (searched-index zipped)
                                                 (= searched-index (car zipped))))))
    (move-item array i (second (aref array i)))))
 (defun mixing-array (arr)
  (let ((to-be-modified (alexandria:copy-array arr)))
    (loop
      for initial-index from 0 below (length arr)
      ;; for elem across arr
      do (progn (move-elem-by-itself to-be-modified initial-index)
                ;; (format t "after moving ~a, arr: ~a~%" elem to-be-modified)
                ))
    to-be-modified))
 (defun zip-with-index (ls)
  (loop for v in ls
        for i from 0
        collect (list i v)))
 (defun input-arr (filename)
  (let ((nums (mapcar #'parse-integer (uiop:read-file-lines filename))))
    (make-array (length nums) :initial-contents (zip-with-index nums))))
 (defun get-ugh-nth (arr n)
  ;; need to find 0 by value in the (index, value) array
  (let* ((zero-ind (position 0 arr :test (lambda (searched-value zipped)
                                           (= searched-value (second zipped)))))
        (unsafe-index (+ zero-ind n))
        (safe-n (mod unsafe-index (length arr))))
    (second (aref arr safe-n))))
 (defun part-1-ans (filename)
  (let* ((input-arr (input-arr filename))
         (mixed (mixing-array input-arr)))
    (format t "getting part 1, mixed array: ~a~%" mixed)
    (+ (get-ugh-nth mixed 1000)
       (get-ugh-nth mixed 2000)
       (get-ugh-nth mixed 3000))))
 (5am:run! 'day20-tests)
Author	SHA1	Message	Date
efim	281a0aebf4	day 20 part 2, yay	2022-12-25 09:40:10 +00:00
efim	974cc4993d	day 20 kicking me with duplicates	2022-12-25 09:10:19 +00:00
efim	2eb4b5c0a5	at least part 1 of day 19	2022-12-24 12:45:54 +00:00
efim	bf52645d93	this is "optimization"	2022-12-24 10:11:53 +00:00
efim	83f65babdf	not yet anything for day 19	2022-12-23 22:58:50 +00:00
efim	598500e289	day 18, part 2 complete, with a little bit ugly	2022-12-22 20:41:17 +00:00
efim	831f09c9cd	day 18, part 2, not complete, before going ugly	2022-12-22 20:37:14 +00:00
efim	643bba2464	day 18, part 1, the simple one	2022-12-22 19:49:43 +00:00
efim	01d5c300d6	giving up on day 17	2022-12-20 20:34:07 +00:00
efim	69250daf63	day 16 part 2, quite stuck	2022-12-18 18:59:07 +00:00
efim	ae745dc0f2	day 17 part 1. ugh	2022-12-18 17:22:43 +00:00
efim	3126cd48ab	day 16 monstrocity calculated overnight	2022-12-18 07:19:59 +00:00
+,2,2
+,2,2
+,2,2
+,1,2
+,3,2
+,2,1
+,2,3
+,2,4
+,2,6
+,2,5
+,2,5
+,1,5
+,3,5
		`@ -0,0 +1,2 @@`
							`Blueprint 1: Each ore robot costs 4 ore. Each clay robot costs 2 ore. Each obsidian robot costs 3 ore and 14 clay. Each geode robot costs 2 ore and 7 obsidian.`
							`Blueprint 2: Each ore robot costs 2 ore. Each clay robot costs 3 ore. Each obsidian robot costs 3 ore and 8 clay. Each geode robot costs 3 ore and 12 obsidian.`