雑に重み付き有向グラフを生成するやつ

gen-graph.scm

;雑にグラフを生成する

(import (scheme base)(scheme write)(srfi 1)(srfi 27))

(random-source-randomize! default-random-source)


;乱数のリストを生成する
(define (generate-random-integer-list len max-number)
  (let loop ((i len))
    (if (zero? i)
      '()
      (cons (random-integer max-number)(loop (- i 1))))))

;eqv?で同じものを省く
(define (uniqv ls)
  (let loop ((ret '())(ls ls ))
    (cond
      ((null? ls) ret)
      ((memv (car ls) ret)(loop ret (cdr ls)))
      (else (loop (cons (car ls) ret) (cdr ls))))))
      

;辺を生成する
(define (generate-node v vertices min-cost max-cost)
  (let ((cvs (delete v 
                     (uniqv (generate-random-integer-list vertices vertices))
                     eqv?)))
    (map (lambda (x) (cons x (+ min-cost (random-integer (- max-cost min-cost )))))
         cvs)))
    

;グラフを生成する
(define (generate-graph vertices min-cost max-cost)
  (let loop ((i 0))
    (if (= i vertices)
      '()
      (cons (generate-node i vertices min-cost max-cost) 
            (loop (+ i 1))))))

 
;dot出力
(define (output-dot-lang graph)
  (display "digraph {")(newline)
  (let loop ((graph graph)(v 0))
    (if (null? graph)
      '()
      (begin
        (for-each
          (lambda (x)
            (display v)
            (display " -> ")
            (display (car x))
            (display " [label=")
            (display (cdr x))
            (display "]")
            (newline))
          (car graph))
        (loop (cdr graph)(+ v 1)))))
  (display "}")
  (newline))



;test(頂点数3でコストが1から10のグラフを生成する)
;(generate-graph 3 1 10)
;
;result(乱数を使っているので毎回こうなるわけではない)
;(((1 . 5) (2 . 6)) ((0 . 4)) ((1 . 5)))
;
;       |----4-----
;       V         |
;      [0] --5-->[1] 
;       |         ^
;       6         |
;       |         5
;       V         |
;      [2]--------|