-let rec rm_assoc n = function
- | [] -> assert false
- | (x,i)::tl when n=x -> i,tl
- | p::tl -> let i,tl = rm_assoc n tl in i,p::tl
-;;
-
-let merge canonicals elements n m =
- let cn,canonicals = rm_assoc n canonicals in
- let cm,canonicals = rm_assoc m canonicals in
- let ln,elements = rm_assoc cn elements in
- let lm,elements = rm_assoc cm elements in
- let canonicals =
- (n,cm)::(m,cm)::List.map
- (fun (x,xc) as p ->
- if xc = cn then (x,cm) else p) canonicals
- in
- let elements = (cn,ln@lm)::elements
- in
- canonicals,elements
-;;
-
-let clusters f l =
- let canonicals = List.map (fun x -> (x,x)) l in
- let elements = List.map (fun x -> (x,[x])) l in
- List.fold_left
- (fun (canonicals,elements) x ->
- let dep = f x in
- List.fold_left
- (fun (canonicals,elements) d ->
- merge canonicals elements d x)
- (canonicals,elements) dep)
- (canonicals,elements) l
-;;
-