efim
/
Advent-of-Code
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

day 16, still not working. 

trying out with smaller example.
AND. before refactoring by BAD BOOLEAN
This commit is contained in:
efim 2022-12-17 14:17:49 +00:00
parent c2ea2ec16e
commit 293250c20b
5 changed files with 748 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

128
day16-scratch-cl-graph.lisp Normal file
View File

@ -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?

547
day16-scratch-graph-utils.lisp Normal file
View File

@ -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?

5
day16-simpler-test.txt Normal file
View File

@ -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

10
day16-test.txt Normal file
View File

@ -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

58
day16.lisp Normal file
View File

@ -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)))