all_paths.ml

type opc = M | P ;;

type opnc = D | S;;

type vals = A | B | C;;

open Sequence.Infix;;

let combs k l =
  let n = List.length l in
  let rec aux k n l = match l with
  | [] when k=0 -> Sequence.return []
  | [] -> Sequence.empty
  | x :: tail ->
    let s1 = if n > k then (aux k (n-1) tail) else Sequence.empty in
    let s2 = if n >= k then (aux (k-1) (n-1) tail >|= fun l->x::l) else Sequence.empty in
    Sequence.append s1 s2
  in
  aux k n l;;


type tree =
| Feuille of vals
| Nd of opc * tree * tree;;

module L = BatList;;

(*
type tree =
| Feuille of vals
| Nd of opc * tree * tree
| Ndn of opnc * tree * tree;;*)

let rec combinations l =
  L.unique l |> combs 2 |> Sequence.to_list |> L.map (fun l -> (L.hd l, L.tl l |> L.hd));;

let rec genProf max curN (l : tree list) =
  if curN = 0 then 
      let n0 = L.map (fun e -> Feuille e) [A;B;C] in
      if max > 0 then ( genProf max 1 n0) else n0
  else 
    if curN = 1 then 
      let arb = L.map (fun op -> ( L.map (fun (a,b) -> Nd(op,Feuille a, Feuille b)) (combinations [A;B;C] ) )) [M;P] |> L.flatten in
      if max > 1 then ( genProf max 2 (l@arb)) else l@arb
    else 
      if curN <= max then
         let dbls = L.map (fun e -> (e,e)) l in
         let _ = Printf.printf "Tailles dbls=%d, combinaisons=%d\n" (L.length dbls) (combinations l|> L.length) in
         let arbres = (combinations l)@dbls in
         let res = L.map (fun  (a1,a2) -> [Nd(M,a1,a2) ; Nd(P,a1,a2)]) arbres |> L.flatten in
         ( genProf max (curN +1) (res@l))
      else
      l;;

Printf.printf "Taille Finale=%d" (genProf 3 0 [] |> L.length)