module SetPlus(Set : Set.S) = struct
  include Set
  
  let split_min_elt s = let min = min_elt s in
                          (min, remove min s)

  let of_list = List.fold_left (fun s x -> add x s) empty
end

module Integer =
  struct
    type t = int
    let compare = compare
  end

module IntSet = SetPlus( Set.Make( Integer ) )

module IntMap = Map.Make( Integer )

module SetCoupleType =
  struct
    type t = IntSet.t * IntSet.t
    let compare = compare
  end  

module IntSetCouplesSet = SetPlus( Set.Make( SetCoupleType ) )

(* This function enriches a map with successive bijection couples
   from set1 to set2.
   The f function is applied of every resulting map.
 *)   
module Gen_perm(OrgElt : Set.OrderedType)
               (AimElt : Set.OrderedType) =
struct
  
  module OrgSet = Set.Make(OrgElt)
  module AimSet = Set.Make(AimElt)
  module OrgMap = Map.Make(OrgElt)

  let gen_perm (set1, set2) f =
    
    let rec _gen_perm s1 s2 taken =
      if OrgSet.is_empty s1 then
        f taken
      else
        let e1 = OrgSet.choose s1 in
        let rem_s1 = OrgSet.remove e1 s1 in
          AimSet.iter
            ( fun e2 ->
                _gen_perm
                  rem_s1
                  (AimSet.remove e2 s2)
                  (OrgMap.add e1 e2 taken) )
            s2 in
      _gen_perm set1 set2
end

module IntGenPerm = Gen_perm( Integer ) ( Integer )

let multi_perm f =
  let f_on_map map = f (fun e -> IntMap.find e map) in
  let rec foreach_perm acc set_couple_set =
    try let (cur, rem) = IntSetCouplesSet.split_min_elt set_couple_set in
      IntGenPerm.gen_perm
         cur
        (fun taken -> foreach_perm taken rem)
        acc
    with Not_found ->
      f_on_map acc in
        
    foreach_perm IntMap.empty

let define_permutations = IntSetCouplesSet.of_list
  (List.map (fun (x, y) -> (IntSet.of_list x, IntSet.of_list y))
            [([0], [0]);
             ([1; 3], [2; 4]);
             ([11; 13; 15], [12; 14; 16]);
             ([101; 103], [102; 104])])

let _ = multi_perm
          (fun permutation ->
             Printf.printf "{ ";
             IntSetCouplesSet.iter
               ( fun (s, _) ->
                   IntSet.iter (fun e ->
                                  Printf.printf "(%i, %i) " e (permutation e))
                               s )
               define_permutations;
             Printf.printf "}\n")
          define_permutations
(* ->
{ (0, 0) (1, 2) (3, 4) (11, 12) (13, 14) (15, 16) (101, 102) (103, 104) }
{ (0, 0) (1, 2) (3, 4) (11, 12) (13, 14) (15, 16) (101, 104) (103, 102) }
{ (0, 0) (1, 2) (3, 4) (11, 12) (13, 16) (15, 14) (101, 102) (103, 104) }
{ (0, 0) (1, 2) (3, 4) (11, 12) (13, 16) (15, 14) (101, 104) (103, 102) }
{ (0, 0) (1, 2) (3, 4) (11, 14) (13, 12) (15, 16) (101, 102) (103, 104) }
{ (0, 0) (1, 2) (3, 4) (11, 14) (13, 12) (15, 16) (101, 104) (103, 102) }
{ (0, 0) (1, 2) (3, 4) (11, 14) (13, 16) (15, 12) (101, 102) (103, 104) }
{ (0, 0) (1, 2) (3, 4) (11, 14) (13, 16) (15, 12) (101, 104) (103, 102) }
{ (0, 0) (1, 2) (3, 4) (11, 16) (13, 12) (15, 14) (101, 102) (103, 104) }
{ (0, 0) (1, 2) (3, 4) (11, 16) (13, 12) (15, 14) (101, 104) (103, 102) }
{ (0, 0) (1, 2) (3, 4) (11, 16) (13, 14) (15, 12) (101, 102) (103, 104) }
{ (0, 0) (1, 2) (3, 4) (11, 16) (13, 14) (15, 12) (101, 104) (103, 102) }
{ (0, 0) (1, 4) (3, 2) (11, 12) (13, 14) (15, 16) (101, 102) (103, 104) }
{ (0, 0) (1, 4) (3, 2) (11, 12) (13, 14) (15, 16) (101, 104) (103, 102) }
{ (0, 0) (1, 4) (3, 2) (11, 12) (13, 16) (15, 14) (101, 102) (103, 104) }
{ (0, 0) (1, 4) (3, 2) (11, 12) (13, 16) (15, 14) (101, 104) (103, 102) }
{ (0, 0) (1, 4) (3, 2) (11, 14) (13, 12) (15, 16) (101, 102) (103, 104) }
{ (0, 0) (1, 4) (3, 2) (11, 14) (13, 12) (15, 16) (101, 104) (103, 102) }
{ (0, 0) (1, 4) (3, 2) (11, 14) (13, 16) (15, 12) (101, 102) (103, 104) }
{ (0, 0) (1, 4) (3, 2) (11, 14) (13, 16) (15, 12) (101, 104) (103, 102) }
{ (0, 0) (1, 4) (3, 2) (11, 16) (13, 12) (15, 14) (101, 102) (103, 104) }
{ (0, 0) (1, 4) (3, 2) (11, 16) (13, 12) (15, 14) (101, 104) (103, 102) }
{ (0, 0) (1, 4) (3, 2) (11, 16) (13, 14) (15, 12) (101, 102) (103, 104) }
{ (0, 0) (1, 4) (3, 2) (11, 16) (13, 14) (15, 12) (101, 104) (103, 102) }
*)