X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=dev%2Ftest-graph-algorithms.lisp;fp=dev%2Ftest-graph-algorithms.lisp;h=0000000000000000000000000000000000000000;hb=900a931f109598249ebc33bea50b65abf998ed0b;hp=f54b8791ecd88e218886273549727d456bff1f95;hpb=5282d117ab0e8b7080bca9683e270f0d2a8f4d5c;p=cl-graph.git diff --git a/dev/test-graph-algorithms.lisp b/dev/test-graph-algorithms.lisp deleted file mode 100644 index f54b879..0000000 --- a/dev/test-graph-algorithms.lisp +++ /dev/null @@ -1,121 +0,0 @@ -(in-package cl-graph) - -(deftestsuite test-connected-components () - ()) - -(addtest (test-connected-components) - test-1 - (let ((g (make-container 'graph-container :default-edge-type :undirected))) - (loop for v in '(a b c d e f g h i j) do (add-vertex g v)) - (loop for (v1 v2) in '((a b) (a c) ( b c) (b d) (e f) (e g) (h i)) do - (add-edge-between-vertexes g v1 v2)) - - (let ((cc (connected-components g))) - (flet ((test (a b result) - (ensure-same (eq (representative-node cc (find-vertex g a)) - (representative-node cc (find-vertex g b))) - result))) - (loop for (v1 v2 result) in '((a b t) (a e nil) (f g t) - (j c nil) (b a t) (d c t)) do - (test v1 v2 result)))))) - -;;; --------------------------------------------------------------------------- - -(deftestsuite test-minimum-spanning-tree () - ()) - -(deftestsuite test-mst-kruskal (test-minimum-spanning-tree) - ()) - -(addtest (test-mst-kruskal) - test-1 - (let ((g (make-container 'graph-container - :default-edge-type :undirected - :undirected-edge-class 'weighted-edge)) - (m nil)) - (loop for (v1 v2 w) in '((a b 4) (a h 9) - (b c 8) (b h 11) - (c i 2) (c d 7) (c f 4) - (d e 9) (d f 14) - (e f 10) - (f g 2) - (g h 1) (g i 6) - (h i 7)) do - (add-edge-between-vertexes g v1 v2 :weight w)) - (setf m (minimum-spanning-tree-kruskal g)) - (ensure (set-equal - '(a b c d e f g h i) - (flatten (mapcar (lambda (e) - (list (element (vertex-1 e)) (element (vertex-2 e)))) - m)))) - (ensure-same (reduce #'+ m :key 'weight) 37 :test '=) - (ensure-same (size m) 8))) - -#+Test -(defclass* directed-weighted-edge (weighted-edge-mixin graph-container-directed-edge) - ()) - -#+Test -(let ((g (make-container 'graph-container - :default-edge-type :undirected - :undirected-edge-class 'weighted-edge - :directed-edge-class 'directed-weighted-edge))) - (loop for (v1 v2 w) in '((a b 4) (a h 9) - (b c 8) (b h 11) - (c i 2) (c d 7) (c f 4) - (d e 9) (d f 14) - (e f 10) - (f g 2) - (g h 1) (g i 6) - (h i 7) - - (a h 3)) do - (add-edge-between-vertexes g v1 v2 :weight w - :edge-type (if (random-boolean *random-generator* 0.3) - :directed :undirected))) - (minimum-spanning-tree-kruskal g)) - -#+Test -(graph->dot - (let ((g (make-container 'graph-container - :default-edge-type :undirected - :undirected-edge-class 'weighted-edge)) - (m nil)) - (loop for (v1 v2 w) in '((a b 10) (a b 1) (a d 3) - (b c 1) (b d 3) - (c d 1)) do - (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force)) - (setf m (minimum-spanning-tree-kruskal g)) - g) - "p2dis:data;x.dot") - -#+Test -(let ((g (make-container 'graph-container - :default-edge-type :undirected - :undirected-edge-class 'weighted-edge)) - (m nil)) - (loop for (v1 v2 w) in '((a b 1) (a d 3) - (b c 5) (b d 2) - (c d 1)) do - (add-edge-between-vertexes g v1 v2 :weight w :if-duplicate-do :force)) - (setf m (minimum-spanning-tree-kruskal g)) - m) - -;;; --------------------------------------------------------------------------- - -#+test -(let ((graph (make-container 'graph-container))) - (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x) - (u y) (w x) (x y)) do - (add-edge-between-vertexes graph a b)) - - (breadth-first-search-graph graph 's)) - -;;; --------------------------------------------------------------------------- - -(let ((graph (make-container 'graph-container))) - (loop for (a b) in '((r s) (r v) (s w) (t u) (t w) (t x) - (u y) (w x) (x y)) do - (add-edge-between-vertexes graph a b)) - - (breadth-first-visitor graph 's #'print)) \ No newline at end of file