Changeset 25487 in project

Timestamp:

11/10/11 07:32:29 (10 years ago)

Author:

Ivan Raikov

Message:

interval-digraph: bug fixes and additions to edge iterator interfaces

Location:

release/4/interval-digraph/trunk

Files:

• interval-digraph.scm (modified) (7 diffs)
• interval-digraph.setup (modified) (2 diffs)
• tests/run.scm (modified) (1 diff)

release/4/interval-digraph/trunk/interval-digraph.scm

@@ -344 +344 @@
 
 
-  (define (foreach-edge f) ((succs 'for-each-ascending) 
-                            (lambda (i v)  (cis:foreach (lambda (j) (f i j)) v))))
+  (define (foreach-edge f) 
+    ((succs 'for-each-ascending) 
+     (lambda (e) 
+       (let ((i (car e)))
+         (cis:foreach (lambda (j) (f i j)) (cdr e)))
+       )))
+
+
+  (define (foreach-edge-with-property f p) 
+    (let ((props (alist-ref p edge-props)))
+      ((succs 'for-each-ascending) 
+       (lambda (e)  
+         (let* ((i (car e))
+                (i-prop ((props 'get-value) (cis:singleton i) #f)))
+           (if i-prop
+               (cis:foreach (lambda (j) (f i j ((i-prop 'get-value) (cis:singleton j) #f))) (cdr e))
+               (cis:foreach (lambda (j) (f i j #f)) (cdr e))))
+           ))
+       ))
 
 
@@ -379 +396 @@
         ((foreach-node)                foreach-node)
         ((foreach-node-with-label)     foreach-node-with-label)
-        ((foreach-edge)                foreach-edge)
+        ((foreach-edge)                foreach-edge)        
+        ((foreach-edge-with-property)  foreach-edge-with-property)
+        
 
         ;; transformers
@@ -470 +489 @@
            (node-interval-property   (lambda (p i)  (or ((a 'node-interval-property) p i) ((b 'node-interval-property) p i))))
            (node-label               (lambda (i)    (or ((a 'node-label) i) ((b 'node-label) i))))
-           (edge-property-list-keys       (lambda () (delete-duplicates (append ((a 'edge-property-list-keys)) ((b 'edge-property-list-keys))))))
+           (edge-property-list-keys  (lambda () (delete-duplicates (append ((a 'edge-property-list-keys)) ((b 'edge-property-list-keys))))))
+           (edge-property-list-map   (lambda () (delete-duplicates (append ((a 'edge-property-list-map)) ((b 'edge-property-list-map))))))
            (edge-property            (lambda (p i j)  (or ((a 'edge-property) p i j) ((b 'edge-property) i j))))
            (edge-interval-property   (lambda (p i j)  (or ((a 'edge-interval-property) p i j) ((b 'edge-interval-property) i j))))
@@ -545 +565 @@
         ((node-label)                  node-label)
         ((edge-property)               edge-property)
-        ((edge-property-list-keys)          edge-property-list-keys)
+        ((edge-property-list-keys)     edge-property-list-keys)
+        ((edge-property-list-map)      edge-property-list-map)
         ((foreach-node)                foreach-node)
         ((foreach-node-with-label)     foreach-node-with-label)
@@ -573 +594 @@
 
   (define (rename-nodes ns) (map (lambda (x) (list (fx+ k x))) ns))
-  (define (rename-nodes-with-labels ns) (map (lambda (x) (list (fx+ k (car x) (cadr x)))) ns))
+  (define (rename-nodes-with-labels ns) (map (lambda (x) (list (fx+ k (car x)) (cadr x))) ns))
   (define (rename-edges es) (map (lambda (e) (list (fx+ k (car e)) (fx+ k (cadr e)))) es))
   (define (rename-edges-with-labels es) (map (lambda (e) (list (fx+ k (car e)) (fx+ k (cadr e)) (caddr e))) es))
@@ -601 +622 @@
            (node-label               (lambda (i)      ((a 'node-label) (fx- i k))))
            (edge-property-list-keys       (a 'edge-property-list-keys))
+           (edge-property-list-map        (a 'edge-property-list-map))
            (edge-property            (lambda (p i j)  ((a 'edge-property) p (fx- i k) (fx- j k) )))
            (edge-interval-property   (lambda (p i j)  ((a 'edge-interval-property) p (cis:shift (fxneg k) i) (cis:shift (fxneg k) j) )))
@@ -657 +679 @@
         ((node-interval-property)      node-interval-property)
         ((node-label)                  node-label)
-        ((edge-property-list-keys)          edge-property-list-keys)
+        ((edge-property-list-keys)     edge-property-list-keys)
+        ((edge-property-list-map)      edge-property-list-map)
         ((edge-property)               edge-property)
         ((foreach-node)                foreach-node)

release/4/interval-digraph/trunk/interval-digraph.setup

@@ -6 +6 @@
 (required-extension-version 'rb-tree 4.0)
 
-(compile -O2 -d0 -s interval-digraph.scm -j interval-digraph)
+(compile -O2 -d0 -S -s interval-digraph.scm -j interval-digraph)
 (compile -O2 -d0 -s interval-digraph.import.scm)
 
@@ -18 +18 @@
 
   ; Assoc list with properties for your extension:
-  `((version 2.0)
+  `((version 2.1)
     ))

release/4/interval-digraph/trunk/tests/run.scm

@@ -134 +134 @@
                (cis:singleton 220)))
 
+        ((g 'foreach-edge)
+         (lambda (i j) 
+           (test "foreach-edge" #t (cis:in? i sources) )
+           (test "foreach-edge" #t (cis:in? j targets) )))
+                 
+
+        ((g 'foreach-edge-with-property)
+         (lambda (i j v) 
+           (test "foreach-edge-with-property" #t (cis:in? i sources) )
+           (test "foreach-edge-with-property" #t (cis:in? j targets) )
+           (if (and (= i 10) (= j 220))
+               (test "foreach-edge-with-property" "chicken" v))
+           )
+         'test
+         )
+                 
+
       ))
     ))