The unpac monorepo manager self-hosting as a monorepo using unpac
Merge pull request #154 from backtracking/new-example-words
new example: word graph
authored by
Jean-Christophe Filliatre
and committed by
GitHub
ff83e482
71000769
+109
-1
+2
CHANGES.md
+2
CHANGES.md
+2
-1
examples/dune
+2
-1
examples/dune
+105
examples/words.ml
+105
examples/words.ml
···
1
+
2
+
(* Word Graph
3
+
(example taken from The Stanford GraphBase)
4
+
5
+
Given a number of letters n and a file containing words (one per line),
6
+
this program builds the undirected graph where
7
+
- vertices are words of length n;
8
+
- two words are connected with an edge if they differ by exactly one letter.
9
+
10
+
Then the program computes and prints the components.
11
+
12
+
Finally, it repeatedly queries a word from the user and displays
13
+
its component.
14
+
*)
15
+
16
+
open Format
17
+
open Graph
18
+
19
+
module S = struct
20
+
type t = string
21
+
let compare = compare
22
+
let hash = Hashtbl.hash
23
+
let equal = (=)
24
+
end
25
+
module H = Hashtbl.Make(S)
26
+
27
+
module G = Imperative.Graph.Abstract(S)
28
+
let g = G.create ()
29
+
30
+
let words : G.V.t H.t = H.create 16
31
+
32
+
let add_word w =
33
+
let v = G.V.create w in H.add words w v; G.add_vertex g v
34
+
35
+
let rec read_words n c =
36
+
match input_line c with
37
+
| s -> if String.length s = n then add_word s; read_words n c
38
+
| exception End_of_file -> ()
39
+
40
+
let () =
41
+
try match Sys.argv with [| _; n; f |] ->
42
+
let n = int_of_string n in
43
+
let c = open_in f in
44
+
read_words n c;
45
+
close_in c;
46
+
| _ -> raise Exit
47
+
with _ -> eprintf "%s <int> <file>@." Sys.argv.(0); exit 1
48
+
49
+
let () = printf "%d words@." (G.nb_vertex g)
50
+
51
+
let diff1 s1 s2 =
52
+
let n = String.length s1 in
53
+
assert (String.length s2 = n);
54
+
let rec scan d i =
55
+
i = n && d = 1 ||
56
+
i < n && if s1.[i] = s2.[i] then scan d (i+1) else d = 0 && scan 1 (i+1) in
57
+
scan 0 0
58
+
59
+
let () =
60
+
G.iter_vertex (fun v1 ->
61
+
G.iter_vertex (fun v2 ->
62
+
if diff1 (G.V.label v1) (G.V.label v2) then G.add_edge g v1 v2
63
+
) g) g
64
+
65
+
let () = printf "%d edges@." (G.nb_edges g)
66
+
67
+
module C = Components.Undirected(G)
68
+
let comp = C.components_array g
69
+
70
+
let histogram a =
71
+
let h = Hashtbl.create (Array.length a) in
72
+
let incr v =
73
+
Hashtbl.replace h v (1 + try Hashtbl.find h v with Not_found -> 0) in
74
+
Array.iter incr a;
75
+
let l = Hashtbl.fold (fun v n acc -> (v, n) :: acc) h [] in
76
+
List.sort (fun (v1, _) (v2, _) -> compare v1 v2) l
77
+
78
+
let () =
79
+
printf "%d components@." (Array.length comp);
80
+
Array.sort (fun l1 l2 -> Stdlib.compare (List.length l1) (List.length l2))
81
+
comp;
82
+
let print1 v = printf "@ %s" (G.V.label v) in
83
+
let print c =
84
+
printf "@[<hov 2>%d:" (List.length c); List.iter print1 c; printf "@]@." in
85
+
Array.iter print comp;
86
+
let hist = histogram (Array.map List.length comp) in
87
+
List.iter (fun (v, n) -> printf "%d component(s) of size %d@." n v) hist
88
+
89
+
module D = Traverse.Dfs(G)
90
+
91
+
let () =
92
+
while true do
93
+
printf "start: @?";
94
+
let s = read_line () in
95
+
try
96
+
let v = H.find words s in
97
+
printf "@[<hov 2>component:";
98
+
let m = ref 0 in
99
+
let visit v = printf "@ %s" (G.V.label v); incr m in
100
+
D.prefix_component visit g v;
101
+
printf "@]@.";
102
+
printf "%d word(s)@." !m
103
+
with Not_found ->
104
+
printf "not a vertex@."
105
+
done