(* Given a set of integer lists, compute all sets obtained taking the head of
 * a list and adding it in front of another list, or as a new separate list *)

module IntList = struct         (* needed for set of integer lists *)
  type t = int list
  let compare = compare         (* need (default) comparison to make set *)
end

module S = Set.Make(IntList)    (* printable set of integer lists *)
module SS = Set.Make(S)         (* set of sets *)

let comp f g x = f (g x)        (* function composition *)
let replace eo en = comp (S.add en) (S.remove eo)      (* replace elt in set *)
(* union of f applied to each set element *)
let map2s f s = S.fold (comp SS.add f) s SS.empty       (* f -> set *)
let map2ss f s = S.fold (comp SS.union f) s SS.empty    (* f -> set of sets *)

(* adds i in turn to each list in s *)
let addtoall i s = map2s (fun l -> replace l (i::l) s) s

let allsets s =         (* all sets obtainable from current one *)
  SS.remove s (map2ss (fun lst ->    (* remove original set from result *)
    let h = List.hd lst in match List.tl lst with       (* for each list head *)
        [] -> addtoall h (S.remove lst s)       (* if sole element, remove *)
      | t -> let rem = replace lst t s in       (* else replace with tail *)
             SS.add (S.add [h] rem) (addtoall h rem)) s)(* and add set with [h] *)

let testset = S.add [3] (S.singleton [1;2]);;
(* S.elements converts from set to list; interpreter can directly print lists *)
List.map S.elements (SS.elements (allsets testset));;

This document was generated using caml2html