Changeset 22141 in project


Ignore:
Timestamp:
12/28/10 20:06:58 (9 years ago)
Author:
Ivan Raikov
Message:

interval-digraph: added procedure make-random-gnp-digraph

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

Legend:

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

    r21078 r22141  
    2020 (needs cis (rb-tree 4.0))
    2121
    22  (test-depends test)
     22 (test-depends test random-mtzig)
    2323
    2424 (author "Ivan Raikov")
  • release/4/interval-digraph/trunk/interval-digraph.scm

    r20837 r22141  
    2222
    2323
    24  (make-digraph digraph-union digraph-disjoint-union digraph-rename)
     24 (make-digraph digraph-union digraph-disjoint-union digraph-rename
     25  make-random-gnp-digraph)
    2526
    2627                   
     
    681682(define (digraph-disjoint-union a b) (digraph-union a (digraph-rename ((a 'capacity)) b)))
    682683
     684;;
     685;; Naive implementation: randomly choosing edges from NxN possibilities with probability P
     686;;
     687
     688(define (make-random-gnp-digraph name label N P R S loops)
     689
     690  (if (< N 10) (error 'make-random-gnp-digraph "N is too small" N))
     691  (if (not (and (< 0 P) (<= P 1))) (error 'make-random-gnp-digraph "P must be in the interval (0, 1]"))
     692
     693  (let* ((E     (* N N))
     694         (nodes (cis:interval 1 N))
     695         (a     (make-digraph name label))
     696         (a     ((a 'add-node-interval) nodes)))
     697   
     698    (let recur ((a a) (s S) (e 0))
     699
     700      (if (> e E) a
     701
     702          (let* ((i (inexact->exact (R N P s)))
     703                 (j (inexact->exact (R N P s))))
     704
     705            (if (or (zero? i) (zero? j) (and (= i j) (not loops)) ((a 'has-edge) i j))
     706                (recur a s (+ 1 e))
     707                (recur ((a 'add-edge) (list i j)) s (+ 1 e))
     708                )))
     709    )))
     710
    683711
    684712)
  • release/4/interval-digraph/trunk/interval-digraph.setup

    r20665 r22141  
    1818
    1919  ; Assoc list with properties for your extension:
    20   `((version 1.0)
     20  `((version 1.1)
    2121    ))
  • release/4/interval-digraph/trunk/tests/run.scm

    r20659 r22141  
    2222;;
    2323
    24 (require-library srfi-1 test interval-digraph)
     24(require-library srfi-1 test interval-digraph random-mtzig)
    2525(import srfi-1 test
    26         (prefix interval-digraph   interval-digraph:))
     26        (prefix interval-digraph   interval-digraph:)
     27        (only random-mtzig random-mtzig:init random-mtzig:randb!)
     28        )
    2729
    2830
     
    141143
    142144    ))
     145
     146(test-group "random graph test"
     147
     148  (let* ((g (interval-digraph:make-random-gnp-digraph 
     149             'gnp-graph  "random G(N=100,P=0.2) graph"
     150             100 0.2 random-mtzig:randb! (random-mtzig:init 48)
     151             #f)))
     152         
     153    (print ((g 'edges)))
     154    ))
     155
Note: See TracChangeset for help on using the changeset viewer.