blob: 6e4a3a1368f16ac76ee68c8782ef62a4c4416b4e (
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
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
(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)))
(defun travel-time (paths)
(loop for (name flow distance) in paths
sum (1+ distance)))
(defun path-release (paths)
(loop for (name flow distance) in paths
sum (1+ distance) into runtime
sum (* flow (- 30 runtime)) into release
finally (return release)))
(= 340 (path-release '((a 5 1) (b 8 2))))
(shortest-path (data "eg-in") 'AA 'CC)
(defun close-option (interesting graph visited)
(sort
(mapcar (lambda (node)
(setf (gethash (car node) visited)
(cons (move-to node 'aa graph) (gethash 'aa visited))) )
interesting)
#'>
:key (lambda (path) (path-release (reverse path)))))
(defun make-edge (from to)
(intern
(concatenate 'string
(symbol-name from)
"-"
(symbol-name to))))
(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)))))))))
(worthwhile-graph
(data "eg-in"))
(defun next-options (current graph visited)
(let ((to-this-node (gethash current visited)))
(flet ((appropriate (next)
(destructuring-bind (next-node-name . time-there) next
(let* ((route-to-next (gethash next-node-name visited))
(next-node-flow (cadr (assoc next-node-name graph :test #'eq)))
(move-to-next (list next-node-name next-node-flow time-there)))
(when (or (and (not route-to-next)
(< (1+ time-there) (- 30 (travel-time to-this-node))))
(and (not (member next-node-name to-this-node :key #'car))
(< (path-release route-to-next)
(path-release (cons move-to-next to-this-node)))))
(setf (gethash (car next) visited)
(cons move-to-next (gethash current visited))))))))
(arrows:-<>
(mapcar #'appropriate (cddr (assoc current graph :test #'eq)))
(delete nil <>)
;; (sort <> #'> :key (lambda (path) (path-release (reverse path))))
(mapcar #'caar <>)))))
(let* ((graph (data "eg-in"))
(open (make-hash-table :test #'eq))
(action-graph (worthwhile-graph graph)))
;; (path-release)
(setf (gethash 'aa open) '((aa 0 0)))
;; (loop for k being the hash-keys in open using (hash-value v)
;; do (format t "~a=>~a~%" k v))
(labels ((traverse (queue open)
(unless (null queue)
(let ((next (next-options (car queue) action-graph open)))
(traverse (append (cdr queue) next) open)))))
(traverse '(aa) open)
;; (let ((queue (next-options 'aa action-graph open )))
;; (prog1
;; ;; queue
;; ;; (caar queue)
;; (let ((next (next-options (car queue) action-graph open )))
;; (setq queue (append (cdr queue) next))
;; (setq queue (append (cdr queue)
;; (next-options (car queue) action-graph open )))
;; (setq queue (append (cdr queue)
;; (next-options (car queue) action-graph open )))
;; (setq queue (append (cdr queue)
;; (next-options (car queue) action-graph open )))
;; (setq queue (append (cdr queue)
;; (next-options (car queue) action-graph open )))
;; (setq queue (append (cdr queue)
;; (next-options (car queue) action-graph open )))
;; (setq queue (append (cdr queue)
;; (next-options (car queue) action-graph open )))
;; (setq queue (append (cdr queue)
;; (next-options (car queue) action-graph open )))
;; (setq queue (append (cdr queue)
;; (next-options (car queue) action-graph open )))
;; )))
;; (next-options 'cc graph open 30)
(loop for k being the hash-keys in open using (hash-value v)
do (format t "~a=>~a f=~a ~%" k v (path-release (reverse v))))
))
(adjoin 'l '(b c))
(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)))
|
