-let mk_vertex_and_dsc_vertex =
- function () ->
- let cache1 = Hashtbl.create 5393 in
- let cache2 = Hashtbl.create 5393 in
- (function w ->
- try
- Hashtbl.find cache1 w
- with
- Not_found ->
- let n =
- let rec aux acc =
- function
- [] -> acc
- | he::tl -> aux (acc * 4 + (match he with I -> 1 | C -> 2 | M -> 3)) tl
- in
- aux 0 w
- 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 mk_vertex2 =
- function () ->
- let cache1 = Hashtbl.create 5393 in
- function n ->
- try
- Hashtbl.find cache1 n
- with
- Not_found ->
- let v = Graph.Pack.Digraph.V.create n in
- Hashtbl.add cache1 n v;
- v
-;;
-
-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 dsc_vertex =
- let cache = Hashtbl.create 5393 in
- let canonicals = Hashtbl.create 5393 in
- let descriptions = Hashtbl.create 5393 in
- (function v ->
- 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 () ->
- let vertexes = uniq (Hashtbl.fold (fun k _ l -> k::l) cache []) in
- let xx =
- mapi
- (fun v ->
- v,
- List.sort string_compare
- (List.map string_of_w (Hashtbl.find_all cache v))
- ) vertexes in
- iteri (function (_,w::_) -> Hashtbl.add canonicals w () | _ -> ()) xx;
- 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
- try Hashtbl.find canonicals w; true with Not_found -> false
- in
- iteri
- (function (v,x) ->
- Hashtbl.add descriptions v
- (let s = String.concat "=" (List.filter is_not_redundant x) in
- if s = "" then "." else s)) xx),
- Hashtbl.find descriptions