(* 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 type PRINTABLE = sig    (* type that can be printed and compared *)
  type t
  val compare: t -> t -> int   (* needed to make sets of this type *)
  val print: t -> unit
end

module ExtSet(Elt: PRINTABLE) = struct  (* set with printable elements *)
  include Set.Make(Elt)         (* includes all standard set functions *)
  let print s = print_char '{';
    if not (is_empty s) then let m = min_elt s in (
      Elt.print m;
      iter (fun e -> print_string ", "; Elt.print e) (remove m s)
    ); print_char '}'
  let replace eo en s = add en (remove eo s)    (* new: replace function *)
end

module IntList = struct         (* integer lists that can be printed *)
  type t = int list
  let compare = compare         (* need (default) comparison to make set *)
  let print l = print_char '['; if l <> [] then (
      print_int (List.hd l);
      List.iter (fun e -> print_string "; "; print_int e) (List.tl l)
    ); print_char ']'
end

module S = ExtSet(IntList)      (* printable set of integer lists *)
module SS = ExtSet(S)           (* set of sets *)

(* actual solution starts here *)
let comp f g x = f (g x)        (* function composition *)
(* 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 -> S.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 = S.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]);;

SS.print (allsets testset);;

This document was generated using caml2html