mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
iterator interface for CCGraph.scc
This commit is contained in:
parent
54c690467f
commit
d8a0bbc748
2 changed files with 54 additions and 51 deletions
|
|
@ -41,6 +41,7 @@ module Seq = struct
|
||||||
let acc = ref acc in
|
let acc = ref acc in
|
||||||
a (fun x -> acc := f !acc x);
|
a (fun x -> acc := f !acc x);
|
||||||
!acc
|
!acc
|
||||||
|
let to_list seq = fold (fun acc x->x::acc) [] seq |> List.rev
|
||||||
end
|
end
|
||||||
|
|
||||||
let (|>) x f = f x
|
let (|>) x f = f x
|
||||||
|
|
@ -368,14 +369,15 @@ module SCC = struct
|
||||||
) else pop_down_to ~id (cell.vertex::acc) stack
|
) else pop_down_to ~id (cell.vertex::acc) stack
|
||||||
|
|
||||||
let explore ~tbl ~graph seq =
|
let explore ~tbl ~graph seq =
|
||||||
|
let first = ref true in
|
||||||
|
fun k ->
|
||||||
|
if !first then first := false else raise Sequence_once;
|
||||||
(* stack of nodes being explored, for the DFS *)
|
(* stack of nodes being explored, for the DFS *)
|
||||||
let to_explore = Stack.create() in
|
let to_explore = Stack.create() in
|
||||||
(* stack for Tarjan's algorithm itself *)
|
(* stack for Tarjan's algorithm itself *)
|
||||||
let stack = Stack.create () in
|
let stack = Stack.create () in
|
||||||
(* unique ID *)
|
(* unique ID *)
|
||||||
let n = ref 0 in
|
let n = ref 0 in
|
||||||
(* result *)
|
|
||||||
let res = ref [] in
|
|
||||||
(* exploration *)
|
(* exploration *)
|
||||||
Seq.iter
|
Seq.iter
|
||||||
(fun v ->
|
(fun v ->
|
||||||
|
|
@ -412,12 +414,12 @@ module SCC = struct
|
||||||
(* pop from stack if SCC found *)
|
(* pop from stack if SCC found *)
|
||||||
if cell.id = cell.min_id then (
|
if cell.id = cell.min_id then (
|
||||||
let scc = pop_down_to ~id:cell.id [] stack in
|
let scc = pop_down_to ~id:cell.id [] stack in
|
||||||
res := scc :: !res
|
k scc
|
||||||
)
|
)
|
||||||
done
|
done
|
||||||
) seq;
|
) seq;
|
||||||
assert (Stack.is_empty stack);
|
assert (Stack.is_empty stack);
|
||||||
!res
|
()
|
||||||
end
|
end
|
||||||
|
|
||||||
type 'v scc_state = 'v SCC.state
|
type 'v scc_state = 'v SCC.state
|
||||||
|
|
@ -443,7 +445,7 @@ let scc ?(tbl=mk_table 128) ~graph seq = SCC.explore ~tbl ~graph seq
|
||||||
; "h", "d"
|
; "h", "d"
|
||||||
; "h", "g"
|
; "h", "g"
|
||||||
] in
|
] in
|
||||||
let res = scc ~graph (Seq.return "a") in
|
let res = scc ~graph (Seq.return "a") |> Seq.to_list in
|
||||||
assert_bool "scc"
|
assert_bool "scc"
|
||||||
(set_eq ~eq:(set_eq ?eq:None) res
|
(set_eq ~eq:(set_eq ?eq:None) res
|
||||||
[ [ "a"; "b"; "e" ]
|
[ [ "a"; "b"; "e" ]
|
||||||
|
|
|
||||||
|
|
@ -43,6 +43,7 @@ module Seq : sig
|
||||||
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
|
val filter_map : ('a -> 'b option) -> 'a t -> 'b t
|
||||||
val iter : ('a -> unit) -> 'a t -> unit
|
val iter : ('a -> unit) -> 'a t -> unit
|
||||||
val fold: ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
|
val fold: ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
|
||||||
|
val to_list : 'a t -> 'a list
|
||||||
end
|
end
|
||||||
|
|
||||||
(** {2 Interfaces for graphs} *)
|
(** {2 Interfaces for graphs} *)
|
||||||
|
|
@ -224,7 +225,7 @@ type 'v scc_state
|
||||||
val scc : ?tbl:('v, 'v scc_state) table ->
|
val scc : ?tbl:('v, 'v scc_state) table ->
|
||||||
graph:('v, 'e) t ->
|
graph:('v, 'e) t ->
|
||||||
'v sequence ->
|
'v sequence ->
|
||||||
'v list list
|
'v list sequence_once
|
||||||
(** Strongly connected components reachable from the given vertices.
|
(** Strongly connected components reachable from the given vertices.
|
||||||
Each component is a list of vertices that are all mutually reachable
|
Each component is a list of vertices that are all mutually reachable
|
||||||
in the graph.
|
in the graph.
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue