- aux 0 w
- in
-prerr_endline (string_of_w w ^ " => " ^ string_of_int n);
- let v = Graph.Pack.Digraph.V.create n in
- cache := (w,v)::!cache;
- v in
+ let v = Graph.Pack.Digraph.V.create n in
+ Hashtbl.add cache1 w v;
+ Hashtbl.add cache2 v w;
+ v),
+ (Hashtbl.find cache2)
+;;
+
+let string_compare s1 s2 =
+ let c = compare (String.length s1) (String.length s2) in
+ if c = 0 then String.compare s1 s2 else c
+;;
+
+let normalize_and_describe norm mk_vertex dsc_vertex =
+ let cache = Hashtbl.create 37 in
+ (function n ->
+ let v = mk_vertex n in
+ let normalized = norm v in
+ let dsc = dsc_vertex v in
+ if not (List.mem dsc (Hashtbl.find_all cache normalized)) then
+ Hashtbl.add cache normalized dsc;
+ normalized),
+ (function v ->
+ let vertexes = uniq (Hashtbl.fold (fun k _ l -> k::l) cache []) in
+ let ll =
+ List.map
+ (fun v ->
+ v,
+ List.sort string_compare
+ (List.map string_of_w (Hashtbl.find_all cache v))
+ ) vertexes in
+ let is_not_redundant s =
+ let len = String.length s in
+ if len <= 1 then true
+ else
+ let w = String.sub s 1 (len - 1) in
+ List.exists (function w'::_ -> w=w' | [] -> false) (List.map snd ll)
+ in
+ let l = List.filter is_not_redundant (List.assoc v ll) in
+ let s = String.concat "=" l in
+ if s = "" then "." else s)
+;;
+
+let classify arcs =
+ print_endline (string_of_int (List.length arcs) ^ " arcs to be classified");
+ let mk_vertex,dsc_vertex = mk_vertex_and_dsc_vertex () in