source: project/release/4/interval-digraph/tags/2.1/tests/run.scm @ 25488

Last change on this file since 25488 was 25488, checked in by Ivan Raikov, 9 years ago

interval-digraph release 2.1

File size: 5.1 KB
Line 
1;;
2;;
3;; Verifying the digraph package. Code adapted from the Boost graph
4;; library dependency example.
5;;
6;; Copyright 2007-2010 Ivan Raikov and the Okinawa Institute of Science and Technology
7;;
8;; This program is free software: you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or (at
11;; your option) any later version.
12;;
13;; This program is distributed in the hope that it will be useful, but
14;; WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
16;; General Public License for more details.
17;;
18;; A full copy of the GPL license can be found at
19;; <http://www.gnu.org/licenses/>.
20;;
21;;
22;;
23
24(require-library srfi-1 test interval-digraph cis random-mtzig)
25(import srfi-1 test
26        (prefix cis   cis:)
27        (prefix interval-digraph   interval-digraph:)
28        (only random-mtzig random-mtzig:init random-mtzig:randb!)
29        )
30
31
32(define used-by
33  (list
34    (cons 'dax_h 'foo_cpp) (cons 'dax_h 'bar_cpp) (cons 'dax_h 'yow_h)
35    (cons 'yow_h 'bar_cpp) (cons 'yow_h 'zag_cpp) (cons 'boz_h 'bar_cpp)
36    (cons 'boz_h 'zig_cpp) (cons 'boz_h 'zag_cpp) (cons 'zow_h 'foo_cpp)
37    (cons 'foo_cpp 'foo_o) (cons 'foo_o 'libfoobar_a)
38    (cons 'bar_cpp 'bar_o) (cons 'bar_o 'libfoobar_a)
39    (cons 'libfoobar_a 'libzigzag_a) (cons 'zig_cpp 'zig_o)
40    (cons 'zig_o 'libzigzag_a) (cons 'zag_cpp 'zag_o)
41    (cons 'zag_o 'libzigzag_a) (cons 'libzigzag_a 'killerapp)))
42
43
44(define node-list
45  (delete-duplicates
46   (concatenate (list (map car used-by) (map cdr used-by)))))
47
48
49(define node-ids
50  (list-tabulate (length node-list) values))
51
52(define node-map  (zip node-list node-ids)) 
53
54(test-group "basic digraph test"
55  (let* ((g (interval-digraph:make-digraph  'depgraph  "dependency graph"))
56         
57         ;; add the nodes to the graph
58         (g (fold (lambda (i n g) ((g 'add-node) i label: n))
59                  g node-ids node-list)))
60
61    ;; make sure all nodes got inserted
62    (test "add nodes to the graph"
63          (map first
64               '((14 killerapp)
65                 (13 libzigzag_a) (12 zag_o) (11 zag_cpp)
66                 (10 zig_o) (9 zig_cpp) (8 libfoobar_a) (7 bar_o)
67                 (6 bar_cpp) (5 foo_o) (4 foo_cpp) (3 zow_h) (2 boz_h)
68                 (1 yow_h) (0 dax_h)))
69          ((g 'nodes)))
70
71    (let ((g1  ;; add the edges to the graph
72           (fold (lambda (e g)
73                   (let* ((ni (car e))
74                          (nj (cdr e))
75                          (i (car (alist-ref ni node-map)))
76                          (j (car (alist-ref nj node-map))))
77                     ((g 'add-edge) (list i j) label: (format "~A->~A" ni nj))))
78                 g used-by)))
79
80      ;; make sure all edges got correctly created
81      (test "add edges to the graph"
82            '((13 14 "libzigzag_a->killerapp") (12 13 "zag_o->libzigzag_a")
83              (11 12 "zag_cpp->zag_o") (10 13 "zig_o->libzigzag_a")
84              (9 10 "zig_cpp->zig_o") (8 13 "libfoobar_a->libzigzag_a")
85              (7 8 "bar_o->libfoobar_a") (6 7 "bar_cpp->bar_o")
86              (5 8 "foo_o->libfoobar_a") (4 5 "foo_cpp->foo_o")
87              (3 4 "zow_h->foo_cpp") (2 6 "boz_h->bar_cpp")
88              (2 9 "boz_h->zig_cpp") (2 11 "boz_h->zag_cpp")
89              (1 6 "yow_h->bar_cpp") (1 11 "yow_h->zag_cpp") 
90              (0 1 "dax_h->yow_h") (0 4 "dax_h->foo_cpp") 
91              (0 6 "dax_h->bar_cpp") )
92            ((g1 'edges-with-labels)))
93
94          )))
95
96
97(test-group "interval digraph test"
98  (let* ((N 100) (k 2)
99         
100         (g (interval-digraph:make-digraph  'depgraph  "interval  graph"))
101         
102         ;; add the nodes to the graph
103         (g ((g 'add-node-interval) (cis:interval 0 N)))
104
105         (g ((g 'add-node-interval) (cis:interval (* k N) (* (+ 1 k) N))))
106
107         )
108
109    (let ((nset (list-tabulate (+ 1 N) identity)) (delta (* k N)))
110      ;; make sure all nodes got inserted
111      (test "add nodes to the graph"
112            (reverse (append  nset  (map (lambda (x) (+ x delta)) nset)))
113            ((g 'nodes))))
114
115    (let* ((sources  (cis:interval 0 N))
116           (targets  (cis:interval (* k N) (* (+ 1 k) N)))
117           (g        (cis:fold-left
118                      (lambda (i g)
119                        ((g 'add-edge-interval) (list i targets)))
120                      g sources)
121                     ))
122     
123      (test "add edges to the graph" 
124            (cis:fold-right (lambda (x ax) (cis:fold-left (lambda (y ax) (cons (list x y) ax)) ax targets)) '() sources)
125            ((g 'edges)))
126
127      (let ((g ((g 'edge-interval-property-set) 'test sources targets "chicken")))
128
129        (test "edge-property" "chicken" 
130              ((g 'edge-property) 'test 10 220))
131
132        (test "edge-property-list-map" "chicken" 
133              (((alist-ref 'test ((g 'edge-property-list-map) 10)) 'get-value) 
134               (cis:singleton 220)))
135
136        ((g 'foreach-edge)
137         (lambda (i j) 
138           (test "foreach-edge" #t (cis:in? i sources) )
139           (test "foreach-edge" #t (cis:in? j targets) )))
140                 
141
142        ((g 'foreach-edge-with-property)
143         (lambda (i j v) 
144           (test "foreach-edge-with-property" #t (cis:in? i sources) )
145           (test "foreach-edge-with-property" #t (cis:in? j targets) )
146           (if (and (= i 10) (= j 220))
147               (test "foreach-edge-with-property" "chicken" v))
148           )
149         'test
150         )
151                 
152
153      ))
154    ))
155
156(test-group "random graph test"
157
158  (let* ((g (interval-digraph:make-random-gnp-digraph 
159             'gnp-graph  "random G(N=100,P=0.2) graph"
160             100 0.2 random-mtzig:randb! (random-mtzig:init 48)
161             #f)))
162         
163    (print ((g 'edges)))
164    ))
165
166(test-exit)
Note: See TracBrowser for help on using the repository browser.