Changeset 25487 in project


Ignore:
Timestamp:
11/10/11 07:32:29 (9 years ago)
Author:
Ivan Raikov
Message:

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

Location:
release/4/interval-digraph/trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • release/4/interval-digraph/trunk/interval-digraph.scm

    r24779 r25487  
    344344
    345345
    346   (define (foreach-edge f) ((succs 'for-each-ascending)
    347                             (lambda (i v)  (cis:foreach (lambda (j) (f i j)) v))))
     346  (define (foreach-edge f)
     347    ((succs 'for-each-ascending)
     348     (lambda (e)
     349       (let ((i (car e)))
     350         (cis:foreach (lambda (j) (f i j)) (cdr e)))
     351       )))
     352
     353
     354  (define (foreach-edge-with-property f p)
     355    (let ((props (alist-ref p edge-props)))
     356      ((succs 'for-each-ascending)
     357       (lambda (e) 
     358         (let* ((i (car e))
     359                (i-prop ((props 'get-value) (cis:singleton i) #f)))
     360           (if i-prop
     361               (cis:foreach (lambda (j) (f i j ((i-prop 'get-value) (cis:singleton j) #f))) (cdr e))
     362               (cis:foreach (lambda (j) (f i j #f)) (cdr e))))
     363           ))
     364       ))
    348365
    349366
     
    379396        ((foreach-node)                foreach-node)
    380397        ((foreach-node-with-label)     foreach-node-with-label)
    381         ((foreach-edge)                foreach-edge)
     398        ((foreach-edge)                foreach-edge)       
     399        ((foreach-edge-with-property)  foreach-edge-with-property)
     400       
    382401
    383402        ;; transformers
     
    470489           (node-interval-property   (lambda (p i)  (or ((a 'node-interval-property) p i) ((b 'node-interval-property) p i))))
    471490           (node-label               (lambda (i)    (or ((a 'node-label) i) ((b 'node-label) i))))
    472            (edge-property-list-keys       (lambda () (delete-duplicates (append ((a 'edge-property-list-keys)) ((b 'edge-property-list-keys))))))
     491           (edge-property-list-keys  (lambda () (delete-duplicates (append ((a 'edge-property-list-keys)) ((b 'edge-property-list-keys))))))
     492           (edge-property-list-map   (lambda () (delete-duplicates (append ((a 'edge-property-list-map)) ((b 'edge-property-list-map))))))
    473493           (edge-property            (lambda (p i j)  (or ((a 'edge-property) p i j) ((b 'edge-property) i j))))
    474494           (edge-interval-property   (lambda (p i j)  (or ((a 'edge-interval-property) p i j) ((b 'edge-interval-property) i j))))
     
    545565        ((node-label)                  node-label)
    546566        ((edge-property)               edge-property)
    547         ((edge-property-list-keys)          edge-property-list-keys)
     567        ((edge-property-list-keys)     edge-property-list-keys)
     568        ((edge-property-list-map)      edge-property-list-map)
    548569        ((foreach-node)                foreach-node)
    549570        ((foreach-node-with-label)     foreach-node-with-label)
     
    573594
    574595  (define (rename-nodes ns) (map (lambda (x) (list (fx+ k x))) ns))
    575   (define (rename-nodes-with-labels ns) (map (lambda (x) (list (fx+ k (car x) (cadr x)))) ns))
     596  (define (rename-nodes-with-labels ns) (map (lambda (x) (list (fx+ k (car x)) (cadr x))) ns))
    576597  (define (rename-edges es) (map (lambda (e) (list (fx+ k (car e)) (fx+ k (cadr e)))) es))
    577598  (define (rename-edges-with-labels es) (map (lambda (e) (list (fx+ k (car e)) (fx+ k (cadr e)) (caddr e))) es))
     
    601622           (node-label               (lambda (i)      ((a 'node-label) (fx- i k))))
    602623           (edge-property-list-keys       (a 'edge-property-list-keys))
     624           (edge-property-list-map        (a 'edge-property-list-map))
    603625           (edge-property            (lambda (p i j)  ((a 'edge-property) p (fx- i k) (fx- j k) )))
    604626           (edge-interval-property   (lambda (p i j)  ((a 'edge-interval-property) p (cis:shift (fxneg k) i) (cis:shift (fxneg k) j) )))
     
    657679        ((node-interval-property)      node-interval-property)
    658680        ((node-label)                  node-label)
    659         ((edge-property-list-keys)          edge-property-list-keys)
     681        ((edge-property-list-keys)     edge-property-list-keys)
     682        ((edge-property-list-map)      edge-property-list-map)
    660683        ((edge-property)               edge-property)
    661684        ((foreach-node)                foreach-node)
  • release/4/interval-digraph/trunk/interval-digraph.setup

    r24779 r25487  
    66(required-extension-version 'rb-tree 4.0)
    77
    8 (compile -O2 -d0 -s interval-digraph.scm -j interval-digraph)
     8(compile -O2 -d0 -S -s interval-digraph.scm -j interval-digraph)
    99(compile -O2 -d0 -s interval-digraph.import.scm)
    1010
     
    1818
    1919  ; Assoc list with properties for your extension:
    20   `((version 2.0)
     20  `((version 2.1)
    2121    ))
  • release/4/interval-digraph/trunk/tests/run.scm

    r24779 r25487  
    134134               (cis:singleton 220)))
    135135
     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
    136153      ))
    137154    ))
Note: See TracChangeset for help on using the changeset viewer.