Skip to content

Commit 1a83448

Browse files
vselovedvseloved
committed
v.1.1: implemeted the missing tests based on the REPL outputs from the book.
Fixed the typos, corner case handling, and toher issues in the process.
1 parent 94be202 commit 1a83448

14 files changed

+605
-583
lines changed

‎ch1-complexity.lisp‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,5 +12,5 @@
1212

1313
(deftest mat-max ()
1414
(should be null (mat-max #2A()))
15-
(shoould be = 42 (mat-max #2A((42))))
15+
(should be = 42 (mat-max #2A((42))))
1616
(should be = 6 (mat-max #2A((1 2 3) (4 5 6)))))

‎ch10-graphs.lisp‎

Lines changed: 68 additions & 54 deletions
Original file line numberDiff line numberDiff line change
@@ -31,36 +31,48 @@
3131
(rtl:? src-node 'edges))))
3232
rez))
3333

34-
;; TODO (deftest graph ()
35-
;; CL-USER> (init-graph '((7 8)
36-
;; (1 3)
37-
;; (1 2)
38-
;; (3 4)
39-
;; (3 5)
40-
;; (2 4)
41-
;; (2 5)
42-
;; (5 4)
43-
;; (5 6)
44-
;; (4 6)))
34+
(deftest graph ()
35+
(should print-to *standard-output*
36+
"
37+
1 2 3 4 5 6 7 8
38+
1 x x
39+
2 x x
40+
3 x x
41+
4 x
42+
5 x x
43+
6
44+
7 x
45+
8
46+
"
47+
(print (init-graph '((7 8)
48+
(1 3)
49+
(1 2)
50+
(3 4)
51+
(3 5)
52+
(2 4)
53+
(2 5)
54+
(5 4)
55+
(5 6)
56+
(4 6))))))
4557

4658
(defun topo-sort (graph)
4759
(let ((nodes (nodes graph))
4860
(visited (make-hash-table))
4961
(rez (rtl:vec)))
5062
(rtl:dokv (id node nodes)
51-
(unless (gethash id visited)
52-
(visit node nodes visited rez)))
63+
(unless (gethash id visited)
64+
(visit node nodes visited rez)))
5365
rez))
5466

5567
(defun visit (node nodes visited rez)
5668
(dolist (edge (node-edges node))
5769
(rtl:with ((id (edge-dst edge))
58-
(child (elt nodes id)))
59-
(unless (find id rez)
60-
(assert (not (gethash id visited)) nil
61-
"The graph isn't acyclic for vertex: ~A" id)
62-
(setf (gethash id visited) t)
63-
(visit child nodes visited rez))))
70+
(child (gethash id nodes)))
71+
(unless (find id rez)
72+
(assert (not (gethash id visited)) nil
73+
"The graph isn't acyclic for vertex: ~A" id)
74+
(setf (gethash id visited) t)
75+
(visit child nodes visited rez))))
6476
(vector-push-extend (node-id node) rez)
6577
rez)
6678

@@ -144,8 +156,8 @@
144156
(parent (hparent i))
145157
(parent-key (aref vec parent)))
146158
(when (> i-key parent-key)
147-
(rtl:removef i (gethash i-key *heap-indices*))
148-
(rtl:removef parent (gethash parent-key *heap-indices*))
159+
(rtl:removef (gethash i-key *heap-indices*) i)
160+
(rtl:removef (gethash parent-key *heap-indices*) parent)
149161
(push i (gethash parent-key *heap-indices*))
150162
(push parent (gethash i-key *heap-indices*))
151163
(rotatef (aref vec i)
@@ -164,7 +176,7 @@
164176
(heap-up vec parent))
165177
vec)
166178

167-
(defun heap-decrease-key-correct (vec key decrement)
179+
(defun heap-decrease-key-correct (vec key decrement)
168180
(let ((i (gethash key *heap-indices*)))
169181
(unless i (error "No key ~A found in the heap: ~A" key vec))
170182
(remhash key *heap-indices*)
@@ -179,25 +191,24 @@
179191
(rtl:with ((i-key (heap-item-key (aref vec i)))
180192
(parent (hparent i))
181193
(parent-key (heap-item-key (aref vec parent))))
182-
(when (> i-key parent-kea)
183-
(rtl:removef i (gethash i-key *heap-indices*))
184-
(rtl:removef parent (gethash parent-key *heap-indices*))
194+
(when (> i-key parent-key)
195+
(rtl:removef (gethash i-key *heap-indices*) i)
196+
(rtl:removef (gethash parent-key *heap-indices*) parent)
185197
(push i (gethash parent-key *heap-indices*))
186198
(push parent (gethash i-key *heap-indices*))
187199
(rotatef (aref vec i)
188200
(aref vec parent))
189201
(heap-up vec parent)))
190202
vec)
191203

192-
;; TODO (deftest heap2 ()
204+
;; TODO test heap
193205

194206
(defstruct (spf-node (:include node))
195207
(weight most-positive-fixnum)
196208
(path (list)))
197209

198210
(defun spf (graph src dst)
199211
(rtl:with ((nodes (graph-nodes graph))
200-
(spf (list))
201212
;; the following code should express initialize the heap
202213
;; with a single node of weight 0 and all other nodes
203214
;; of weight MOST-POSITIVE-FIXNUM
@@ -222,13 +233,15 @@
222233
(spf-node-path node) (cons (rtl:? nodes id)
223234
(rtl:? nodes id 'path))))))))))
224235

225-
;; TODO (deftest spf ()
236+
;; TODO test spf
226237

227238
(defstruct mf-edge
228239
beg end capacity)
229240

230241
(defun max-flow (g)
231-
(let ((rg (copy-array g)) ; residual graph
242+
(assert (= (array-dimension g 0)
243+
(array-dimension g 1)))
244+
(let ((rg (rtl:copy-array g)) ; residual graph
232245
(rez 0))
233246
(loop :for path := (aug-path rg) :while path :do
234247
(let ((flow most-positive-fixnum))
@@ -247,58 +260,59 @@
247260
(defun aug-path (g)
248261
(rtl:with ((sink (1- (array-dimension g 0)))
249262
(visited (make-array (1+ sink) :initial-element nil)))
250-
(labels ((dfs (g i)
251-
(if (zerop (aref g i sink))
252-
(dotimes (j sink)
253-
(unless (or (zerop (aref g i j))
254-
(aref visited j))
255-
(rtl:when-it (dfs g j)
256-
(setf (aref visited j) t)
257-
(return (cons (make-mf-edge
258-
:beg i :end j
259-
:capacity (aref g i j))
260-
rtl:it)))))
261-
(list (make-mf-edge
262-
:beg i :end sink
263-
:capacity (aref g i sink))))))
264-
(dfs g 0))))
263+
(labels ((dfs (g i)
264+
(setf (aref visited i) t)
265+
(if (zerop (aref g i sink))
266+
(dotimes (j sink)
267+
(unless (or (zerop (aref g i j))
268+
(aref visited j))
269+
(rtl:when-it (dfs g j)
270+
(return (cons (make-mf-edge
271+
:beg i :end j
272+
:capacity (aref g i j))
273+
rtl:it)))))
274+
(list (make-mf-edge
275+
:beg i :end sink
276+
:capacity (aref g i sink))))))
277+
(dfs g 0))))
265278

266279
(deftest max-flow ()
267280
(should be = 7 (max-flow #2A((0 4 4 0 0 0)
268281
(0 0 0 4 2 0)
269282
(0 0 0 1 2 0)
270283
(0 0 0 0 0 3)
271-
(0 0 0 0 0 5)))))
284+
(0 0 0 0 0 5)
285+
(0 0 0 0 0 0)))))
272286

273287
;; code prototypes
274288

275289
(defun pagerank (g &key (d 0.85) (repeat 100))
276-
(rtl:with ((n (length (nodes g)))
277-
(pr (make-arrray n :initial-element (/ 1 n))))
290+
(rtl:with ((nodes (nodes g))
291+
(n (length nodes))
292+
(pr (make-array n :initial-element (/ 1 n))))
278293
(loop :repeat repeat :do
279-
(let ((pr2 (map 'vector (lambda (x) (- 1 (/ d n)))
294+
(let ((pr2 (map 'vector (lambda (x) (- 1 (/ x n)))
280295
pr)))
281296
(rtl:dokv (i node nodes)
282297
(let ((p (aref pr i))
283298
(m (length (node-children node))))
284-
(rtl:dokv (j child (node-children node)))
285-
(incf (aref pr2 j) (* d (/ p m)))))
299+
(rtl:dokv (j _ (node-children node))
300+
(incf (aref pr2 j) (* d (/ p m))))))
286301
(setf pr pr2)))
287302
pr))
288303

289304
(defun pr1 (node n p &key (d 0.85))
290-
(let ((pr (make-arrray n :initial-element 0))
305+
(let ((pr (make-array n :initial-element 0))
291306
(m (hash-table-count (node-children node))))
292307
(rtl:dokv (j child (node-children node))
293308
(setf (aref pr j) (* d (/ p m))))
294309
pr))
295310

296311
(defun pagerank-mr (g &key (d 0.85) (repeat 100))
297312
(rtl:with ((n (length (nodes g)))
298-
(pr (make-arrray n :initial-element (/ 1 n))))
313+
(pr (make-array n :initial-element (/ 1 n))))
299314
(loop :repeat repeat :do
300-
(setf pr (map 'vector (lambda (x)
301-
(- 1 (/ d n)))
315+
(setf pr (map 'vector (lambda (x) (- 1 (/ x n)))
302316
(reduce 'vec+ (map 'vector (lambda (node p)
303317
(pr1 node n p :d d))
304318
(nodes g)

0 commit comments

Comments
 (0)