From 293250c20b58a9c9de57aa7ef33f6b8422a3fab4 Mon Sep 17 00:00:00 2001 From: efim Date: Sat, 17 Dec 2022 14:17:49 +0000 Subject: [PATCH] day 16, still not working. trying out with smaller example. AND. before refactoring by BAD BOOLEAN --- day16-scratch-cl-graph.lisp | 128 ++++++++ day16-scratch-graph-utils.lisp | 547 +++++++++++++++++++++++++++++++++ day16-simpler-test.txt | 5 + day16-test.txt | 10 + day16.lisp | 58 ++++ 5 files changed, 748 insertions(+) create mode 100644 day16-scratch-cl-graph.lisp create mode 100644 day16-scratch-graph-utils.lisp create mode 100644 day16-simpler-test.txt create mode 100644 day16-test.txt create mode 100644 day16.lisp diff --git a/day16-scratch-cl-graph.lisp b/day16-scratch-cl-graph.lisp new file mode 100644 index 0000000..a8afc56 --- /dev/null +++ b/day16-scratch-cl-graph.lisp @@ -0,0 +1,128 @@ +;; https://adventofcode.com/2022/day/16 + +;; so. only idea i had is to build the graph, and then do random walk? ugh. +;; we could maybe potentially divide by 2 amount of recursion, +;; +;; since possible actions are +;; - go to next room +;; - open current valve & go to next room +;; +;; and that shared part is almost similar, but is 1 move shorter, but adds some turns of this valve being open +;; if i return info on which valves were open for how many turns from the recursion, +;; i could potentially calculate what is more - 1 less turn of all of these and + some amount of current room's valve +;; or just go to next turn. +;; +;; but this is kind of way too much, to wander aimlessly? +;; maybe I need to build closure, then could choose any desired vertice? and select only those which are not visited. +;; this seems much more sane +;; +;; maybe there's already good \ easy \ powerful graph library? +;; +;; i found two libraries for graphs. +;; https://cl-graph.common-lisp.dev/user-guide.html - this one seem to allow for calculating closures, and filtering. +;; (repo: https://github.com/gwkkwg/cl-graph ) +;; so i could potentially filter the remaining graph for the walkthrough +;; https://github.com/kraison/graph-utils - this one visualization and primitives that could allow for writing algos +;; +;; i guess i'll try to install first. is it available in quicklisp? +;; (ql:quickload 'cl-graph) + +(push #p"~/quicklisp/local-projects/cl-graph/" asdf:*central-registry*) + +;; (ql:quickload "cl-graph") +(ql:quickload '(:cl-graph :moptilities)) +(defclass my-graph (cl-graph:basic-graph) + ()) +(defparameter *test-graph* nil) +;; (:documentation "Stub for matrix based graph. Not implemented.") +;; OH NO + +;; (cl-graph:add-vertex *test-graph* 6) +;; (cl-graph:vertex-count *test-graph*) + +;; (cl-graph:graph->dot *test-graph* t) + +;; (in-package #:cl-graph) +(in-package cl-user) + +(make-graph 'basic-graph) ; still doesn' work +;; to allow export to DOT +;; https://github.com/gwkkwg/cl-graph/issues/12 +;; (defclass* dot-graph (dot-graph-mixin graph-container) +;; () +;; (:export-p t)) +(let ((g (make-container 'dot-graph :default-edge-type :directed))) + (loop for (a b) in '((a b) (b c) (b d) (d e) (e f) (d f)) do + (add-edge-between-vertexes g a b)) + (graph->dot g nil)) + + +(setq *test-graph* + (let ((g (cl-graph:make-graph 'cl-graph:dot-graph))) + (loop for v in '(a b c d e) do + (cl-graph:add-vertex g v)) + (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do + (cl-graph:add-edge-between-vertexes g v1 v2)) + g)) + +(setq *test-graph* + (let ((g (make-graph 'graph-container))) + (loop for v in '(a b c d e) do + (add-vertex g v)) + (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do + (add-edge-between-vertexes g v1 v2)) + g)) + +(cl-graph:vertex-count *test-graph*) +(graph->dot *test-graph* nil) +(vertexes *test-graph*) +(make-graph-from-vertexes (vertexes *test-graph*)) + +(identity 1) +;; graph-container already subclass of basic-graph. +;; then why doesn't this method is dispatched? +(make-filtered-graph *test-graph* (lambda (v) t) ) + +;; maybe quicklisp doens't have a fresh enough version? +;; ok. how do i make quicklisp use cloned code? + +;; well. too bad. +(cl-graph:make-graph-from-vertexes (cl-graph:vertexes *test-graph*)) +(cl-graph:make-filtered-graph *test-graph* (lambda (v) t) ) +((lambda (v) t) 1) + +(ql:where-is-system :cl-graph) +;; => #P"/home/efim/quicklisp/dists/quicklisp/software/cl-graph-20171227-git/" + +(ql:update-client) +(ql:update-all-dists) +;; Changes from quicklisp 2022-07-08 to quicklisp 2022-11-07: + +(cl-graph:graph->dot *test-graph* nil) + +;; required additional dependency +;; (ql:quickload '(:cl-graph :moptilities)) +;; asdf system connections +;; https://github.com/gwkkwg/cl-graph/blob/3cb786797b24883d784b7350e7372e8b1e743508/cl-graph.asd#L84-L89 + +(setq *test-graph* + (let ((g (cl-graph:make-graph 'cl-graph:dot-graph))) + (loop for v in '(a b c d e) do + (cl-graph:add-vertex g v)) + (loop for (v1 . v2) in '((a . b) (a . c) (b . d) (c . e)) do + (cl-graph:add-edge-between-vertexes g v1 v2)) + g)) + +(print (cl-graph:graph->dot *test-graph* nil)) + +(print (cl-graph:graph->dot + (cl-graph:make-filtered-graph *test-graph* + (lambda (v) (not (eq v 'a))) + :graph-completion-method nil) + nil)) + +;; well, that was all for nothing? +;; or do i still rather use that library? +;; because it would allow me to add data to vertices? +;; +;; and graph-utils allows for getting hashmap of all paths and lengts? diff --git a/day16-scratch-graph-utils.lisp b/day16-scratch-graph-utils.lisp new file mode 100644 index 0000000..d579d8f --- /dev/null +++ b/day16-scratch-graph-utils.lisp @@ -0,0 +1,547 @@ +;; 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 t))) + +(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))) + (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) + (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)) nil ) + 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 = (+ cur-node-gas-per-turn + (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)) nil ) + 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) + (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)) nil ) + 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 + (+ 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)))) + (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*))) +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? diff --git a/day16-simpler-test.txt b/day16-simpler-test.txt new file mode 100644 index 0000000..dcf7a65 --- /dev/null +++ b/day16-simpler-test.txt @@ -0,0 +1,5 @@ +Valve AA has flow rate=0; tunnels lead to valves BB +Valve BB has flow rate=1; tunnels lead to valves CC, EE +Valve CC has flow rate=1; tunnels lead to valves DD +Valve DD has flow rate=1; tunnels lead to valves EE +Valve EE has flow rate=1; tunnels lead to valves EE diff --git a/day16-test.txt b/day16-test.txt new file mode 100644 index 0000000..9f30acc --- /dev/null +++ b/day16-test.txt @@ -0,0 +1,10 @@ +Valve AA has flow rate=0; tunnels lead to valves DD, II, BB +Valve BB has flow rate=13; tunnels lead to valves CC, AA +Valve CC has flow rate=2; tunnels lead to valves DD, BB +Valve DD has flow rate=20; tunnels lead to valves CC, AA, EE +Valve EE has flow rate=3; tunnels lead to valves FF, DD +Valve FF has flow rate=0; tunnels lead to valves EE, GG +Valve GG has flow rate=0; tunnels lead to valves FF, HH +Valve HH has flow rate=22; tunnel leads to valve GG +Valve II has flow rate=0; tunnels lead to valves AA, JJ +Valve JJ has flow rate=21; tunnel leads to valve II diff --git a/day16.lisp b/day16.lisp new file mode 100644 index 0000000..94349b9 --- /dev/null +++ b/day16.lisp @@ -0,0 +1,58 @@ +;; https://github.com/kraison/graph-utils + +(ql:quickload 'graph-utils) +(ql:quickload 'alexandria) + +;;; reading in data +;; graph and hashmap from node name to flow and state +(defclass verticle-data () + ((flow :reader flow :initarg :flow) + (name :reader name :initarg :name) + (is-opened-p :accessor is-opened-p :initform t))) + +(defmethod print-object ((obj verticle-data) stream) + (with-slots (name flow is-opened-p) obj + (format stream "~a with flow: ~a; is opened? ~a" name flow is-opened-p))) + +(defun parse-integer-or-symbol (str) + (let ((maybe-int (parse-integer str :junk-allowed t))) + (if maybe-int + maybe-int + (intern (string-upcase str))))) + +(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))) + +(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))) + + +;;; calculations for part 1 + +(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) + (is-opened-p to-node-data)) + collect (list to-node dist)))