(* (define (append a b) (if (null? a) b (cons (car a)(append (cdr a) b))))
Make a list of sublists of given list.
Each sub list lacks just one entry of input.
(define (sl l) (if (null? l) '()
  (cons (cdr l) (map (lambda (q) (cons (car l) q)) (sl (cdr l)))))) *)


let rec sl l = match l with [] -> []
  | h::t -> t::List.map (fun q -> h::q) (sl t);;

(* rc (read complex) takes a list of zones, each a simplex
   denoted as a list of vertex numbers and builds two lists of
   faces, each sorted by vertex number and segregated by parity.
   This list should be the complex consisting of the boundary. *)

let rc b = List.fold_left
    (fun acc fac -> match fac with (o, vl) ->
   (* Do all faces of this zone with face list fac. *)
   (* Yield a pair of face lists assorted by parity. *)
    match (List.fold_left (fun acc1 face ->
      match acc1 with od, (even, odd) ->
   (not od, if o
      then (odd, face::even)
      else (face::odd, even)))
    (false, acc) (sl vl))
    with (o, (l, r)) -> if o then (r, l) else (l, r))
    ([], []) (List.map pe b);;

let rec cas a b = match a, b with
    | [], [] -> 0 
    | [], a -> -1
    | a, [] ->1
    | p::q, r::s -> let w = compare p r in
       if w = 0 then cas q s else w;;

let ob = List.sort cas;;

let b1 q = match (rc q) with a, b -> (ob a, ob b);;

let rec elim q = match q with
   | [], [] -> [], []
   | a, [] -> a, []
   | [], b -> [], b
   | a::b, c::d -> let w = cas a c in if w < 0 then
        match elim (b, c::d) with p, q -> a::p, q else if w> 0 then
        match elim (a::b, d) with p, q -> p, c::q else
        elim (b, d);;

let comb a = elim (b1 a);;

let boundary x =
   let rec turn (p, q) = match q with [] -> p
     | r::s -> turn (((match r with a::b::c -> b::a::c)::p), s)
  in turn (comb x);;

(*
octahedron:
boundary [[1; 2; 3]; [1; 3; 4]; [1; 4; 5]; [1; 5; 2];
          [6; 3; 2]; [6; 4; 3]; [6; 5; 4]; [6; 2; 5]];;
- : int list list =
[[4; 1]; [4; 1]; [3; 1]; [3; 1]; [3; 6]; [3; 6]; [4; 6]; [4; 6]]

tetrahedron
boundary [[1; 4; 2]; [1; 3; 4]; [2; 4; 3]; [1; 2; 3]];;

icosohedron
boundary [[1; 2; 3]; [1; 3; 4]; [1; 4; 5]; [1; 5; 6]; [1; 6; 2];
  [2; 7; 3]; [3; 8; 4]; [4; 9; 5]; [5; 10; 6]; [6; 11; 2];
  [2; 11; 7]; [3; 7; 8]; [4; 8; 9]; [5; 9; 10]; [6; 10; 11];
  [7; 12; 8]; [8; 12; 9]; [9; 12; 10]; [10; 12; 11]; [11; 12; 7]];;

icosohedron with missing face
boundary [[1; 2; 3]; [1; 3; 4]; [1; 4; 5]; [1; 5; 6]; [1; 6; 2];
  [2; 7; 3]; [3; 8; 4];            [5; 10; 6]; [6; 11; 2];
  [2; 11; 7]; [3; 7; 8]; [4; 8; 9]; [5; 9; 10]; [6; 10; 11];
  [7; 12; 8]; [8; 12; 9]; [9; 12; 10]; [10; 12; 11]; [11; 12; 7]];;
  *)