From 01d5c300d6e12c12f9f15bb2c79f827af12a1222 Mon Sep 17 00:00:00 2001 From: efim Date: Tue, 20 Dec 2022 20:34:07 +0000 Subject: [PATCH] giving up on day 17 --- day17-scratch.lisp | 305 ++++++++++++++++++++++++++++++++++++++------- 1 file changed, 262 insertions(+), 43 deletions(-) diff --git a/day17-scratch.lisp b/day17-scratch.lisp index 44af361..2d21f94 100644 --- a/day17-scratch.lisp +++ b/day17-scratch.lisp @@ -67,7 +67,7 @@ (setf (aref row i) #\_)) grid)) nil) -(init-test-grid) +(init-test-grid 200) (defun print-grid (grid ) (let ((rows (array-dimension grid 0)) @@ -174,7 +174,6 @@ (is-point-free '(0 . 2) *test-grid*) (is-point-free '(9 . 2) *test-grid*) (is-point-free '(1 . 9) *test-grid*) -(resting-into-array *test-h-line* *test-grid* '(2 . 1)) (is-point-free '(2 . 0) *test-grid*) (is-point-free '(2 . 1) *test-grid*) @@ -203,7 +202,7 @@ (defun -check-fig (fig) (let ((hook '(7 . 2))) - (init-test-grid) + (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) @@ -212,7 +211,7 @@ (print-grid *test-grid*) (points-into-array (check-right-points fig hook) *test-grid* #\R) (print-grid *test-grid*) - (init-test-grid) + (init-test-grid 200) )) ;; hook is left point @@ -237,6 +236,7 @@ (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 @@ -281,7 +281,7 @@ ) ) ; do i need that? (defparameter *test-cross* (make-instance 'cross)) -(init-test-grid) +(init-test-grid 200) (resting-into-array *test-cross* *test-grid* '(2 . 2)) (print-grid *test-grid*) (defmethod check-down-points ((fig cross) hook) @@ -517,7 +517,7 @@ ;; do move down, and loop for the lateral change and possible exit (setq hook (cons (1+ (car hook)) (cdr hook))))))) -(init-test-grid) +(init-test-grid 200) (print-grid *test-grid*) *test-grid* (let ((my-list '(1 2 3 4))) @@ -598,25 +598,25 @@ ;; (print-grid grid) ) -(init-test-grid) -(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 +;; (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 +;; (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) -(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 +;; (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 @@ -633,14 +633,14 @@ ;; 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 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) -(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 +;; (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. @@ -663,9 +663,10 @@ (typep 1 'fixnum) (init-test-grid 10000) -(defparameter *test-run-result* - (try-dropping *endless-shapes* - *endless-test-laterals* 2022 *test-grid*)) ; this is not right. no lateral moves done +(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) @@ -676,9 +677,9 @@ ;;; 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 +;; (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? @@ -694,9 +695,9 @@ (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 +;; (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 @@ -711,10 +712,11 @@ ;; 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 +(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) @@ -777,3 +779,220 @@ ;; ;; 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