source: project/release/3/rgraph/trunk/rgraph-test2.scm @ 9977

Last change on this file since 9977 was 9977, checked in by Kon Lovett, 13 years ago

Using canonical directory structure.

File size: 4.4 KB
Line 
1; Copyright (c) 2004, Jonah Nathaniel Beckford
2; All rights reserved.
3;
4; Redistribution and use in source and binary forms, with or without
5; modification, are permitted provided that the following conditions
6; are met:
7;
8;   Redistributions of source code must retain the above copyright
9;   notice, this list of conditions and the following disclaimer.
10;
11;   Redistributions in binary form must reproduce the above copyright
12;   notice, this list of conditions and the following disclaimer in
13;   the documentation and/or other materials provided with the
14;   distribution.
15;
16;   Neither the name of the author nor the names of its contributors
17;   may be used to endorse or promote products derived from this
18;   software without specific prior written permission.
19;
20; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
21; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
22; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
23; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
24; COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
25; INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
26; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
27; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
28; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
29; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
30; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
31; OF THE POSSIBILITY OF SUCH DAMAGE.
32;
33; jonah@usermail.com
34
35(require-extension srfi-40)
36(cond-expand
37  [srfi-40
38    (print "Using rgraph stream functions; found 'srfi-40 extension")]
39  [else
40    (print "Not using rgraph stream functions because no 'srfi-40 extension")])
41(newline)
42
43(require-for-syntax 'rgraph)
44(require 'rgraph-base)
45
46
47(print "define-adjacency-list ...")
48(define-adjacency-list myg1
49  ()
50  (vl-hash) (vertex-name vertex-color)
51  (el-hash) (edge-weight)
52  #t #t)
53(newline)
54
55
56(print "make ...")
57(define g1 (make-myg1))
58(print g1)
59(newline)
60
61
62(print "add-vertex! add-edge! ...")
63(define v1 (myg1-add-vertex! g1 'v1))
64(define v2 (myg1-add-vertex! g1 'v2))
65(define v3 (myg1-add-vertex! g1 'v3))
66(define e1 (myg1-add-edge! g1 v1 v2))
67(define e2 (myg1-add-edge! g1 v1 v3))
68(define e3 (myg1-add-edge! g1 v2 v3))
69(print e1)
70(newline)
71
72
73(print "vertices ...")
74(print (myg1-vertices g1))
75(cond-expand
76  [srfi-40
77    (stream-for-each print (myg1-vertices* g1))]
78  [else])
79
80
81(print "edge ...")
82(let-rgraph myg1
83  (print (edge g1 v1 v2))
84  (newline))
85
86
87(print "out-edges ...")
88(print (myg1-out-edges g1 v2))
89(cond-expand
90  [srfi-40
91    (stream-for-each print (myg1-out-edges* g1 v1))]
92  [else
93    (print (myg1-out-edges g1 v1))])
94(newline)
95
96(print "in-edges ...")
97(print (myg1-in-edges g1 v2))
98(cond-expand
99  [srfi-40
100    (stream-for-each print (myg1-in-edges* g1 v3))]
101  [else
102    (print (myg1-in-edges g1 v3))])
103(newline)
104
105
106(print "internal properties ...")
107(set-myg1-vertex-name! g1 v1 "first vertex name")
108(print (myg1-vertex-name g1 v1))
109(print (myg1-vertex-name g1 v2))
110(set-myg1-edge-weight! g1 e1 "first edge weight")
111(print (myg1-edge-weight g1 e1))
112(print (myg1-edge-weight g1 e2))
113(newline)
114
115
116(print "num-vertices / num-edges ...")
117;; when remove a vertex, all edges it belongs too must be deleted as
118;; well.  so number of edges should decrement by one for this example.
119(define t1 (myg1-num-vertices g1))
120(define t2 (myg1-out-degree g1 v1))
121(define s2 (myg1-in-degree g1 v3))
122(printf "out ~S / ~S~%" t1 t2)
123(printf "in  ~S / ~S~%" t1 s2)
124(myg1-remove-vertex! g1 v2)
125(when (and (integer? v3) (not (myg1-vertex-set?)))
126  ;; this should work, because the old vertex 3 is now vertex 2.
127  ;; ONLY for vl-vector
128  (set! v3 (myg1-vertex g1 1)))
129(define t3 (myg1-num-vertices g1))
130(define t4 (myg1-out-degree g1 v1))
131(define s4 (myg1-in-degree g1 v3))
132(unless (= (sub1 t1) t3)
133  (error "The number of vertices did not decrease by one"))
134(unless (= (sub1 t2) t4 (length (myg1-out-edges g1 v1)))
135  (error "The number of out-edges did not decrease by one"))
136(unless (= (sub1 s2) s4 (length (myg1-in-edges g1 v3)))
137  (error "The number of in-edges did not decrease by one"))
138(printf "out ~S / ~S~%" t3 t4)
139(printf "in  ~S / ~S~%" t3 s4)
140(cond-expand
141  [srfi-40
142    (stream-for-each print (myg1-out-edges* g1 v1))]
143  [else
144    (print (myg1-out-edges g1 v1))])
145(unless (myg1-edge g1 v1 v3)
146  (error "The vertex descriptor in the edges were not recalculated upon removal of a vertex"))
147(newline)
Note: See TracBrowser for help on using the repository browser.