blob: 1e161cf9f1d0f70b7fb3f8d4fcbd65ff78c03f0f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
|
(ql:quickload '(fiveam cl-ppcre uiop arrows))
(defstruct valve
name
flow
connections)
(defun data (filename)
(with-open-file (in filename)
(loop for line = (read-line in nil nil)
while line
collect (cl-ppcre:register-groups-bind (val (#'parse-integer flow) others)
("Valve (\\w+) has flow rate=(\\d+); tunnels? leads? to valves? (.+)" line)
`(,(intern val) ,flow ,@(mapcar #'intern (cl-ppcre:split ", " others)))))))
(let ((gra (list (make-valve :name 'aa :connections '(bb cc))
(make-valve :name 'bb :connections '(ll cc)))))
(valve-connections (find 'll gra :key #'valve-name)))
(defun next-steps (current graph paths)
(flet ((appropriate (next)
(and (not (gethash next paths)) ;; not visited
(setf (gethash next paths) (cons next (gethash current paths))))))
(remove-if-not #'appropriate
;; name flow connections -> cddr
(cddr (assoc current graph :test #'eq)))))
(defun shortest-path (graph from to)
(let ((paths (make-hash-table :test #'eq)))
(setf (gethash from paths) (list from))
(labels ((traverse (queue paths)
(unless (null queue)
(let ((next (next-steps (car queue) graph paths)))
(unless (member to next :test #'eq)
(traverse (append (cdr queue) next) paths))))))
(traverse (list from) paths))
;; (loop for k being the hash-keys in paths using (hash-value v)
;; do (format t "~a=>~a~%" k v))
(gethash to paths)))
(= 340 (path-release '((a 5 1) (b 8 2))))
(shortest-path (data "eg-in") 'AA 'CC)
(defun worthwhile-graph (graph)
(let ((interesting (remove-if #'zerop graph :key #'cadr)))
(loop for (from flow) in (cons '(aa 0) interesting)
collect (nconc (list from flow)
(loop for (to) in interesting
when (not (eq from to))
collect (cons to (1- (length (shortest-path graph from to)))))))))
(defun travel-time (paths)
(loop for (name flow distance) in paths
sum (1+ distance)))
(defun next-options (current graph open time-left)
(flet ((appropriate (next)
(destructuring-bind (next-node-name . time-there) next
(and (not (member next-node-name open :test #'eq))
(< (1+ time-there) time-left)))))
(remove-if-not #'appropriate (cddr (assoc current graph :test #'eq)))))
(defun path-release (path graph)
(loop for (from to) on path
while to
for neighbors = (cddr (assoc from graph :test #'eq))
for flow = (cadr (assoc to graph :test #'eq))
for distance = (cdr (assoc to neighbors :test #'eq))
sum (1+ distance) into runtime
sum (* flow (- 30 runtime)) into release
finally (return release)))
(= 1648 (path-release '(AA DD JJ BB CC HH EE) (worthwhile-graph (data "eg-in"))))
(= 1651 (path-release '(AA DD BB JJ HH EE CC) (worthwhile-graph (data "eg-in"))))
(= 560 (path-release '(AA DD) (worthwhile-graph (data "eg-in"))))
(let* ((open '(aa))
(action-graph (worthwhile-graph (data "input"))))
;; (path-release)
;; (loop for k being the hash-keys in open using (hash-value v)
;; do (format t "~a=>~a~%" k v))
(labels ((traverse (graph node open time-left current-flow)
(let ((next (next-options node graph open time-left)))
(if (null next)
(let ((res (reverse open)))
(list (path-release res graph) res))
(arrows:->
(lambda (next-node)
(destructuring-bind (name . time-there) next-node
(let ((flow (cadr (assoc name graph :test #'eq)))
(time-left (- time-left time-there 1)))
(traverse graph name (cons name open)
time-left
(+ current-flow
(* flow time-left))))))
(mapcar next)
(sort #'>= :key #'car)
(car))))))
(apply #'values (traverse action-graph 'aa open 30 0))))
|
