Add bfs/generalized.
This commit is contained in:
parent
c9c640cdc8
commit
a40b1ec187
38
graph.rkt
38
graph.rkt
|
@ -19,7 +19,8 @@
|
||||||
;;; https://stackoverflow.com/questions/65386334/racket-generic-graph-library-in-typed-racket
|
;;; https://stackoverflow.com/questions/65386334/racket-generic-graph-library-in-typed-racket
|
||||||
|
|
||||||
(module graph-wrapper racket
|
(module graph-wrapper racket
|
||||||
(require (prefix-in g: graph))
|
(require (prefix-in g: graph)
|
||||||
|
data/gen-queue/fifo)
|
||||||
(provide (struct-out graph) has-vertex? has-edge? vertex=? add-vertex! remove-vertex!
|
(provide (struct-out graph) has-vertex? has-edge? vertex=? add-vertex! remove-vertex!
|
||||||
rename-vertex! add-edge! add-directed-edge! remove-edge!
|
rename-vertex! add-edge! add-directed-edge! remove-edge!
|
||||||
remove-directed-edge! get-vertices in-vertices get-neighbors
|
remove-directed-edge! get-vertices in-vertices get-neighbors
|
||||||
|
@ -32,7 +33,7 @@
|
||||||
undirected-graph directed-graph
|
undirected-graph directed-graph
|
||||||
matrix-graph?
|
matrix-graph?
|
||||||
|
|
||||||
bfs fewest-vertices-path
|
bfs bfs/generalized fewest-vertices-path
|
||||||
dfs dfs/generalized
|
dfs dfs/generalized
|
||||||
|
|
||||||
graphviz)
|
graphviz)
|
||||||
|
@ -115,6 +116,26 @@
|
||||||
;; 4.1 Breadth-first Search
|
;; 4.1 Breadth-first Search
|
||||||
(define (bfs g source)
|
(define (bfs g source)
|
||||||
(g:bfs (gg g) source))
|
(g:bfs (gg g) source))
|
||||||
|
(define (bfs/generalized
|
||||||
|
g
|
||||||
|
source
|
||||||
|
#:init-queue [init-queue (mk-empty-fifo)]
|
||||||
|
#:break [break? (λ (G source from to) #f)]
|
||||||
|
#:init [init void]
|
||||||
|
#:visit? [custom-visit?-fn (λ (G source from to) #f)]
|
||||||
|
#:discover [discover (λ (G s u v acc) acc)]
|
||||||
|
#:visit [visit (λ (G s v acc) acc)]
|
||||||
|
#:return [finish (λ (G s acc) acc)])
|
||||||
|
(g:bfs/generalized
|
||||||
|
(gg g)
|
||||||
|
source
|
||||||
|
#:init-queue init-queue
|
||||||
|
#:break break?
|
||||||
|
#:init init
|
||||||
|
#:visit? custom-visit?-fn
|
||||||
|
#:discover discover
|
||||||
|
#:visit visit
|
||||||
|
#:return finish))
|
||||||
(define (fewest-vertices-path G source target)
|
(define (fewest-vertices-path G source target)
|
||||||
(g:fewest-vertices-path (gg G) source target))
|
(g:fewest-vertices-path (gg G) source target))
|
||||||
|
|
||||||
|
@ -201,6 +222,15 @@
|
||||||
;; 4.1 Breadth-first Search
|
;; 4.1 Breadth-first Search
|
||||||
[bfs (-> Graph Any (Values (Mutable-HashTable Any Number)
|
[bfs (-> Graph Any (Values (Mutable-HashTable Any Number)
|
||||||
(Mutable-HashTable Any Any)))]
|
(Mutable-HashTable Any Any)))]
|
||||||
|
[bfs/generalized (->* (Graph Any)
|
||||||
|
(#:init-queue Any ; TODO: Add a proper type.
|
||||||
|
#:break (-> Graph Any Any Any Boolean)
|
||||||
|
#:init (-> Graph Any Void)
|
||||||
|
#:visit? (-> Graph Any Any Any Boolean)
|
||||||
|
#:discover (-> Graph Any Any Any Any Any)
|
||||||
|
#:visit (-> Graph Any Any Any Any)
|
||||||
|
#:return (-> Graph Any Any Any))
|
||||||
|
Any)]
|
||||||
[fewest-vertices-path (-> Graph Any Any (U (Listof Any) False))]
|
[fewest-vertices-path (-> Graph Any Any (U (Listof Any) False))]
|
||||||
|
|
||||||
;; 4.2 Depth-first Search
|
;; 4.2 Depth-first Search
|
||||||
|
@ -301,6 +331,10 @@
|
||||||
(define-values (bfs-lens bfs-tree) (bfs (directed-graph '((a b) (b c))) 'a))
|
(define-values (bfs-lens bfs-tree) (bfs (directed-graph '((a b) (b c))) 'a))
|
||||||
(check-equal? (hash->ordered-list bfs-lens) '((a . 0) (b . 1) (c . 2)))
|
(check-equal? (hash->ordered-list bfs-lens) '((a . 0) (b . 1) (c . 2)))
|
||||||
(check-equal? (hash->ordered-list bfs-tree) '((a . #f) (b . a) (c . b)))
|
(check-equal? (hash->ordered-list bfs-tree) '((a . #f) (b . a) (c . b)))
|
||||||
|
|
||||||
|
(check-equal? (bfs/generalized (directed-graph '((a b) (a c) (b d) (c d))) 'a)
|
||||||
|
(void))
|
||||||
|
|
||||||
(check-equal? (fewest-vertices-path (directed-graph '((a b) (b c) (c d))) 'a 'd)
|
(check-equal? (fewest-vertices-path (directed-graph '((a b) (b c) (c d))) 'a 'd)
|
||||||
'(a b c d))
|
'(a b c d))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue