32 lines
858 B
Scheme
32 lines
858 B
Scheme
(use-modules (graphgif)
|
|
(srfi srfi-1)
|
|
(srfi srfi-43)
|
|
(ice-9 copy-tree)
|
|
(d-))
|
|
|
|
(define red (create-color 1 0 0))
|
|
|
|
(define graph
|
|
(~> (generate-web 10 10)
|
|
(remove-rect 10 1 3 6 3)
|
|
(remove-rect 10 6 3 6 7)))
|
|
|
|
(define (color-graph graph visited heap)
|
|
(map (lambda (pair)
|
|
(cons (car pair)
|
|
(if (memq (car pair) visited)
|
|
(set-node-color (cdr pair) red)
|
|
(cdr pair))))
|
|
graph))
|
|
|
|
(define* (heap-unfold heap #:optional (infinites? #f))
|
|
(if (and (heap-peek heap) (or infinites? (finite? (car (heap-peek heap)))))
|
|
(cons (heap-peek heap) (heap-unfold (heap-pop heap) infinites?))
|
|
'()))
|
|
|
|
(define graphs '())
|
|
(djikstra graph 90 9 (lambda (visited heap)
|
|
(set! graphs (cons (color-graph graph visited heap) graphs))))
|
|
(write-graphs-to-file (reverse-list->vector graphs) "djikstra.webp")
|
|
|