From 5c9f0cd12ae2099dd730442ab8983ef17c44bb1e Mon Sep 17 00:00:00 2001 From: Oscar Najera Date: Fri, 6 Jan 2023 20:25:14 +0100 Subject: finding a period --- AoC2022/17/solver.lisp | 64 +++++++++++++++++++++++++++++++++++--------------- 1 file changed, 45 insertions(+), 19 deletions(-) (limited to 'AoC2022/17/solver.lisp') diff --git a/AoC2022/17/solver.lisp b/AoC2022/17/solver.lisp index bad968a..b84807c 100644 --- a/AoC2022/17/solver.lisp +++ b/AoC2022/17/solver.lisp @@ -87,24 +87,26 @@ (simulate chamber new-place next-shift)))) -(defun solver (drops-left highpoint obstacles next-rock next-shift) +(defun solver (drops-left highpoint raise-history obstacles next-rock next-shift) (declare (optimize (speed 3))) (declare (type fixnum drops-left highpoint)) (declare (type function next-rock)) (if (zerop drops-left) - ;; (values highpoint obstacles) - highpoint + raise-history + ;; highpoint (multiple-value-bind (new-obstacles posible-high) (simulate obstacles (place-rock (funcall next-rock) (the fixnum (+ highpoint 3))) next-shift) - (declare (type fixnum posible-high)) - (solver (1- drops-left) (max highpoint posible-high) - (if (zerop (mod drops-left 100)) ;; arbitrarily chop list - (subseq new-obstacles 0 (min 128 (length new-obstacles))) - new-obstacles) - next-rock next-shift)))) + (let ((new-high (max highpoint posible-high))) + (vector-push new-high raise-history) + (solver (1- drops-left) new-high raise-history + ;; new-obstacles + (if (zerop (mod drops-left 100)) ;; arbitrarily chop list + (subseq new-obstacles 0 (min 128 (length new-obstacles))) + new-obstacles) + next-rock next-shift))))) (fiveam:test solutions (fiveam:is @@ -113,16 +115,40 @@ (= 3141 (solver 2022 0 nil (gen-object *rocks*) (gen-object (uiop:read-file-line "input")))))) ;; (print (solver 1000000000000 0 nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in")))) -(time (solver 40000 0 nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in")))) + +(length (uiop:read-file-line "eg-in")) + +(let ((drops 2065)) + (multiple-value-bind (hi hist) (solver drops 0 (make-array drops :initial-element 0 :fill-pointer 1) nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in"))) + (length hi) + (find-period hi 620))) +(+ 22 37) ;; (require :sb-sprof) ;; (sb-sprof::start-profiling) ;; (sb-sprof:report :type :flat) - -;; (let ((a (make-array 5 :fill-pointer 0 :adjustable t))) -;; (vector-push-extend 2 a) -;; (vector-push-extend 6 a) -;; (vector-push-extend 8 a) -;; ;; (vector-push-extend 2 a) -;; ;; (vector-push-extend 6 a) -;; ;; (vector-push-extend 5 a) -;; (vector-push-extend 5 a)) +(defun occurrences (lst) + (let ((table (make-hash-table :test #'eq))) + (loop for e in lst + do (incf (gethash e table 0))) + (loop for k being the hash-key of table using (hash-value v) + collect (cons k v)))) +(* 59 35) +(length '(60 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 + 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 53 + 53 53 53 53 53 53 53 53 53 )) +(defun find-period (history max-window) + (let* ((len (1- (length history)))) + (loop for size from 1 to max-window + for raises = (loop + for start from 0 to len by size + for end from size by size + collect (- (aref history (min end len)) (aref history start)) + ;; collect (reduce #'+ (subseq history start (min end len))) + ) + for periods = (occurrences raises) + when (<= (length periods) 3) + collect (list size periods raises) + ;; finally (return (list size periods raises)) + + ;; collect (list size (length periods) periods) + ))) -- cgit v1.2.3