;; https://github.com/kraison/graph-utils ;; ;; maybe "distance map" is closure completion? ;; (defpackage :mypackage ;; (:use :cl) ;; (:local-nicknames (:gu :graph-utils) ;; (:alex :alexandria) ;; (:re :cl-ppcre))) ;; (in-package :mypackage) ;; (graph-utils:make-graph) ;; (gu:make-graph) ; so, calling functions work, autocomplete doesn't (ql:quickload 'graph-utils) (ql:quickload 'alexandria) (in-package cl-user) ;; 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))) ;; thank you blambert & stackoverflow ;; https://stackoverflow.com/questions/11067899/is-there-a-generic-method-for-cloning-clos-objects (defgeneric copy-instance (object &rest initargs &key &allow-other-keys) (:documentation "Makes and returns a shallow copy of OBJECT. An uninitialized object of the same class as OBJECT is allocated by calling ALLOCATE-INSTANCE. For all slots returned by CLASS-SLOTS, the returned object has the same slot values and slot-unbound status as OBJECT. REINITIALIZE-INSTANCE is called to update the copy with INITARGS.") (:method ((object standard-object) &rest initargs &key &allow-other-keys) (let* ((class (class-of object)) (copy (allocate-instance class))) (dolist (slot-name (mapcar #'sb-mop:slot-definition-name (sb-mop:class-slots class))) (when (slot-boundp object slot-name) (setf (slot-value copy slot-name) (slot-value object slot-name)))) (apply #'reinitialize-instance copy initargs)))) (defparameter *test-graph* (graph-utils:make-graph)) ;; (graph-utils:add-node *test-graph* 'a) ;; (graph-utils:add-node *test-graph* 'b) ;; (graph-utils:add-edge *test-graph* 'a 'b :weight 1) ;; (graph-utils:add-node *test-graph* (list 'c 48)) (defclass my-node () ((name :reader name :initarg :name) (value :reader value :initarg :value))) (setq node-a (make-instance 'my-node :name 'a :value 40)) (setq node-b (make-instance 'my-node :name 'b :value 28)) (graph-utils:add-node *test-graph* node-a) (graph-utils:add-node *test-graph* node-b) (graph-utils:add-edge *test-graph* node-a node-b) (graph-utils:node-ids *test-graph*) ;; will that find all paths for nodes? that would be nice (graph-utils:all-pairs-shortest-paths *test-graph*) (loop for key being each hash-key of (graph-utils:all-pairs-shortest-paths *test-graph*) using (hash-value value) do (format t "~a : ~a~%" key value )) ;; (0 . 0) : 0 ;; (1 . 1) : 0 ;; (0 . 1) : 1 ;; (1 . 0) : 1 ;; yeah, that's nice. ;; now, i'd really like to be able to get node by the slot of the object? (in-package cl-user) (graph-utils:lookup-node *test-graph* 'a) ;; (graph-utils:lookup-triple *test-graph* 'a) ;; i could get custom equality function. ;; but, hm. like that could be called on both symbol and object to be put into hashmap? ;; is that bad? ;; or, i guess i could use object \ name as nodes, ;; and have separate hashmap that correlates that node name with the node content ;; that would be ok, i think! ;; lookup node ;; lookup triple (?) - "subject predicate object" that's queries for logical programming ;; neighbors ;; predicate ;; rename-node (?) ;; select ;; select-first ;; now, i'd want to retrieve node from graph by name. ;; how'd i do that? ;; not needed, equal is ok for defclass ;; (defun my-node-equal (n1 n2) ;; (equal (name n1) (name n2))) ;; (equal 'a 'a) ;; (let ((m-n (make-instance 'my-node :name 'a :value 40))) ;; (equal m-n m-n)) ;; (my-node-equal (make-instance 'my-node :name 'a :value 40) ;; (make-instance 'my-node :name 'c :value 12)) ;; (equal (make-instance 'my-node :name 'a :value 40) ;; (make-instance 'my-node :name 'c :value 12)) (graph-utils:visualize *test-graph*) ;; => ;; ("Valve" "AA" "has" "flow" "rate" "0;" "tunnels" "lead" "to" "valves" "DD" "" ;; "II" "" "BB") (defun parse-integer-or-symbol (str) (let ((maybe-int (parse-integer str :junk-allowed t))) (if maybe-int maybe-int (intern (string-upcase str))))) ;;; so, do i want to go with loading of the file into memory? ;; reading line (ql:quickload 'cl-ppcre) (destructuring-bind (-valve source-name -has -flow -rate flow-rate -tunnels -lead -to -valves &rest to-valve-names) (mapcar #'parse-integer-or-symbol (let ((test-line "Valve AA has flow rate=0; tunnels lead to valves DD, II, BB")) (remove-if (lambda (str) (equal "" str)) (cl-ppcre:split "(,| |=)" test-line)))) (format t "from ~a with ~a; to ~a~%" source-name flow-rate to-valve-names) (list source-name flow-rate to-valve-names)) (defun parse-input-line (line) (destructuring-bind (-valve source-name -has -flow -rate flow-rate -tunnels -lead -to -valves &rest to-valve-names) (mapcar #'parse-integer-or-symbol (remove-if (lambda (str) (equal "" str)) (cl-ppcre:split "(,| |=)" line))) (format t "from ~a with ~a; to ~a~%" source-name flow-rate to-valve-names) (list source-name flow-rate to-valve-names))) (parse-input-line "Valve AA has flow rate=0; tunnels lead to valves DD, II, BB") ;; => from AA with 0; to (DD II BB) ;; ;; (AA 0 (DD II BB)) (parse-input-line "Valve BB has flow rate=13; tunnels lead to valves CC, AA") (parse-input-line "Valve HH has flow rate=22; tunnel leads to valve GG ") ;; ok. that works ;; so. for this i'll create nodes AA DD II BB ;; put edges AA to\from all other 3 ;; and put state of AA into a hashmap? ;;; now. for PART 1. ;; do i want to build a graph, put value and statuses of the node into separate hashmap ;; and then what? ;; have paths from node to all others computed. ;; and do walk, where I choose to which node to go next? ;; ;; i suppose so ;; now. how do i want to proceed? ;; do i want to return both? ugh. ;; i could use "returning multiple values", or just return list ;; take in file name, get lines, split them, then for each line put ;; - required vertice and edge into graph ;; - put current vertice data into hashmap (defclass verticle-data () ((flow :reader flow :initarg :flow) (name :reader name :initarg :name) (is-opened-p :accessor is-opened-p :initform nil))) (defmethod print-object ((obj verticle-data) stream) (with-slots (name flow is-opened-p) obj ( print-unreadable-object (obj stream :identity t :type t) (format stream "~a with flow: ~a; is opened ~a" name flow is-opened-p)))) (defparameter *test-storages* (let ((line-struct '(AA 0 (DD II BB))) (graph (graph-utils:make-graph)) (verticle-data-hashmap (make-hash-table))) (destructuring-bind (cur-verticle flow connected) line-struct (let ((cur-verticle-data (make-instance 'verticle-data :flow flow))) (graph-utils:add-node graph cur-verticle) (setf (gethash cur-verticle verticle-data-hashmap) cur-verticle-data) (loop for to-node in connected do (progn (graph-utils:add-node graph to-node) (graph-utils:add-edge graph cur-verticle to-node))))) (list graph verticle-data-hashmap))) (first *test-storages*) (defparameter *test-graph* (graph-utils:make-graph)) (defparameter *test-vertices-map* (make-hash-table)) (defun put-struct-into-storages (line-struct graph verticle-data-hashmap) (destructuring-bind (cur-verticle flow connected) line-struct (let ((cur-verticle-data (make-instance 'verticle-data :flow flow :name cur-verticle))) (graph-utils:add-node graph cur-verticle) (setf (gethash cur-verticle verticle-data-hashmap) cur-verticle-data) (loop for to-node in connected do (progn (graph-utils:add-node graph to-node) (graph-utils:add-edge graph cur-verticle to-node))))) (list graph verticle-data-hashmap)) (defun read-file-data (filename graph vertices-data-map) (loop for line-struct in (mapcar #'parse-input-line (uiop:read-file-lines filename)) do (put-struct-into-storages line-struct graph vertices-data-map))) ;; HERE INIT (defparameter *test-graph* (graph-utils:make-graph)) (defparameter *test-vertices-map* (make-hash-table)) ;; (read-file-data "day16-test.txt" *test-graph* *test-vertices-map*) (read-file-data "day16-simpler-test.txt" *test-graph* *test-vertices-map*) (defparameter *test-shortest-paths* (graph-utils:all-pairs-shortest-paths *test-graph*)) ;; (put-struct-into-storages '(AA 0 (DD II BB)) *test-graph* *test-vertices-map*) (loop for line-struct in (mapcar #'parse-input-line (uiop:read-file-lines "day16-test.txt")) do (put-struct-into-storages line-struct *test-graph* *test-vertices-map*)) (defun print-hashmap (map &optional (stream t)) (loop for k being each hash-keys of map using (hash-value v) do (format stream "~a : ~a~%" k v))) (loop for k being each hash-keys of *test-vertices-map* using (hash-value v) do (format t "~a : ~a~%" k v)) (graph-utils:visualize *test-graph*) ;; yeah, i guess that's what i want. ;; i'd also like i think to open that graphically? maybe? (defparameter *test-shortest-paths* (graph-utils:all-pairs-shortest-paths *test-graph*)) (print-hashmap *test-shortest-paths*) ;; well, that's nice ;; but, can i then get vertice by it's id? (graph-utils:lookup-node *test-graph* 0) ;; ok, i guess that's good enough. ;; could map that number to node name ;; so. now i'm starting in node 0. ;; what's the algo? ;; i get all nodes i can go to. ;; from the map of "transitive paths" ;; for each of these I call with "remaining time - length" and get it's max ;; ;; ugh. it's a mess. yes, it's smaller exponential, but it's still it ;; ;; well, my puzzle inut does have lots of RATE 0 valves ;; so, on each turn get all reachable ;; filter out those that are already closed or with rate 0 ;; ;; call for max for going to that node immediately ;; or with (time - 1) and current valve being closed ;; and pass in different copies of hashmap and graph, i guess (graph-utils:copy-graph *test-graph*) ;; and i do need to copy hash-table, right? or at least restore it on return. (alexandria:copy-hash-table *test-vertices-map*) ;; yeah, ok. i guess ;; the function would be: ;; get current node, current graph ;; remaining time - that's exit condition ;; compute distances? or pass them in, i guess they don't change ;; get all pairs that start with current node. ;; filter out those where target node is either already closed or with 0 flow ;; ;; for each - do two recursive calls. ;; ;; exit condition - ;; always return at least it's own maximum. ;; if time remaining is not enough to travel to any unclosed vertice. ;; 1 turn open own. then remaining turns * own-flow ;; helper function. ;; for graph and state. (maybe filter by reachability also?) ;; return only those targets and direction to them ;; where target is unopened and flow > 0 (print-hashmap *test-shortest-paths*) (graph-utils:lookup-node *test-graph* 'aa) (graph-utils:lookup-node *test-graph* 0) (let* ((cur-node 'aa) (vertices-data-map *test-vertices-map*) (graph *test-graph*) (shortest-paths (graph-utils:all-pairs-shortest-paths graph)) ) (loop for (from . to) being the hash-keys in shortest-paths using (hash-value dist) for from-node = (graph-utils:lookup-node graph from) for to-node = (graph-utils:lookup-node graph to) for to-node-data = (gethash to-node vertices-data-map) ;; when (and (equal cur-node from-node) ;; (not (= 0 (flow to-node-data))) ;; (is-opened-p to-node-data)) ;; do (format t "from ~a to ~a dist: ~a. ~a~%" from-node to-node dist to-node-data) when (and (equal cur-node from-node) (not (= 0 (flow to-node-data))) (not (is-opened-p to-node-data))) collect (list to-node dist) )) (defun get-possible-next-vs (cur-node graph vertices-data-map shortest-paths time-remaining) (loop for (from . to) being the hash-keys in shortest-paths using (hash-value dist) for from-node = (graph-utils:lookup-node graph from) for to-node = (graph-utils:lookup-node graph to) for to-node-data = (gethash to-node vertices-data-map) ;; when (and (equal cur-node from-node) ;; (not (equal cur-node to-node)) ;; (not (= 0 (flow to-node-data))) ;; (> time-remaining dist) ;; (is-opened-p to-node-data)) ;; do (format t "from ~a to ~a dist: ~a. ~a~%" from-node to-node dist to-node-data) when (and (equal cur-node from-node) (not (equal cur-node to-node)) (not (= 0 (flow to-node-data))) (> time-remaining dist) (not (is-opened-p to-node-data))) collect (list to-node dist))) (get-possible-next-vs 'aa *test-graph* *test-vertices-map* *test-shortest-paths* 30) (get-possible-next-vs 'bb *test-graph* *test-vertices-map* *test-shortest-paths* 30) ;; wow, now this looks nice ;; will get copy of vertices-data-map. and will give copy to innner recursions (defun recursive-max-vented (cur-node time-left graph vertices-data-map shortest-paths) (let* ((possible-next-nodes (get-possible-next-vs cur-node graph vertices-data-map shortest-paths time-left)) (cur-node-gas-per-turn (flow (gethash cur-node vertices-data-map))) (for-open-current-total-release (max 0 ; in case we get to -1 time remaining (* cur-node-gas-per-turn (1- time-left)) ; freed gas after opening and staying )) (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 cur-node table)) t ) table))) (if (not possible-next-nodes) ;; ending condition, either all opened or no more time for-open-current-total-release ;; else - there are some possible nodes to visit (progn ;; (format t "in ~a. left steps ~a~%" cur-node time-left) (loop for (next-node dist) in possible-next-nodes for max-with-open-current = (+ for-open-current-total-release (recursive-max-vented next-node (- (1- time-left) dist) ; spent 1 turn opening current graph for-open-current-vertices-map shortest-paths)) for max-not-opening-current = (recursive-max-vented next-node (- time-left dist) ; going there directly graph vertices-data-map shortest-paths) maximize max-with-open-current into max-freed maximize max-not-opening-current into max-freed finally (return max-freed)))))) (defparameter *test-graph* (graph-utils:make-graph)) (defparameter *test-vertices-map* (make-hash-table)) (read-file-data "day16-test.txt" *test-graph* *test-vertices-map*) (defparameter *test-shortest-paths* (graph-utils:all-pairs-shortest-paths *test-graph*)) (print (recursive-max-vented 'aa 10 *test-graph* *test-vertices-map* *test-shortest-paths*)) ;; (print (recursive-max-vented 'aa 30 *test-graph* *test-vertices-map* *test-shortest-paths*)) ;; let's try to wait. and then what? try to have smaller step amount ;; then try with smaller graphs (graph-utils:visualize *test-graph*) (get-possible-next-vs 'aa *test-graph* *test-vertices-map* *test-shortest-paths* 30) (print-hashmap *test-shortest-paths*) (print-hashmap *test-vertices-map*) ; wow. so i copy hashmap, but it's a shallow copy. ; i need to copy all values inside. oioioi ;; (copy-structure (gethash 'aa *test-vertices-map*)) (copy-instance (gethash 'aa *test-vertices-map*)) ;; oh, but would then my vertices found? they should since key is same symbol, right? ;; and it didn't work? ;; yeah, because mapvalues doesn't substitute values as in scala. ugh ;; have i mixed the valve states twice? ;; for 30 it works VERY long time ;; ok. if i'm copying the hashmap. cna i parallel the calls in some easy way? ;;; STARTING to read about concurrency; ;; https://lispcookbook.github.io/cl-cookbook/process.html (member :thread-support *FEATURES*) ;; possibly just Lparallel has some simple macro that will parallel my computations ;; i guess just parallel map is enough? (ql:quickload 'lparallel) ;; (timing ;; (let ((sum1 (loop for x from 1 to 1000000000 sum x)) ;; (sum2 (loop for y from 1 to 1000000000 sum y))) ;; (+ sum1 sum2))) ;; (timing ;; (lparallel:plet ((sum1 (loop for x from 1 to 100000000 sum x)) ;; (sum2 (loop for y from 1 to 100000000 sum y))) ;; (+ sum1 sum2))) ;; (lparallel:pmap) ;; the problem is in function that returns for each node maximum of 2 recursive calls ;; so, could i like flet that part? ;; and then do pmapcar for each node. and then take max of that ;; will get copy of vertices-data-map. and will give copy to innner recursions (defun precursive-max-vented (cur-node time-left graph vertices-data-map shortest-paths) (let* ((possible-next-nodes (get-possible-next-vs cur-node graph vertices-data-map shortest-paths time-left)) (cur-node-gas-per-turn (flow (gethash cur-node vertices-data-map))) (for-open-current-total-release (max 0 ; in case we get to -1 time remaining (* cur-node-gas-per-turn (1- time-left)) ; freed gas after opening and staying )) (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 cur-node table)) t ) table))) (if (not possible-next-nodes) ;; ending condition, either all opened or no more time for-open-current-total-release ;; else - there are some possible nodes to visit (flet ((recursive-max-for-next (next-node dist) (lparallel:plet ((max-with-open-current (+ cur-node-gas-per-turn (precursive-max-vented next-node (- (1- time-left) dist) ; spent 1 turn opening current graph for-open-current-vertices-map shortest-paths))) (max-not-opening-current (precursive-max-vented next-node (- time-left dist) ; going there directly graph vertices-data-map shortest-paths))) (max max-not-opening-current max-with-open-current)))) (loop for (next-node dist) in possible-next-nodes maximize (recursive-max-for-next next-node dist)))))) ;; (timing ;; (print (recursive-max-vented 'aa 14 *test-graph* *test-vertices-map* *test-shortest-paths*))) ;; (timing ;; (print (precursive-max-vented 'aa 14 *test-graph* *test-vertices-map* *test-shortest-paths*))) 111 ;;; Computation took: ;;; 4.733019 seconds of real time ;;; 4.723482 seconds of run time 111 ;;; Computation took: ;;; 12.166053 seconds of real time ;;; 85.1261 seconds of run time ;; ok, now let's also start all next nodes separately? (defun precursive-max-vented (cur-node time-left graph vertices-data-map shortest-paths) (progn (format t "starting iteration for ~a, left ~a" cur-node time-left) (print-hashmap vertices-data-map) (let* ((possible-next-nodes (get-possible-next-vs cur-node graph vertices-data-map shortest-paths time-left)) (cur-node-gas-per-turn (flow (gethash cur-node vertices-data-map))) (for-open-current-total-release (max 0 ; in case we get to -1 time remaining (* cur-node-gas-per-turn (1- time-left)) ; freed gas after opening and staying )) (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 cur-node table)) t ) table))) (if (not possible-next-nodes) ;; ending condition, either all opened or no more time for-open-current-total-release ;; else - there are some possible nodes to visit (flet ((recursive-max-for-next (next-node dist) (let ((max-with-open-current (+ for-open-current-total-release (precursive-max-vented next-node (- (1- time-left) dist) ; spent 1 turn opening current graph for-open-current-vertices-map shortest-paths))) (max-not-opening-current (precursive-max-vented next-node (- time-left dist) ; going there directly graph vertices-data-map shortest-paths))) (max max-not-opening-current max-with-open-current)))) (apply #'max (lparallel:pmapcar (lambda (next-and-dist-list) (recursive-max-for-next (first next-and-dist-list) (second next-and-dist-list))) possible-next-nodes))))))) ;; HERE INIT (defparameter *test-graph* (graph-utils:make-graph)) (defparameter *test-vertices-map* (make-hash-table)) ;; (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*) ;; (timing ;; (print (recursive-max-vented 'aa 1 *test-graph* *test-vertices-map* *test-shortest-paths*))) ;; (timing ;; (print (precursive-max-vented 'aa 14 *test-graph* *test-vertices-map* *test-shortest-paths*))) 603 ;;; Computation took: ;;; 21.654093 seconds of real time ;;; 21.583296 seconds of run time 603 ;;; Computation took: ;;; 41.297173 seconds of real time ;;; 294.63492 seconds of run time ;; old bugged, where only added 1 minute of opened valve 111 ;;; Computation took: ;;; 5.249021 seconds of real time ;;; 5.233272 seconds of run time 111 ;;; Computation took: ;;; 9.693041 seconds of real time ;;; 69.213646 seconds of run time ;; (timing ;; (print (precursive-max-vented 'aa 30 *test-graph* *test-vertices-map* *test-shortest-paths*))) ;; well. there are discrepancies with answers. ;; so, let's make an even simpler case? ;;; let's batch more. only initial decision into parallel? (defun initial-coice-paralleled-max-vented (cur-node time-left graph vertices-data-map shortest-paths initial-time) (let* ((possible-next-nodes (get-possible-next-vs cur-node graph vertices-data-map shortest-paths time-left)) (cur-node-gas-per-turn (flow (gethash cur-node vertices-data-map))) (for-open-current-total-release (max 0 ; in case we get to -1 time remaining (* cur-node-gas-per-turn (1- time-left)) ; freed gas after opening and staying )) (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 cur-node table)) t ) table))) (if (not possible-next-nodes) ;; ending condition, either all opened or no more time for-open-current-total-release ;; else - there are some possible nodes to visit (flet ((recursive-max-for-next (next-node dist) (let* ((recursive-function (if (< (- initial-time time-left ) 2) #'precursive-max-vented #'recursive-max-vented)) (max-with-open-current (+ for-open-current-total-release (funcall recursive-function next-node (- (1- time-left) dist) ; spent 1 turn opening current graph for-open-current-vertices-map shortest-paths))) (max-not-opening-current (funcall recursive-function next-node (- time-left dist) ; going there directly graph vertices-data-map shortest-paths))) (max max-not-opening-current max-with-open-current)))) (apply #'max (lparallel:pmapcar (lambda (next-and-dist-list) (recursive-max-for-next (first next-and-dist-list) (second next-and-dist-list))) possible-next-nodes)))))) ;; (timing ;; (print (recursive-max-vented 'aa 14 *test-graph* *test-vertices-map* *test-shortest-paths*))) ;; (timing ;; (print (precursive-max-vented 'aa 14 *test-graph* *test-vertices-map* *test-shortest-paths*))) ;; (timing ;; (print (initial-coice-paralleled-max-vented 'aa 14 *test-graph* *test-vertices-map* *test-shortest-paths* 14))) 603 ;;; Computation took: ;;; 21.654093 seconds of real time ;;; 21.583296 seconds of run time 603 ;;; Computation took: ;;; 41.297173 seconds of real time ;;; 294.63492 seconds of run time 603 ;;; Computation took: ;;; 42.40918 seconds of real time ;;; 293.1057 seconds of run time ;; so it's for some reason still not ok? ;; oh, that's because initial choice is very limited. ;; only into 3 paths ;; (timing ;; (print (initial-coice-paralleled-max-vented 'aa 30 *test-graph* *test-vertices-map* *test-shortest-paths* 30))) ;;; OK, so my problem is a BUG ;; let's focus on single threaded solution ;; HERE INIT (defparameter *test-graph* (graph-utils:make-graph)) (defparameter *test-vertices-map* (make-hash-table)) ;; (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*) ;; (recursive-max-vented 'aa 7 *test-graph* *test-vertices-map* *test-shortest-paths*) (defun recursive-max-vented (cur-node time-left graph vertices-data-map shortest-paths) (progn (format t "starting iteration for ~a, left ~a~%" cur-node time-left) (print-hashmap vertices-data-map) (let* ((possible-next-nodes (get-possible-next-vs cur-node graph vertices-data-map shortest-paths time-left)) (cur-node-gas-per-turn (flow (gethash cur-node vertices-data-map))) (for-open-current-total-release (max 0 ; in case we get to -1 time remaining (* cur-node-gas-per-turn (1- time-left)) ; freed gas after opening and staying )) (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 cur-node table)) t ) table))) (if (not possible-next-nodes) ;; ending condition, either all opened or no more time for-open-current-total-release ;; else - there are some possible nodes to visit (progn ;; (format t "in ~a. left steps ~a~%" cur-node time-left) (loop for (next-node dist) in possible-next-nodes for max-with-open-current = (+ for-open-current-total-release (recursive-max-vented next-node (- (1- time-left) dist) ; spent 1 turn opening current graph for-open-current-vertices-map shortest-paths)) for max-not-opening-current = (recursive-max-vented next-node (- time-left dist) ; going there directly graph vertices-data-map shortest-paths) maximize max-with-open-current into max-freed maximize max-not-opening-current into max-freed finally (return max-freed))))))) ;; well. here's my problem - i'm not marking Nodes I've already visited. ;; since I'm already working with a closure, i only need to visit each "actual" node once. and it makes no sense skipping them. (defun visit-each-once-recursive-max-vented (cur-node time-left graph vertices-data-map shortest-paths) ;; (format t "wtf") (let* ((possible-next-nodes (get-possible-next-vs cur-node graph vertices-data-map shortest-paths time-left)) (cur-node-gas-per-turn (flow (gethash cur-node vertices-data-map))) (for-open-current-total-release (max 0 ; in case we get to -1 time remaining (* cur-node-gas-per-turn (1- time-left)) ; freed gas after opening and staying )) (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 cur-node table)) t ) table))) ;; (format t ">> starting iteration for ~a, left ~a~%; cur-gas ~a~%" cur-node time-left cur-node-gas-per-turn) ;; (print-hashmap vertices-data-map) (if (not possible-next-nodes) ;; ending condition, either all opened or no more time for-open-current-total-release ;; else - there are some possible nodes to visit (progn ;; (format t "in ~a. left steps ~a~%" cur-node time-left) (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 (visit-each-once-recursive-max-vented next-node (- time-left dist) ; going there directly graph vertices-data-map shortest-paths) (+ for-open-current-total-release (visit-each-once-recursive-max-vented next-node (- (1- time-left) dist) ; spent 1 turn opening current graph for-open-current-vertices-map shortest-paths))) maximize next-max into max-freed finally (return max-freed)))))) ;; 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 'ee *test-graph* *test-vertices-map* *test-shortest-paths* 30) ;; 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 ;; it seems that this call should be impossible: ;; starting iteration for CC, left 0 ;; AA : # ;; BB : # ;; CC : # ;; DD : # ;; EE : # ;;; 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"?