*****************************
* chap1
*****************************

#1+1;;
- : int = 2
#2*3;;
- : int = 6
#4/2;;
- : int = 2
#5.5 *. 2.5;;
- : float = 13.75


#exp(1.);;
- : float = 2.71828182846
#4. *. atan(1.);;
- : float = 3.14159265359


#2 _ 3;;
EntrŽe interactive:
>2 _ 3;;
>  ^
Erreur de syntaxe.
#2 - 3;;
- : int = -1


#sin;;
- : float -> float = <fun>


#(1<2) && (4=3);;
- : bool = false
#(1<2) || (4=3);;
- : bool = true
#"Bonjour";;
- : string = "Bonjour"
#nth_char "Bonjour" 3;;
- : char = `j`
#"Ceci est"^" une cha”ne de caract�res";;
- : string = "Ceci est une cha”ne de caract�res"


#[|"un" ; "vecteur"; "de"; "string" |];;
- : string vect = [|"un"; "vecteur"; "de"; "string"|]
#["une"; "liste"; "de"; "string"];;
- : string list = ["une"; "liste"; "de"; "string"]
#1::[2;3];;
- : int list = [1; 2; 3]
#hd [7;8;9];;
- : int = 7
#tl [1;2;3];;
- : int list = [2; 3]
#hd (tl [1;2;3]);;
- : int = 2
#[|7;8;9|];;
- : int vect = [|7; 8; 9|]
#[|7;8;9|].(2);;
- : int = 9


#("une paire", "de string");;
- : string * string = "une paire", "de string"
#(1,"abc",true);;
- : int * string * bool = 1, "abc", true


#string_of_int;;
- : int -> string = <fun>
#string_of_int 3;;
- : string = "3"
#float_of_int 4;;
- : float = 4.0
#list_of_vect [|1;2;3|];;
- : int list = [1; 2; 3]


#int 10;;
EntrŽe interactive:
>int 10;;
>^^^
L'identificateur int n'est pas dŽfini.
##open "random";;
#int 10;;
- : int = 4
#int 10;;
- : int = 2
#int 10;;
- : int = 3


#type animal_de_compagnie = Chien | Chat | Oiseau;;
Le type animal_de_compagnie est dŽfini.
#Chien;;
- : animal_de_compagnie = chien


#[1; "un" ; 2; 3];;
EntrŽe interactive:
>  [1;"un";2;3];;
> ^^^^^^
Cette expression est de type string list,
mais est utilisŽe avec le type int list.


#1+2.3;;
EntrŽe interactive:
>1+2.3;;
>  ^^^
Cette expression est de type float,
mais est utilisŽe avec le type int.
#1.0 +. 2.3;;
- : float = 3.3
#float_of_int 1 +. 2.3;;
- : float = 3.3


#let f = function x -> x*x;;
f : int -> int = <fun>


#f(3);;
- : int = 9
#f 2;;
- : int = 4


#let f x = x*x;;
f : int -> int = <fun>
#let f = fun x -> x*x;;
f : int -> int = <fun>


#let g x = f x;;
g : int -> int = <fun>
#g(3);;
- : int = 9


#let h = f;;
h : int -> int = <fun>
#h(3);;
- : int = 9


#(function x -> x + 1) 2;;
- : int = 3


#let somme1 (x,y) = x+y;;
somme1 : int * int -> int = <fun>
#somme1 (1,4);;
- : int = 5


#let h z = somme1 (2,z);;
h : int -> int = <fun>
#h 3;;
- : int = 5


#let somme2 x y  = x+y;;
somme2 : int -> int -> int = <fun>
#somme2 2 3;;
- : int = 5


#let h  = somme2 2;;
h : int -> int = <fun>
#h 3;;
- : int = 5


#let rec u(n) = u(n-1) + u(n-2);;
u : int -> int = <fun>


#x;;
EntrŽe interactive:
>x;;
>^
L'identificateur x n'est pas dŽfini.
#let x=2 in x+3;;
- : int = 5
#x;;
EntrŽe interactive:
>x;;
>^
L'identificateur x n'est pas dŽfini.


# x + 3 where x=2;;
- : int = 5


#let x = 3 in let y = 2 in x+y;;
- : int = 5


#let (x,y)=(3,2) in x+y;;
- : int = 5


#let x=3 and y=2 in x+y;;
- : int = 5


#let pi=4. *. atan(1.);;
pi : float = 3.14159265359


#let x=5;;
x : int = 5
#x+1;;
- : int = 6
#let f = fun y -> x+y;;
f : int -> int = <fun>
#f(2);;
- : int = 7


#let x=3;;
x : int = 3
#f(2);;
- : int = 7


#let rec factorielle n = match n with
     | 0 -> 1 
     | n -> n * factorielle (n-1);;
factorielle : int -> int = <fun>
#factorielle 5;;
- : int = 120


#let rec u = function
     | 0 -> 0 
     | 1 -> 1 
     | n -> u(n-1) + u(n-2);;
u : int -> int = <fun>
#u 8;;
- : int = 21


#let rec u n = match n with
     | 0 -> 0 
     | 1 -> 1 
     | n -> u(n-1) + u(n-2);;
u : int -> int = <fun>
#u 8;;
- : int = 21


let XOR = function
     | (false, false) -> false 
     | (false, true)  -> true  
     | (true, false)  -> true  
     | (true, true)   -> false;;
XOR : bool * bool -> bool = <fun>
#XOR (1=1, 2>0);;
- : bool = false


let XOR = function
     | (false, false) -> false 
     | (true, true)   -> false 
     |     _          -> true;;
XOR : bool * bool -> bool = <fun>
#XOR (3=1, 5>0);;
- : bool = true


let OR = function
     | (false, false) -> false
     | (true, _)      -> true
     | (_, true)      -> true;;


#let vole = function 
     | Chien  -> false
     | Chat   -> false
     | Oiseau -> true;;
vole : animal_de_compagnie -> bool = <fun>
#vole Oiseau;;
- : bool = true


#let rec add (liste1,liste2) = match (liste1,liste2) with
     |  ([],liste)   -> liste
     |  (liste,[])   -> liste
     | (e1::r,e2::s) -> (e1+e2)::(add (r,s));;
add : int list * int list -> int list = <fun>
#add ([1;2;3],[0;4;5;6]);;
- : int list = [1; 6; 8; 6]


#let rec add2 liste = function
     | []   -> liste
     | e::r -> (hd(liste) + e)::(add2 (tl liste) r);;
add2 : int list -> int list -> int list = <fun>
#add2 [1;2;3] [0;1];;
- : int list = [1; 3; 3]


#let rec add3 (liste1,liste2) = match (liste1,liste2) with
 (e1::r,e2::s) -> (e1+e2)::(add3 (r,s));;
EntrŽe interactive:
>...............................match (liste1,liste2) with
> (e1::r,e2::s) -> (e1+e2)::(add3 (r,s))..
Attention: ce filtrage n'est pas exhaustif.
add3 : int list * int list -> int list = <fun>



#let rec add4 (liste1,liste2) = match (liste1,liste2) with
     |  ([],liste)   -> liste
     |  (liste,[])   -> liste
     | (e1::r,e2::s) -> (e1+e2)::(add4 (r,s))
     |  ([],[])      -> [];;
EntrŽe interactive:
>     |  ([],[])      -> [];;
>         ^^^^^
Attention: ce cas de filtrage est inutile.
add : int list * int list -> int list = <fun>


#print_string "bonjour";;
bonjour- : unit = ()
#print_string;;
- : string -> unit = <fun>


#let abs x =
    if x>0 then x else -x;;
abs : int -> int = <fun>
#abs (-5);;
- : int = 5
#abs 2;;
- : int = 2


#let rec fact n=
   if n<=1 then 1 else n*fact (n-1);;
fact : int -> int = <fun>
#fact 12;;
- : int = 479001600


#let mon_log2 x =
  if x>. 0. then log(x);;
EntrŽe interactive:
>  if x>. 0. then log(x);;
>  ^^^^^^^^^^^^^^^^^^^^^
Cette expression est de type unit,
mais est utilisŽe avec le type float.


#let test x =
   if x<0 then print_string "Entier negatif";;
test : int -> unit = <fun>
#test (-3);;
Entier negatif- : unit = ()
#test 2;;
- : unit = ()


#let x= ref 0;;
x : int ref = ref 0


#x;;
- : int ref = ref 0
#!x;;
- : int = 0
#x:=x+1;;
EntrŽe interactive:
>x:=x+1;;
>   ^
Cette expression est de type int ref,
mais est utilisŽe avec le type int.
#x:=!x+1;;
- : unit = ()
#x;;
- : int ref = ref 1
#!x;;
- : int = 1


#let fact n =
    let res = ref 1 in
      for i=1 to n do
          res:= !res*i
      done;
    !res;;
fact : int -> int = <fun>
#fact 3;;
- : int =6


#let sigma n m =
	    let resultat = ref 0 in
	       for i = n to m do
	          resultat := !resultat + i
		      done;
	!resultat;;
sigma : int -> int -> int = <fun>
#sigma 1 10;;
- : int = 55


#let newton epsilon u0 = 
           (* epsilon est la precision, u0 la valeur initiale *)
   let g x = 1./.2. *. x +. 1./. x in 
           (* on travaille avec des flottants ! *)
   let rac2 = ref u0 in
		    while (abs_float(2. -. !rac2*.(!rac2)) > epsilon) do
             rac2:= g !rac2 
      done;
  !rac2;;
newton : float -> float -> float = <fun>
#newton 1e-6  5.;;
- : float = 1.4142135858


#let newton_bis epsilon u0 = 
   let g x = 1./.2. *. x +. 1./. x in 
   let compteur = ref 0 in
(* on initialise le compteur ˆ zŽro *)
   let rac2 = ref u0 in
		     while (abs_float(2. -. !rac2*.(!rac2)) > epsilon) do
              rac2:= g !rac2; 
              compteur:= !compteur + 1
       done;
   print_string "nombre d'iterations : "; 
   print_int !compteur;
   print_newline ();;
(* on retourne la valeur du compteur cette fois-ci
   plut™t que la racine *)
newton_bis : float -> float -> unit = <fun>
#newton_bis 1e-6 5.;;
nombre d'iterations : 5
- : unit = ()


#let test n = 
let a=ref 0 and b=ref 0 in
if n=1 then begin a:=1; b:=11 end else begin a:=2;  b:=22 end;
(!a,!b);;
test : int -> int * int = <fun>

#test 1;;
- : int * int = 1, 11
#test 2;;
- : int * int = 2, 22

#let test2 n = 
let a=ref 0 and b=ref 0 in
if n=1 then begin a:=1; b:=11 end else a:=2;  b:=22;
(!a,!b);;
test2 : int -> int * int = <fun>

#test2 1;;
- : int * int = 1, 22
#test2 2;;
- : int * int = 2, 22


#let test3 n = 
let a=ref 0 and b=ref 0 in
if n=1 then  a:=1; b:=11 else a:=2;  b:=22;
(!a,!b);;

EntrŽe interactive:
>if n=1 then  a:=1; b:=11 else a:=2;  b:=22;
>                         ^^^^
Erreur de syntaxe.


let Juillet97 () =
  let s = "britannique" in
  let s = "chinoise" in   
        print_string "Hong Kong est une ville ";
        print_string s;
  print_string " sous souverainetŽ ";
  print_string s;;


#Juillet97 ();;
Hong Kong est une ville chinoise sous souverainetŽ chinoise
- : unit = ()


let Juin97 () =
  let s = "britannique" in
  begin
  let s = "chinoise" in   
        print_string "Hong Kong est une ville ";
        print_string s;
  end;
  print_string " sous souverainetŽ ";
  print_string s;;


#Juin97 ();;
Hong Kong est une ville chinoise sous souverainetŽ britannique
- : unit = ()


let conditionnelle condition action1 action2 = 
  match condition with
    | true  -> action1 
    | false -> action2;;


let rec boucle_inconditionnelle n f x = 
			if n=0 then x else f(boucle_inconditionnelle (n-1) f x)

let rec boucle_conditionnelle test_arret f x = 
			if (test_arret x) then x else 
						boucle_conditionnelle test_arret f (f x);;


let rec repeat_until test_arret f x =
   boucle_conditionnelle test_arret f (f x);;


#[];;
- : 'a list = []


#hd;;
- : 'a list -> 'a = <fun>


#let FoisDeux x = 2*x;;
FoisDeux : int -> int = <fun>
#map FoisDeux [1;2;3];;
- : int list = [2; 4; 6]


#map;;
- : ('a -> 'b) -> 'a list -> 'b list = <fun>


#let itere_loi loi  initialisation n m =
	    let resultat = ref initialisation in
	        for i = n to m do
		           resultat := loi !resultat i
		       done;
	    !resultat;;
itere_loi : ('a -> int -> 'a) -> 'a -> int -> int -> 'a = <fun>
#let sigma = itere_loi (prefix +) 0;;
sigma : int -> int -> int = <fun>
#sigma 1 10;;
- : int = 55
#let prod = itere_loi (prefix *) 1;;
prod : int -> int -> int = <fun>
#prod 1 10;;
- : int = 3628800


#let rec puissance_entiere x = function
    | 0 -> 1.0
    | 1 -> x
    | n -> x *. puissance_entiere x (n-1);;
puissance_entiere : float -> int -> float = <fun>
#puissance_entiere 2.5 3;;
- : float = 15.625


#let puissance_iteree_de_deux = itere_loi puissance_entiere 2.0;;
puissance_iteree_de_deux : int -> int -> float = <fun>
#puissance_iteree_de_deux 1 5;;
- : float = 1.32922799578e+36


#let l = [];;
l : 'a list = []
#let l = ([]:int list);;
l : int list = []


#let itere_loi loi  initialisation n m =
	    let resultat = ref initialisation in
	        for i = n to m do
		           resultat := loi (!resultat:int) i
		       done;
	    !resultat;;
itere_loi : (int -> int -> int) -> int -> int -> int -> int = <fun>


#let puissance_iteree_de_deux = itere_loi puissance_entiere 2.0;;
EntrŽe interactive:
>let puissance_iteree_de_deux = itere_loi puissance_entiere 2.0;;
>                                         ^^^^^^^^^^^^^^^^^
Cette expression est de type float -> int -> float,
mais est utilisŽe avec le type int -> int -> int.


#let rec miroir_aux accu = fun
        | [] -> accu
        | (a::suite) -> miroir_aux (a::accu) suite;;
miroir_aux : 'a list -> 'a list -> 'a list = <fun>
#miroir_aux [3;2;1] [6;7;8];;
- : int list = [8; 7; 6; 3; 2; 1]


#let miroir = miroir_aux [];; 
miroir : '_a list -> '_a list = <fun>


#miroir [1;2;3];;
- : int list = [3; 2; 1]
#miroir;;
- : int list -> int list = <fun>


#let miroir_polymorphe l = miroir_aux [] l;;  
miroir_polymorphe : 'a list -> 'a list = <fun>
#miroir_polymorphe [1;2;3];;
- : int list = [3; 2; 1]
#miroir_polymorphe;;
- : 'a list -> 'a list = <fun>


#let e = ref [];;
e : '_a list ref = ref []
#e:=[1];;
- : unit = ()
#e;;
- : int list ref = ref [1]


#let x= ref (true,[1;2;3]);;
x : (bool * int list) ref = ref (true, [1; 2; 3])
#x:=(false,[4;5]);;
- : unit = ()


#let binomial n p = (fact n)/((fact p) * (fact (n-p)))
    where rec fact  = function
          | 0 -> 1
          | n -> n* fact (n-1);;
binomial : int -> int -> int = <fun>
#binomial 4 2;;
- : int = 6


#let compose g f x = g (f x);;
compose : ('a -> 'b) -> ('c -> 'a) -> 'c -> 'b = <fun>
#let f x = x+1;;
f : int -> int = <fun>
#let g x = x*x;;
g : int -> int = <fun>
#let h = compose g f;;
h : int -> int = <fun>
#h 3;;
- : int = 16


#let test n  = (n/n = 1);;
test : int -> bool = <fun>
#test 1;;
- : bool = true
#test 0;;
Exception non rattrapŽe: Division_by_zero
#(2=2) or (test 0);;
- : bool = true
#let ou = prefix or;;
ou : bool -> bool -> bool = <fun>
#ou (2=2)  (test 0);;
Exception non rattrapŽe: Division_by_zero


let somme_curry x y = x+y;;



let somme_uncurry (x,y) = x+y;;


#let curry = fun
     f x y -> f (x,y);;
curry : ('a * 'b -> 'c) -> 'a -> 'b -> 'c = <fun>

#let somme = curry somme_uncurry;;
somme : int -> int -> int = <fun>


#let uncurry = fun
    f (x,y) -> f x y;;
uncurry : ('a -> 'b -> 'c) -> 'a * 'b -> 'c = <fun>


#let curry = function
 f x y -> f (x,y);;


EntrŽe interactive:
> f x y -> f (x,y);;
> ^^^
Le constructeur f n'est pas dŽfini.


#let XOR = function
    | true x -> not x
    | false x -> x;;

EntrŽe interactive:
>    | true x -> not x
>      ^^^^^^
Le constructeur true est constant: 
   il ne peut recevoir un argument.


let XOR = fun
    | true x -> not x
    | false x -> x;;

let XOR = function
    | (true,x) -> not x
    | (false,x) -> x;;


let test1 = function
    | ... -> ...
    | ((1, x),(2,(1,y))) -> ...
    | ... -> ...;;



let test2 = function
    | ... -> ...
    | ((1, x),(2,(1,x))) -> ...
    | ... -> ...;;


let test3 = function
    | ... -> ...
    | ((1, x),(2,(1,y))) when x=y -> ...
    | ... -> ...;;


let test4 = function
    | ... -> ...
    | ((1, x),(2,(1,y))) when x=y+1 -> ...
    | ... -> ...;;


let test5 = function
    | ... -> ...
    | ((1, x),(2,(1,y))) -> if x=y then ... else ...
    | ... -> ...;;


let f = function
    | [] -> ...
    | a::r as L -> if list_length L = ...


let f = function
    | [] -> ...
    | a::r -> if list_length (a::r) = ...


#"test" == "test";;
- : bool = false
#"test" = "test";;
- : bool = true


#1/2=3/2-1;;



#1/2==3/2-1;;
- : bool = true


#let x = ref 1 and y = ref 1;;
x : int ref = ref 1
y : int ref = ref 1
#x = y;;
- : bool = true
#x == y;;
- : bool = false
#x := 2;;
- : unit = ()
#x = y;;
- : bool = false


type animal_de_compagnie = Chien | Chat | Oiseau;;
Le type animal_de_compagnie est dŽfini.


#type complexe = 
      {Partie_reelle : float; Partie_imaginaire : float};;
Le type complexe est dŽfini.
#let i={Partie_reelle = 0.0 ; Partie_imaginaire = 1.0};;
i : complexe = {Partie_reelle = 0.0; Partie_imaginaire = 1.0}


#let conjugaison {Partie_reelle = a ; Partie_imaginaire = b} =
	        {Partie_reelle = a ; Partie_imaginaire = -.b};;
conjugaison : complexe -> complexe = <fun>
#let i_barre = conjugaison i;;
i_barre : complexe = {Partie_reelle = 0.0; Partie_imaginaire = -1.0}
#i_barre.Partie_imaginaire;;
- : float = -1.0


#type pere_de_famille = 
{Nom : string ; Age : int ; Enfants : string list ;
                Animaux : animal_de_compagnie list};;
Le type pere_de_famille est dŽfini.
#let papa = 
{Nom = "jean" ; Age = 60 ; Enfants = ["philippe"; "luc"] ;
                           Animaux = [chien]};;
papa : pere_de_famille =
 {Nom = "jean"; Age = 60; Enfants = ["philippe"; "luc"]; 
                          Animaux = [chien]}


#type point == float * float;;
Le type point est dŽfini.


#let rec premi�re_projection = function
   | [] -> []
   | (x,y)::q -> x::(premi�re_projection q);;
premi�re_projection : ('a * 'b) list -> 'a list = <fun>
#let rec premi�re_projection = function
   | [] -> []
   | ((x,y):point)::q -> x::(premi�re_projection q);;
premi�re_projection : point list -> float list = <fun>
#let (translation: point -> point) = function
    (x,y) -> x +. 1., y +. 1.;;
translation : point -> point = <fun>



#type pere_de_famille = {Nom : string ; mutable Age : int ;
                         Enfants : string list ; 
                         Animaux : animal_de_compagnie list};;
Le type pere_de_famille est dŽfini.


#let papa = 
{Nom = "jean" ; Age = 60 ; Enfants = ["philippe"; "luc"] ; 
                Animaux = [chien]};;
papa : pere_de_famille =
 {Nom = "jean"; Age = 60; Enfants = ["philippe"; "luc"]; 
                Animaux = [chien]}
#let rajeunir x = x.age <- 20;;
- : unit = ()
#rajeunir papa;;
- : unit = ()
#papa;;
- : pere_de_famille =
 {Nom = "jean"; Age = 20; Enfants = ["philippe"; "luc"]; 
                          Animaux = [chien]}


#type nombre = Entier of int | Reel of float;;
Le type nombre est dŽfini.
#let x = Entier(1);;
x : nombre = Entier 1
#let y=Reel(2.5);;
y : nombre = Reel 2.5
#let add = fun
    | (Entier n) (Entier m) -> Entier (n+m)
    | (Entier n) (Reel x)   -> Reel ((float_of_int n) +. x)
    | (Reel x)   (Entier n) -> Reel (x +. (float_of_int n))
    | (Reel x)   (Reel y)   -> Reel (x +. y);;
add : nombre -> nombre -> nombre = <fun>
##infix "add";;
#x add y;;
- : nombre = Reel 3.5


#type 'a boite = {Provenance : string ; Contenu : 'a list};;
Le type boite est dŽfini.
#let boulier = {Provenance = "chine" ; 
                Contenu = [0;1;2;3;4;5;6;7;8;9]};;
boulier : int boite =
 {Provenance = "chine"; 
  Contenu = [0; 1; 2; 3; 4; 5; 6; 7; 8; 9]}


#type 'a paire = Paire of 'a  * 'a ;;
Le type paire est dŽfini.
#let anglais_francais = Paire (["un";"deux";"trois"], 
                               ["one";"two"; "three"]);;
anglais_francais : string list paire =
 Paire (["un"; "deux"; "trois"], ["one"; "two"; "three"])


#Paire(1,"un");;
EntrŽe interactive:
>Paire(1,"un");;
>        ^^^^
Cette expression est de type string,
mais est utilisŽe avec le type int.


type arbre_binaire = Feuille of int 
                   | Noeud of  arbre_binaire * arbre_binaire;;


#let mon_arbre = 
           Noeud ( Feuille 1, Noeud (Feuille 2, Feuille 3));;
mon_arbre : arbre_binaire =
           Noeud (Feuille 1, Noeud (Feuille 2, Feuille 3))



#let rec nombre_de_feuilles  = function
    | (Feuille n) -> 1
    | Noeud (sous_arbre_droit, sous_arbre_gauche) ->
                    (nombre_de_feuilles sous_arbre_droit) + 
                    (nombre_de_feuilles sous_arbre_gauche);;

nombre_de_feuilles : arbre_binaire -> int = <fun>
#nombre_de_feuilles mon_arbre;;
- : int = 3


#type expression = Constante of int
                | Variable of string
                | Addition of expression * expression
                | Multiplication of expression * expression
                | Exponentielle of expression;;

Le type expression est dŽfini.
#let expr1 = 
     Exponentielle(Addition (Variable "x", Constante 1));;
expr1 : expression = 
     Exponentielle (Addition (Variable "x", Constante 1))
#let expr2 = Addition (Multiplication (Variable "x", 
                        Addition (Variable "y", Constante 1)),
                       Constante 2);; 
expr2 : expression =
 Addition
  (Multiplication (Variable "x", 
         Addition (Variable "y", Constante 1)),
   Constante 2)


#let rec derive variable_de_derivation = function
    | (Constante n)  -> (Constante 0)
    | (Variable x)   -> if (x=variable_de_derivation) 
                        then (Constante 1)
                        else (Constante 0)
    | (Addition (expr1, expr2)) ->
              Addition (derive variable_de_derivation expr1,
                        derive variable_de_derivation expr2)
    | (Multiplication (expr1, expr2)) ->
       Addition 
        (Multiplication (derive variable_de_derivation expr1,
                         expr2),
         Multiplication (expr1, 
                         derive variable_de_derivation expr2))
    | (Exponentielle expr) ->
       Multiplication (derive variable_de_derivation expr,
                       Exponentielle (expr));;
derive : string -> expression -> expression = <fun>         


#derive "x" expr1;;
- : expression =
 Multiplication
  (Addition (Constante 1, Constante 0),
   Exponentielle (Addition (Variable "x", Constante 1)))
#derive "x" expr2;;
- : expression =
 Addition
  (Addition
    (Multiplication 
          (Constante 1, Addition (Variable "y", Constante 1)),
     Multiplication (Variable "x", 
           Addition (Constante 0, Constante 0))),
   Constante 0)


#type 'a liste = Liste_vide | Conse of 'a*'a liste;;
Le type liste est dŽfini.
#Conse (1, Liste_vide);;
- : int liste = Conse (1, Liste_vide)


#type alpha = a | Mot   of alpha * beta
   and beta = b | Suite of beta  * alpha;;
Le type alpha est dŽfini.
Le type beta est dŽfini.
#let essai1 = Mot ( Mot (a, Suite (b,a)), b);;
essai1 : alpha = Mot (Mot (a, Suite (b,a)), b)
#let essai2 = Suite (b,essai1);;
essai2 : beta = Suite (b, Mot (Mot (a, Suite (b,a)), b))


#printf__printf "Le nombre %s est %d" "un" 1;;
Le nombre un est 1- : unit = ()


#let rec fact = fun
    | 0 -> 1
    | n -> n* fact (n-1);;
fact : int -> int = <fun>
#let sortie = open_out "mon_fichier";;
sortie : out_channel = <abstr>



#output_value sortie (fact 10);;
- : unit = ()
#output_string sortie "C'est fini\n";;
- : unit = ()


#close_out sortie;;
- : unit = ()


#let entree = open_in "mon_fichier";;
entree : in_channel = <abstr>
#let fact10 = input_value entree;;
fact10 : '_a = <poly>
#print_int fact10;;
3628800- : unit = ()
#(fact10:int);; 
(* remarquer le for�age de type pour rŽcuperer la valeur *)
- : int = 3628800
#input_line entree;;
- : string = "C'est fini"
#input_line entree;;
Exception non rattrapŽe: End_of_file


#close_in entree;;
- : unit = ()



type Lexeme = PARO
            | PARF
            | PLUS
            | MULT
            | EXP
            | CST of int
            | VAR of string;;


(* Analyseur lexical *)

let Identificateur_Long = make_string 32 ` `;;

let rec Ident i = function 
    | [< ' `a`..`z`|`A`..`Z`|`0`..`9`|`_`  as c ;
(* on a droit ˆ des identificateurs qui ne commencent pas *)
(* par un chiffre, de longueur < 33 et indexŽs au besoin ! *) 
     (if i >= 32 
      then Ident i 
       (* on tronque au dessus de 32 caract�res *)
      else begin
       	 set_nth_char Identificateur_Long i c;
	        Ident (succ i) 
            end) s >]    -> s
    | [<>]               ->
        (match sub_string Identificateur_Long 0 i with
      	    | "+"   -> PLUS
      	    | "*"   -> MULT
           | "exp" -> EXP
      	    | s     -> VAR s);;

let rec Nombre i = function 
    | [< '`0`..`9`  as d ;
(* on a droit ˆ des nombres de longueur < 33 *) 
     (if i >= 32 then Nombre i 
       else begin
       	 set_nth_char Identificateur_Long i d;
	        Nombre (succ i) 
            end) n >]    -> n
    | [<>]               ->
        (match sub_string Identificateur_Long 0 i with
      	    | "+"   -> PLUS
      	    | "*"   -> MULT
           | "exp" -> EXP
      	    | n     -> CST (int_of_string n));;

let rec Blancs = function
  | [< '` `|`\t`|`\n`; Blancs _ >] -> ()
  | [<>] -> ();;

let rec LexemesFlot_of_flot flot = 
    Blancs flot ; match flot with 
  | [< '`(` ; Blancs _ >]          -> [< 'PARO ; LexemesFlot_of_flot flot >]
  | [< '`)` ; Blancs _ >]          -> [< 'PARF ; LexemesFlot_of_flot flot >]
  | [< '`e`;'`x`;'`p`; Blancs _ >] -> [< 'EXP;   LexemesFlot_of_flot flot >]
  | [< '`+` ; Blancs _ >]          -> [< 'PLUS ; LexemesFlot_of_flot flot >]
  | [< '`*` ; Blancs _ >]          -> [< 'MULT ; LexemesFlot_of_flot flot >]
  | [< '`0`..`9` as d ; 
       (set_nth_char Identificateur_Long 0 d ; Nombre 1 ) lex >] 
                                   -> [< 'lex ; LexemesFlot_of_flot flot >]
  | [< '`a`..`z`|`A`..`Z` as c ; 
      (set_nth_char Identificateur_Long 0 c ; Ident 1 ) lex >] 
                                   -> [< 'lex ; LexemesFlot_of_flot flot >]
(* dans les 2 derniers cas on accumule les caract�res pour constituer un *)
(* identificateur de plus d'une lettre ou un nombre de plus d'un chiffre *)
  | [<>]                           -> [<>];;

let LexemesFlot_of_string string =
           LexemesFlot_of_flot (stream_of_string string);;

(* Analyseur syntaxique *)

let rec Gram1 lexFlot = 
  let e1=Gram2 lexFlot in
  match lexFlot with
  | [< 'PLUS ; Gram1 e2 >] -> Addition (e1,e2)
  | [<>] -> e1
and Gram2 lexFlot =
  let e1=Gram3 lexFlot in
  match lexFlot with
  | [< 'MULT ; Gram2 e2 >] -> Multiplication (e1,e2)
  | [<>] -> e1
and Gram3 = function
  | [< 'EXP ; Gram4 e >] -> Exponentielle (e)
  | [< Gram4 e >] -> e
and Gram4 = function
  | [< 'PARO ; Gram1 e ; 'PARF >] -> e
  | [< 'CST n >] -> Constante n
  | [< 'VAR s >] -> Variable s;;
 
let Analyse string = Gram1 (LexemesFlot_of_string string);;


#Analyse  "exp(x+1)";;
- : expression = Exponentielle 
                   (Addition (Variable "x", Constante 1))
#Analyse "x*(y+1)+2";;
- : expression =
 Addition
  (Multiplication 
       (Variable "x", Addition (Variable "y", Constante 1)),
        Constante 2)
#Analyse "x_1+y*567*z";;
- : expression =
 Addition
  (Variable "x_1",
   Multiplication
    (Variable "y", Multiplication (Constante 567, Variable "z")))


let rec fact = function                          
    | 0 -> 1                                     
    | n -> n*fact (n-1);;                        
                                                                                                  
print_newline ();                                
print_string "Entrez un entier naturel :";       
print_int (fact (int_of_string (read_line ()))); 
print_newline ();;                               


#compile "d:/test.ml";;
- : unit = ()
#load_object "d:/test.zo";;

Entrez un entier naturel :10
3628800
- : unit = ()



#hd [];;
Exception non rattrapŽe: Failure "hd"


#1/(2-2);;
Exception non rattrapŽe: Division_by_zero
#index "luc" ["pierre";"paul";"luc";"jean"];;
- : int = 2
#index "luc" ["pierre";"paul";"jacques";"jean"];;
Exception non rattrapŽe: Not_found


#let v = [|"pierre";"paul";"luc";"jean"|];;
v : string vect = [|"pierre"; "paul"; "luc"; "jean"|]
#v.(1);;
- : string = "paul"
#v.(5);;
Exception non rattrapŽe: Invalid_argument "vect_item"


let hd = function
    | []  -> raise (Failure "hd")
    | a::l -> a;;


#let rec fact  n = 
    if n >= 0
    then if n=0 then 1 else n* fact(n-1)
    else raise (Invalid_argument "n positif, SVP !");; 
fact : int -> int = <fun>
#fact 5;;
- : int = 120
#fact (-3);;
Exception non rattrapŽe: Invalid_argument "n positif, SVP !"


let hd = function
    | []  -> failwith "hd"
    | a::l -> a;;


#Division_by_zero;;
- : exn = Division_by_zero


#exception Division_par_zero;;
L'exception Division_par_zero est dŽfinie.
#let ma_division n = fun
    | 0 -> raise Division_par_zero
    | m -> n/m;;
ma_division : int -> int -> int = <fun>
#ma_division 8 4;;
- : int = 2
#ma_division 5 0;;
Exception non rattrapŽe: Division_par_zero



#exception Argument_non_valide of float;;
L'exception Argument_non_valide est dŽfinie.
#let mon_log x =
   if x <. 0.
   then raise (Argument_non_valide x)
   else log x;;

mon_log : float -> float = <fun>
#mon_log 2.;;
- : float = 0.69314718056
#mon_log (-2.);;
Exception non rattrapŽe: Argument_non_valide -2.0


#1073741823;;
- : int = 1073741823
#1073741823+1;;
- : int = -1073741824


#fact 12;;
- : int = 479001600
#fact 13;;
- : int = -215430144


#exception Depassement_sur_les_entiers;;
L'exception Depassement_sur_les_entiers est dŽfinie.
#let fact n =
   if n <0 
   then  raise (Invalid_argument "n positif, SVP !")
   else
   let res = ref 1 in
      for i=1 to n do
        begin
          res:= !res*i;
          if !res < 0 then raise Depassement_sur_les_entiers   
        end
      done;
    !res;;
fact : int -> int = <fun>
#fact 12;;
- : int = 479001600
#fact 13;;
Exception non rattrapŽe: Depassement_sur_les_entiers
#fact (-2);;
Exception non rattrapŽe: Invalid_argument "n positif, SVP !"


#let binomial n p = 
     try 
 string_of_int ((fact n)/( (fact p) * (fact (n-p)) ))
     with  
  Invalid_argument s ->  "Calcul de factoriel impossible"
| Depassement_sur_les_entiers -> "DŽpassement dans factoriel";;
binomial : int -> int -> string = <fun>
#binomial 4 2;;
- : string = "6"
#binomial 2 4;;
- : string = "Calcul de factoriel impossible"
#binomial 15 14;;
- : string = "DŽpassement dans factoriel"


let rec minlist = function
    | [] -> failwith "liste_vide"
    | [a] -> a
    | a::r -> min a (minlist r);;


let rec detecte = function
    | [] -> failwith "liste_vide"
    | a::r -> if a < (-3000) 
              then failwith "interdit_bancaire" 
              else	r<> [] && detecte r;;


let bilan_annuel liste_des_decouverts =
  try
    detecte  liste_des_decouverts ;
    "�a passe"
(* on est dans ce cas si minlist n'a pas dŽclenchŽ d'exceptions *)
  with Failure "liste_vide" -> "bon_client" 
     | Failure s -> s;; 



type 'a option = None | Some of 'a;; 


#let rec minlist = function
    | []   -> None
    | [a]  -> Some a
    | a::r -> min (Some a) (minlist r);;

minlist : 'a list -> 'a option = <fun>
#minlist [1;2;6;-3;10];;
- : int option = Some -3
#minlist [];;
- : '_a option = None


#let rec fact  = fun 
     | 0 -> 1.
     | n -> n* fact (n-1);;
EntrŽe interactive:
>     | n -> n* fact (n-1);;
>            ^^^^^^^^^^^^^
Cette expression est de type int,
mais est utilisŽe avec le type float.


#let rec fact = fun
    | 0 -> 1
    | n -> n * fact (n-1)
    | 1 -> 1;;
EntrŽe interactive:
>    | 1 -> 1;;
>      ^
Attention: ce cas de filtrage est inutile.
fact : int -> int = <fun>


#let rec f =  fun x ->     
    if x = 0 then f true else f (x-1);;  
EntrŽe interactive:
>    if x = 0 then f true else f (x-1);;  
>                                 ^^^
Cette expression est de type int,
mais est utilisŽe avec le type bool.


#let rec (f:int->int) = fun x->
      if x =0 then f true else f (x-1);;
EntrŽe interactive:
>      if x =0 then f true else f (x-1);;
>                     ^^^^
Cette expression est de type bool,
mais est utilisŽe avec le type int.


let rec fact = fun
    | 0 -> 1
    | n -> n * fact(n-1);;


#trace "fact";;
La fonction fact est dorŽnavant tracŽe.
- : unit = ()
#fact (-2);;
fact <-- -2
fact <-- -3
fact <-- -4
fact <-- -5
fact <-- -6
fact <-- -7
fact <-- -8
fact <-- -9
fact <-- -10
fact <-- -11
fact <-- -12
...
Interruption.



#let rec minlist = function
    | [] -> failwith "liste_vide"
    | [a] -> a
    | a::r -> min a (minlist r);;

minlist : 'a list -> 'a = <fun>
#trace "minlist";;
La fonction minlist est dorŽnavant tracŽe.
- : unit = ()
#minlist [-2;0;-4;1];;
minlist <-- [<poly>; <poly>; <poly>; <poly>]
minlist <-- [<poly>; <poly>; <poly>]
minlist <-- [<poly>; <poly>]
minlist <-- [<poly>]
minlist --> <poly>
minlist --> <poly>
minlist --> <poly>
minlist --> <poly>
- : int = -4


#let rec (minlist:int list->int) = function
    | [] -> failwith "liste_vide"
    | [a] -> a
    | a::r -> min a (minlist r);;
minlist : int list -> int = <fun>
#trace "minlist";;
La fonction minlist est dorŽnavant tracŽe.
- : unit = ()
#minlist [-2;0;-4;1];;
minlist <-- [-2; 0; -4; 1]
minlist <-- [0; -4; 1]
minlist <-- [-4; 1]
minlist <-- [1]
minlist --> 1
minlist --> -4
minlist --> -4
minlist --> -4
- : int = -4


#let transpose m = 
    let q = make_vect 3 (make_vect  3 0) in
            for i = 0 to 2 do
                for j = 0 to 2 do
                    q.(j).(i) <- m.(i).(j) 
                done 
             done;
    q;;
transpose : int vect vect -> int vect vect = <fun>


#transpose  
[|  [| 1; 2; 3 |];
    [| 0; 1; 2 |];
    [| 0; 0; 1 |] |];; 
- : int vect vect = 
[|  [| 3; 2; 1 |]; 
    [| 3; 2; 1 |];
    [| 3; 2; 1 |] |]


#let transpose m = 
  let q = make_vect 3 (make_vect  3 0) in
(* on initialise par la matrice nulle *)
    for i = 0 to 2 do
      for j = 0 to 2 do
        q.(j).(i) <- m.(i).(j); 
        print_newline ();
        printf__printf "la valeur de q(%d,%d) est %d" j i q.(j).(i);
        print_newline ();
        printf__printf "la valeur de m(%d,%d) est %d" i j m.(i).(j)
      done 
     done;;

transpose : int vect vect -> unit = <fun>
#transpose  
[|  [| 1; 2; 3 |];
    [| 0; 1; 2 |];
    [| 0; 0; 1 |] |];; 

la valeur de q(0,0) est 1
la valeur de m(0,0) est 1
la valeur de q(1,0) est 2
la valeur de m(0,1) est 2
la valeur de q(2,0) est 3
la valeur de m(0,2) est 3
la valeur de q(0,1) est 0
la valeur de m(1,0) est 0
la valeur de q(1,1) est 1
la valeur de m(1,1) est 1
la valeur de q(2,1) est 2
la valeur de m(1,2) est 2
la valeur de q(0,2) est 0
la valeur de m(2,0) est 0
la valeur de q(1,2) est 0
la valeur de m(2,1) est 0
la valeur de q(2,2) est 1
la valeur de m(2,2) est 1- : unit = ()


...
let une_col = make_vect 3 0 in
    let q = make_vect 3 une_col in
        for i = 0 to ...


##open "graphics";;
#open_graph "";;
- : unit = ()
#let xmax = (size_x ())-1 and ymax = size_y () -1;;
xmax : int = 479
ymax : int = 279
#draw_circle (xmax/4) (ymax/4) (min (xmax/4) (ymax/4));;
- : unit = ()
#set_color red;;
- : unit = ()
#fill_rect (xmax/2) (ymax/2) xmax ymax;; 
- : unit = ()
#set_color black;;
- : unit = ()
#moveto (xmax/2) 0;lineto (3*xmax/4) (ymax/4); lineto xmax 0;;
- : unit = ()


#open "graphics";;
open_graph "";;

(* la taille de la fen�tre par defaut *)
let w=float_of_int (size_x ());;
let h=float_of_int (size_y ());;

(* la fonction *)     
let f x =
 (sin x) /. x;;
    
(* l'intervalle d'Žtude *)
let a=(-15.);;
let b=15.;;

(* le nombre de points d'interpolation *)
let n=100;;

(* le pas suivant x *)
let pas = (b-.a)/.(float_of_int (n-1));;

(* les valeurs de f *)     
let v = make_vect n 0.0;;

(* init_valeurs calcule de plus les max et min de f *)    
let init_valeurs () =
  v.(0) <- (f a);
  let fmax = ref (v.(0)) and fmin = ref (v.(0)) in
  let x= ref a in
    for i=1 to (n-1) do
      x:= !x +. pas;
      v.(i) <- (f !x);
      if v.(i) > !fmax then fmax:=v.(i);
      if v.(i) < !fmin then fmin:=v.(i)
    done;   
    if (!fmin = !fmax)
    then (!fmin -. 1., !fmax +. 1.)
(* cas d'une fonction constante *)
    else (!fmin,!fmax);;
     
    
(* on place le graphe de f dans la fenetre en  *)
(* laissant une marge de 10% *)

let dilatation () =
     let (ymin,ymax) = init_valeurs () in
     let coefx = (b -. a) /. (0.9 *. w) and
         coefy = (ymax -. ymin) /. (0.9 *. h) in   
     let decal_x= 0.05 *. w  and
         decal_y= 0.05 *. h -. ymin /. coefy in
     (coefx,coefy,decal_x,decal_y);;

let trace_fonction () =
     clear_graph ();
     let (coefx,coefy,decal_x,decal_y) = dilatation () in
     moveto (int_of_float decal_x)
            (int_of_float (decal_y +. v.(0) /. coefy));
     for i=1 to (n-1) do
     lineto (int_of_float (decal_x +. (float_of_int i) *. pas /. coefx))
            (int_of_float (decal_y +. v.(i) /. coefy ))   
     done;;



let rec miroir_aux accu = fun
        | [] -> accu
        | (a::suite) -> miroir_aux (a::accu) suite;;
let miroir l = miroir_aux [] l;;  


#miroir_aux [3;2;1] [6;7;8];;
- : int list = [8; 7; 6; 3; 2; 1]
#miroir [1;2;3];;
- : int list = [3; 2; 1]


let rec miroir_naif = function
    | [] -> []
    | a::r -> (miroir_naif r) @ [a];;


#change 1790 [500;200;100;50;10];;
- : int list = [500; 500; 500; 200; 50; 10; 10; 10; 10]


type couleur = Rouge | Blanc | Bleu;;


#une_passe 
[Blanc ; Bleu ; Rouge ; Bleu; Bleu ; Blanc; Rouge; Bleu; Rouge];;
- : couleur list * bool =
[Blanc; Rouge; Bleu; Bleu; Blanc; Bleu; Rouge; Rouge; Bleu], true


let n = 100;;
let grille =  make_vect (n+1) true;;
let crible n v p =
...;;
let eratosthene () =
  let res = ref [] in
   crible n grille 2;
   crible n grille 3;
   crible n grille 5;
   crible n grille 7; 
   for i = 2 to n do
       if grille.(i) then res:= i::!res
   done;
   !res;;


let th x =
  let exp2 = exp (2. *. x) in 
    (exp2 -. 1.)/. (exp2 +. 1.);;



let rec Mult = fun
   | n 0 -> 0
   | n p -> n + Mult n (p-1);;


#Mult 3 4;;
- : int = 12
##infix "Mult";;
#3 Mult 4;;
- : int = 12


let inferieur_lexico (x1,y1) (x2,y2) = 
          (x1<x2) || ((x1=x2) && (y1<=y2));;


let rec inferieur_lexico l1 l2 = match (l1,l2) with
   | [], _ -> failwith "Comparaison impossible"
   | _, [] -> failwith "Comparaison impossible"
   | (a::r,b::s) -> (a<b) || ((a=b) && (inferieur_lexico r s));;


let miroir l =
    let accumulateur = ref [] in
    let lref = ref l in
    while !lref <> [] do
       accumulateur := (hd !lref)::(!accumulateur);
       lref:= tl (!lref)
    done;
    !accumulateur;;


let renverse n = 
   if n<10 then n 
   else let s = string_of_int n and res= ref "" in 
        for i=(string_length s) -1 downto 0 do
           res:=(!res)^(char_for_read s.[i]) 
        done; 
        int_of_string(!res);;


let palindrome n = (n = (renverse n));;


let rec change s liste_billets = match (s,liste_billets) with
    | (0, _) -> []
    | (_,[]) -> failwith "Je ne peux pas faire de change"
    | (s, n::r) -> if s >= n 
                   then n::(change (s-n) (n::liste_billets))
                   else change s r;;  



let dirac x = diracx where diracx y = if (x=y) then 1. else 0.;;


#let dirac_3 = dirac 3.;;
dirac_3 : float -> float = <fun>
#dirac_3 (0.);;
- : float = 0.0
#dirac_3 (5.);;
- : float = 0.0
#dirac_3 (3.);;
- : float = 1.0


let produit n m =
    let res = ref n in
       for i=n+1 to m do
         res := !res*i
       done;
    !res;;


let binomial n p = 
    if (n-p>p) 
    then  (produit (n-p+1) n)/ (fact p) 
    else  (produit (p+1) n)  / (fact (n-p));;


let rec binomial n = function
  | 0 -> 1 
  | p -> n*(binomial (n-1) (p-1))/p;;


let binomial n p = 
   if p>n then 0 
   else binomial_aux n (min p (n-p))
          where rec binomial_aux n = fun
         | 0  -> 1
         | p -> n*(binomial_aux (n-1) (p-1))/p;;


(* marche alŽatoire linŽaire *)
let hasard = random__int;;


let deplace position = match (hasard 2) with
   | 0 -> decr position; !position
   | 1 -> incr position; !position;;
	
let marche_alŽatoire_axe n =
   let position = ref 0 in
   let retour_origine = ref 0 in
   let position_droite = ref 0 in
     for i=1 to n do
       position := deplace position;
       if !position > !position_droite
       then position_droite := !position;
       if !position = 0 
       then incr retour_origine
     done;
	(!position, !position_droite, !retour_origine);;
	
	
(* marche alŽatoire planaire *)

let deplace (x,y) = match (hasard 4) with
   | 0 -> decr x; (x,y)
   | 1 -> incr x; (x,y)
   | 2 -> decr y; (x,y)
   | 3 -> incr y; (x,y);;

let non_origine (position_x,position_y) =
   (!position_x <> 0) || (!position_y <> 0);;

let marche_alŽatoire_plane n =
(* n doit �tre supŽrieur ou Žgal ˆ 1 *)
   let position = ref (ref 0, ref 0) in
   let nombre_pas = ref 0 in
(* il faut exŽcuter la boucle qui suit une fois *)
   position := deplace !position;
   incr nombre_pas;
   while (non_origine !position) && (!nombre_pas <= n)  do
    position := deplace !position;
    incr nombre_pas
   done;
   if (not (non_origine !position))
   then begin 
        print_string "Retour ˆ l'origine au bout de ";
        print_int !nombre_pas; print_string " pas."
        end
   else begin 
        print_string "Pas de retour ˆ l'origine au bout de ";
        print_int n; print_string " pas."
        end;;


let rec itere f = fun
   | 0 -> (function x -> x)
   | 1 -> f
   | n -> f  (itere f (n-1));;



type cartes = Sept | Huit | Neuf | Dix | Valet | Dame | Roi | As;;

let rec valeur_main = function
   | [] -> 0
   | Valet::r -> 1 + valeur_main r
   | Dame::r  -> 2 + valeur_main r
   | Roi::r   -> 3 + valeur_main r
   | f::r     -> valeur_main r;;


let rec une_passe = function
    | [] -> [],false
    | (Blanc::Rouge::r) -> let l,b = une_passe r in Rouge::Blanc::l,true
    | (Bleu::Rouge::r)  -> let l,b = une_passe r in Rouge::Bleu::l,true
    | (Bleu::Blanc::r)  -> let l,b = une_passe r in Blanc::Bleu::l,true
    | x::r -> let l,b = une_passe r in x::l,b;;

let rec drapeau_hollandais l =
    let l',modifiŽe = une_passe l in
    if modifiŽe then drapeau_hollandais l' else l;;


let rec charlist_of_string s =
	let result= ref [] in
		for i=((string_length s)-1) downto 0 do
			result := (nth_char s i)::(!result) done;
	 !result;;
										 
let  contient  c s = 
	mem c (charlist_of_string s);;

let fizzbuzz_aux n = 
	if (n mod 35) = 0 then 35
	else if (n mod 5)=0 then 5
		 else if (n mod 7)=0 or (contient `7` (string_of_int n)) then 7 
			  else 0;;

let fizzbuzz n = match (fizzbuzz_aux n) with
	| 35 -> print_string "fizzbuzz" 
	| 5  -> print_string "buzz" 
	| 7  -> print_string "fizz" 
	| _  -> print_int n;;

let list_fizzbuzz n =
	for i = 1 to n do print_newline(); fizzbuzz i done;;


let crible n v p =
  for i= p to (n/p) do
    v.(p*i) <- false
  done;;


#list_length (eratosthene ());;
- : int = 25


crible n grille 11;
crible n grille 13;


let eratosthene  n =
  let grille =  make_vect (n+1) true in 
     crible n grille 2;
     let i = ref 3 in
     while (!i*(!i) <= n) do
       if grille.(!i) then crible n grille !i; i:= !i+2
     done;
   let res = ref [] in
     for i = 2 to n do
       if grille.(i) then res := i::!res 
     done;
  !res;;


 let rec intervalle n m =
   if m < n then []
   else n :: (intervalle (n+1) m);;



let intervalle n m =
    let accu= ref [] in
        for i =m downto n do
            accu := i :: !accu 
        done;
    !accu ;;


let rec recurseur z f = function 
   0 -> z
 | n -> f (n-1) (recurseur z f (n-1));;
let intervalle n m = 
    recurseur [] (fun k reste -> (m-k)::reste) (m-n+1);;


let eratosthene n =
    eratosthene_aux [] (intervalle 2 n)
    where rec eratosthene_aux liste_premiers = function
      | [] -> liste_premiers
      | p::reste -> eratosthene_aux (p::liste_premiers) 
                                    (crible p reste);;


let rec crible p  = function
   | [] -> []
   | n::r -> let reste = crible p r in
             if n mod p =0 then reste else n::reste;;


#open "graphics";;

open_graph "260x260";;

(*  niveau d'imbrication *)
let n=6;;

let rec dessin x y l n =
if n>0 then  begin
lineto (int_of_float (x +. l /. 2.))  (int_of_float y);
lineto (int_of_float (x +. l /. 4.))  (int_of_float (y +. l /. 4.));
dessin (x +. l /. 4.)  (y +. l /. 4.)  (l /. 2.) (n-1);
lineto (int_of_float x) (int_of_float (y +. l /. 2.));
lineto (int_of_float (x +. l /. 2.)) (int_of_float (y +. l));
lineto (int_of_float (x +. l)) (int_of_float (y +. l /. 2.));
lineto (int_of_float (x +. l /. 2.)) (int_of_float y);
lineto (int_of_float (x +. l)) (int_of_float y);
lineto (int_of_float (x +. l)) (int_of_float (y +. l));
lineto (int_of_float x) (int_of_float (y +. l));
lineto (int_of_float x) (int_of_float y)
end;;

let carres_imbriques () =
   moveto 10 10;
   dessin 10. 10. 240. n;;



*****************************
* chap2
*****************************


let rec somme n = 
    if n = 0 then 0 else n + somme (n-1);;


somme 3
3 + somme 2
3 + (2 + somme 1)
3 + (2 + (1 + somme 0))
3 + (2 + (1 + 0))
3 + (2 + 1)
3 + 3
6


#trace "somme";;
La fonction somme est dorŽnavant tracŽe.
- : unit = ()
#somme 3;;
somme <-- 3
somme <-- 2
somme <-- 1
somme <-- 0
somme --> 0
somme --> 1
somme --> 3
somme --> 6
- : int = 6


[18;3;10;25;9;3;11;13;23;8]


let rec tri_rapide  = function
  |  []    -> []
  |  [e]   -> [e]
  |  e::r  -> let l1,l2 = partition  e r in
              (tri_rapide l1)@(e::(tri_rapide l2));;


#let rec partition (e:int)  = function
		|	[] -> ([], [])
		| d::r -> let l1,l2 = partition e r in 
			if (d < e) then (d::l1,l2) else (l1,d::l2);;
partition : int -> int list -> int list * int list = <fun>
#partition 18 [3;10;25;9;3;11;13;23;8];;
- : int list * int list = [3; 10; 9; 3; 11; 13; 8], [25; 23]


#trace "tri_rapide";;
La fonction tri_rapide est dorŽnavant tracŽe.
- : unit = ()
#tri_rapide [3;4;2;1;5];;
tri_rapide <-- [3; 4; 2; 1; 5]
tri_rapide <-- [4; 5]
tri_rapide <-- [5]
tri_rapide --> [5]
tri_rapide <-- []
tri_rapide --> []
tri_rapide --> [4; 5]
tri_rapide <-- [2; 1]
tri_rapide <-- []
tri_rapide --> []
tri_rapide <-- [1]
tri_rapide --> [1]
tri_rapide --> [1; 2]
tri_rapide --> [1; 2; 3; 4; 5]
- : int list = [1; 2; 3; 4; 5]


let rec binome = function
    | (n,0) -> 1
    | (n,p) -> if (p>n) 
               then 0 
               else binome ((n-1),p) + binome ((n-1),(p-1));; 


let rec ackermann  = fun
	   | 0 p -> p+1 
	   | n 0 -> ackermann (n-1)  1
	   | n p -> ackermann (n-1) (ackermann n (p-1));;


#ackermann 1 1;;
- : int = 3
#ackermann 2 3;;
- : int = 9
#ackermann 3 7;;
- : int = 1021


let rec morris = fun
    | 0 _ -> 1 
    |	 _  -> morris (m-1) (morris m n);;	


let rec collatz n = 
   if  n<= 0 then invalid_arg "n>0 SVP" 
   else  (n>1) && if (impair n)  
                  then collatz (3*n + 1)
  	               else collatz (n quo 2);;


let rec sans_fin x = if x then sans_fin x else false;;


let rec test () = if (termine test) then (test ()) else true;;


let rec hanoi n dŽpart intermŽdiaire arrivŽe =
    if n>0 then begin
       hanoi (n-1) dŽpart arrivŽe intermŽdiaire;
       deplace dŽpart arrivŽe;
       hanoi (n-1) intermŽdiaire dŽpart arrivŽe
    end;;


let deplace piquet1 piquet2 =
    print_newline ();
    print_string "la rondelle au sommet de ";
    print_string piquet1;
    print_string " est placŽe sur ";
    print_string piquet2;;


#hanoi 3 "A" "B" "C";;

la rondelle au sommet de A est placŽe sur C
la rondelle au sommet de A est placŽe sur B
la rondelle au sommet de C est placŽe sur B
la rondelle au sommet de A est placŽe sur C
la rondelle au sommet de B est placŽe sur A
la rondelle au sommet de B est placŽe sur C
la rondelle au sommet de A est placŽe sur C
- : unit = ()


let rec a = function
    | 0 -> a0 (* valeur initiale *)
    | n -> (a(n-1) +. g(n-1))/. 2.
	and g = function
    | 0 -> g0 (* valeur initale *)
    | n -> sqrt( a(n-1) *. g(n-1));;


#let rec tic() = print_string "tic "; tac()
     and tac() = print_string "tac "; tic();;
#tic ();;


#let somme n =
	    let resultat = ref 0 in
	       for i = 1 to n do
	          resultat := !resultat + i
		      done;
	!resultat;;


let f n =
  let x = ref n and y = ref n in
     while not(!y=0) do
       x:= !x + 2;
       y:= !y -1
     done;
  !x;;


let rec somme n =                         let rec fact n =
    if n = 0                                  if n = 1
    then 0                                    then 0
    else n + somme (n-1);;                    else n * fact (n-1);;

let somme n =                             let fact n =
    let r = ref 0 in                          let r = ref 1 in
      for i = 1 to n do                         for i = 1 to n do
        r := !r + i                               r := !r * i
      done;                                     done;
    !r;;                                      !r;;


let rec puissance a  = function
    | 0 -> 1
    | n -> a * puissance a (n-1);;


let puissance a n = 
    if n =0 then 1
    else let y=ref n and resultat = ref a in
           while (!y > 1) do
             resultat := a * !resultat;
             y:= !y-1
           done;
           ! resultat;;


let puissance a n =
    let r = ref 1 in
       for i=1 to n do
         r:=a*!r 
       done;
    !r;;


let puissance a n =
    let r= ref 1 and base2 = ref n and carrŽ = ref a in
    while (!base2 >0) do
          if (!base2 mod 2 = 1)
          then r := !r * !carrŽ;
          base2 := !base2 / 2;
          carrŽ := !carrŽ * !carrŽ
    done;
    !r;;


let rec puissance a  = function
    | 0 -> 1 
    | n -> let r= puissance_rapide a (n / 2) in
                  if (n mod 2)=0 then r*r else a*r*r;;


let rec fib = function
     | 0 -> 0 
     | 1 -> 1 
     | n ->  fib (n-2) +  fib (n-1);;


#fib 5;;
fib <-- 5
fib <-- 4
fib <-- 3
fib <-- 2
fib <-- 1
fib --> 1
fib <-- 0
fib --> 0
fib --> 1
fib <-- 1
fib --> 1
fib --> 2
fib <-- 2
fib <-- 1
fib --> 1
fib <-- 0
fib --> 0
fib --> 1
fib --> 3
fib <-- 3
fib <-- 2
fib <-- 1
fib --> 1
fib <-- 0
fib --> 0
fib --> 1
fib <-- 1
fib --> 1
fib --> 2
fib --> 5
- : int = 5


let fib n =
 let pred = ref 0 and succ = ref 1 and aux =ref 0 in
   	for i = 2 to n do  
      aux  := !pred;
      pred := !succ;
      succ := !succ + !aux 
    done;
  if n<= 1 then n else !succ;;


let rec fib_aux = fun
     | 0 -> (1,0)
     | n ->  f (fib_aux (n-1))
where f(x,y) = (x+y,x);;

let fib n =  snd (fib_aux n);;


let fib n = 
	   let f(x,y) = (x+y,x) and  v=ref (1,0) in
	     for k=1 to n do
		       v:=f(!v) 
      done;
	   snd !v;;


let fib n =
snd(boucle_inconditionnelle n (fun (x,y) -> (x+y,x)) (1,0));;


let mult a b =
    [|
      a.(0)*b.(0)+a.(1)*b.(2);
      a.(0)*b.(1)+a.(1)*b.(3);
      a.(2)*b.(0)+a.(3)*b.(2);
      a.(2)*b.(1)+a.(3)*b.(3);
    |];;


let rec puissance_matrice2x2 m  = function
 | 0 ->  [|1;0;0;1|] (* l'identitŽ *)
 | n ->  let moitiŽ = puissance_matrice2x2 m (n / 2) in
               if (n mod 2)=0 
               then (mult moitiŽ moitiŽ)
               else (mult m (mult moitiŽ moitiŽ));;

let puissance_matrice2x2 m n =
    let rŽsultat = ref [|1;0;0;1|] (* l'identitŽ *)
        and base2 = ref n and carrŽ = ref m in
    while (!base2 >0) do
          if (!base2 mod 2 = 1)
          then rŽsultat := mult !rŽsultat  !carrŽ;
          base2 := !base2 / 2;
          carrŽ := mult !carrŽ !carrŽ
    done;
    !rŽsultat;;

let fib n =
   if n<2 then n else
   (puissance_matrice2x2 [|1;1;1;0|] (n-1)).(0);;
(* on prend le coefficient A11 de la matrice *)


let rec tri_selection = function
    | [] -> []
    | l  -> let (m,r) = (minimum_et_reste l) in 
                         m::(tri_selection r);;


#minimum_et_reste [5;4;8;2;6;7;7;2;9];;
- : int * int list = 2, [5; 4; 8; 2; 6; 7; 7; 9]


J'ins�re 9 dans  []
         ce qui donne [9]
J'ins�re 2 dans  [9]
         ce qui donne [2; 9] 
J'ins�re 7 dans  [2; 9]
         ce qui donne [2; 7; 9]
J'ins�re 7 dans  [2; 7; 9]
         ce qui donne [2; 7; 7; 9]
J'ins�re 6 dans  [2; 7; 7; 9]
         ce qui donne [2; 6; 7; 7; 9]
J'ins�re 2 dans  [2; 6; 7; 7; 9]
         ce qui donne [2; 2; 6; 7; 7; 9]
J'ins�re 8 dans  [2; 2; 6; 7; 7; 9]
         ce qui donne [2; 2; 6; 7; 7; 8; 9]
J'ins�re 4 dans  [2; 2; 6; 7; 7; 8; 9]
         ce qui donne [2; 2; 4; 6; 7; 7; 8; 9]
J'ins�re 5 dans  [2; 2; 4; 6; 7; 7; 8; 9]
         ce qui donne  [2; 2; 4; 5; 6; 7; 7; 8; 9]


On effectue une passe sur la liste : [5; 4; 8; 2; 6; 7; 7; 2; 9]
               ce qui donne pour l : [2; 5; 4; 8; 2; 6; 7; 7; 9]
On effectue une passe sur la liste : [5; 4; 8; 2; 6; 7; 7; 9]
               ce qui donne pour l : [2; 2; 5; 4; 8; 6; 7; 7; 9]
On effectue une passe sur la liste : [5; 4; 8; 6; 7; 7; 9]
               ce qui donne pour l : [2; 2; 4; 5; 6; 8; 7; 7; 9]
On effectue une passe sur la liste : [5; 6; 8; 7; 7; 9]
               ce qui donne pour l : [2; 2; 4; 5; 6; 7; 8; 7; 9]
On effectue une passe sur la liste : [6; 7; 8; 7; 9]
               ce qui donne pour l : [2; 2; 4; 5; 6; 7; 7; 8; 9]
On effectue une passe sur la liste : [7; 7; 8; 9]
Ce qui donne  [2; 2; 4; 5; 6; 7; 7; 8; 9]


#une_passe [5; 4; 8; 2; 6; 7; 7; 2; 9];;
- : bool * int list = true, [2; 5; 4; 8; 2; 6; 7; 7; 9]
#une_passe [7; 7; 8; 9];;
- : bool * int list = false, [7; 7; 8; 9]


#divise [5; 4; 8; 2; 6; 7; 7; 2; 9];;
- : int list * int list = [5; 8; 6; 7; 9], [4; 2; 7; 2]


#fusion [5; 6; 7; 8;9] [2; 2; 4; 7];;
- : int list = [2; 2; 4; 5; 6; 7; 7; 8; 9]


let tri_fusion v = 
	let n = (vect_length v) in
	let aux =  make_vect n 0 in 
	tri v 0 (n-1) aux
	where rec tri v i j aux =  
	 if j>i then
             begin
               let m=(i+j)/2 in
                  tri v i m aux; 
                  tri v (m+1) j aux;
                  fusion v i j aux
             end;;


#fusion;;
- : 'a vect -> int -> int -> 'a vect -> unit = <fun>


let rec u n = 
   if n=0 then 0 else n - u (n-1);;


let rec v n = 
   if n=0 then 1 else n-v(v(n-1));;


let rec f n = 
    if n>100 
    then n-10 
    else f (f (n+11));;


#inversion [2;5;3;8;11;10;0;8];;
- : bool = true
#inversion [2;5;3;8;11;12;0;8];;
- : bool = false


let rec pair n = match n with
    | 0 -> true
	   | n -> impair (n-1)
and impair n = match n with
    | 0 -> false
    | n-> pair (n-1);;


let f x y = 
    let r = ref 0 and s = ref y in
        while (!s >0) do
          r:= !r + x;
          s:= !s -1
        done;
    s:= y -1;
    let t = ref !r in
        while (!s>0) do
          r:= !r + !t;
          s:= !s -1
        done;
    !r;;




let flocon n =
(* n reprŽsente la profondeur de la rŽcursion *) 
   clear_graph ();
(* on se place en l'origine du dessin *)
   moveto 100 100;
(* puis on trace les trois c™tŽs du flocon  *) 
   c™tŽ 0.0 100. n;
   c™tŽ ((2. *. pi) /. 3.) 100. n;
   c™tŽ (-.((2. *. pi) /. 3.)) 100. n;;


#isole 1 ["chevre"; "chou"; "loup"];;
- : string * string list = "chou", ["chevre"; "loup"]


#ins�re "chou" ["chevre"; "loup"];;
- : string list = ["chevre"; "chou"; "loup"]


rive1_ˆ_2 [(1,["chevre";"chou";"loup"],[])];;


let rec horner P x = match P with
  | [] -> 0.
  | a::r -> a +. x *. (horner r x);;


let rec minimum_et_reste = function
    | [x] ->(x,[])
    | x1::r1 -> let (m2,l2) = (minimum_et_reste r1) in
                if x1<m2 then (x1,m2::l2) else (m2,x1::l2);;


let echange i j v = 
    let t = v.(i) in  
      begin
        v.(i) <- v.(j);
        v.(j) <- t
      end;;


let minimum a b v = 
	let mini = ref a in
	   for i = a to b  do
      if v.(i) < v.(!mini)
      then mini:=i 
    done;
	!mini;;
	 
let tri_selection_vect v = 
	let N = vect_length v and minimum_temporaire = ref 0 in
	  for i=0 to N-1 do 
	     minimum_temporaire := minimum i (N-1) v;
	     echange !minimum_temporaire i v
	  done;
	v;;


let rec insere element = function
    | [] -> [element]
    | x::reste -> if element <= x 
                  then element::x::reste 
                  else x::(insere element reste);;


let rec tri_insertion = function
    | [] -> []
    | x::reste -> insere x (tri_insertion reste);;


let lexico (x1,y1) (x2,y2) = (x1<x2) or ((x1=x2) & (y1<=y2));;


let rec insere_generalise ordre element = function
  | [] -> [element]
  |	x::reste -> if (ordre element x)
                then element::x::reste 
                else x::(insere_generalise ordre element reste);;
	
let rec tri_insertion_generalise ordre = function
  | [] -> []
  | x::reste -> insere_generalise ordre x 
                   (tri_insertion_generalise ordre reste);;


#let lc=[(12,10);(3,2);(3,1);(0,0);(10,5);(11,1);(10,6);(1,2)];;
#tri_insertion_generalise lexico lc;;
- : (int * int) list = 
         [0, 0; 1, 2; 3, 1; 3, 2; 10, 5; 10, 6; 11, 1; 12, 10]


let insere_element v i =
	let j=ref i and e=v.(i) in
 	  while (!j>0) & (v.(!j-1) > e) do
 	        v.(!j) <- v.(!j-1) ; j:=!j-1 
    done;
	 v.(!j) <-e;;

let tri_insertion_vect v = 
	for i=1 to (vect_length v)-1 do
	    insere_element v i
	done;;


let rec une_passe  = function
  | [(x:int)] -> false,[x]
  | x::reste  -> let bool,res = (une_passe reste) in 
                   if x<=(hd res) 
                   then bool,x::res 
                   else true,(hd res)::x::(tl res);;

let rec tri_bulle  = function
  | [] -> []
  | l -> let (modifiee, liste) = une_passe l in
           if modifiee 
           then (hd liste)::(tri_bulle (tl liste))
           else liste;;


let une_passe_vect fin v = 
  let modifiŽ = ref false in
      for j=1 to fin do
        if v.(j-1) > v.(j) 
        then begin 
             echange (j-1) j v;
             modifiŽ := true 
             end
      done;
  !modifiŽ;;
	
let tri_bulle_vect v =
  let i = ref ((vect_length v)-1) in 
     while (!i>=0)  && (une_passe_vect !i v) do
       decr i
     done;;


let rec divise = function
    | [] -> ([],[])
    | [e] -> ([e],[])
    | a::b::r -> let (m1,m2) = divise r in
                 (a::m1,b::m2);;


let rec fusion = fun
    | l [] -> l
    | [] l -> l
    | (a::r as l1) (b::s as l2) -> if a<b
                                   then a::(fusion r l2)
                                   else b::(fusion l1 s);;


let rec tri_fusion = fun
    | [] -> []
    | [e] -> [e]
    | l -> let (m1,m2) = divise l in
           fusion (tri_fusion m1) (tri_fusion m2);; 


let fusion v debut fin aux = 
	let m = (debut+fin)/2 and i=ref debut in let j=ref (m+1) in
             for k=0 to (fin-debut) do
               if (!i<=m) 
                 then
                   begin
                     if (!j<=fin) then
                        begin
                          if v.(!i)<=v.(!j)
                            then begin aux.(k)<- v.(!i); incr i end
                            else begin aux.(k)<- v.(!j); incr j end
                          end
                     else
                       begin aux.(k)<- v.(!i); incr i end 
                   end
                 else begin aux.(k)<- v.(!j); incr j end
             done; 
           for k=0 to (fin-debut) do
             v.(debut+k)<-aux.(k)
           done;;


let rec inversion = function
  | [a;b]   -> (a>b)
  | a::b::r -> (a>b) || (inversion r);;


 let rec paritŽ = function
	    | 0 -> (true, false) 
	    | n -> let (p,i) = paritŽ (n-1) in (i,p);;


let impair n = snd (paritŽ n);;
let pair n = fst (paritŽ n);;


let pi=4. *. atan(1.);;
let rec cos x =
    if x>= 2. *. pi then cos (x -. 2.*. pi)
    else if x >=  pi then -. cos (x -.  pi)
    else if x >= (pi /. 2.) then sin ((pi /. 2.)-. x)
    else if x <= -2.*.pi then cos (x +. 2. *. pi)
    else if x <= -.pi then -. cos (x +. pi)
    else if x <= -.(pi /. 2.) then sin ( x +. (pi /. 2.))
    else if abs_float (x) < 0.003 then 1. -. x *. x /. 2.
    else let  s= sin (x /. 2.) in 1. -. 2. *. s *. s
and sin x =
    if x>= 2. *. pi then sin (x -. 2.*. pi)
    else if x >=  pi then -. sin (x -.  pi)
    else if x >= (pi /. 2.) then cos ((pi /. 2.)-. x)
    else if x <= -2.*.pi then sin (x +. 2. *. pi)
    else if x <= -.pi then -. sin (x +. pi)
    else if x <= -.(pi /. 2.) then -. cos ( x +. (pi /. 2.))
    else if abs_float (x) < 0.00001 then x
    else 2. *. sin (x /. 2.) *. cos (x /. 2.);;


let suite n =
(* calcule TOUS les termes de la suite entre 1 et n *)
  let u = make_vect (n+1) 0 in
   u.(0) <- 1;
   for i=1 to n do
   for j=0 to i-1 do
     u.(i) <- u.(i) + u.(j) * u.(i-1-j)
   done done;
 u.(n);;


let fact n = 
snd(boucle_inconditionnelle n  (fun (x,y) -> (x+1,(x+1)*y)) (0,1));;


let harmonique n = 
    snd(boucle_inconditionnelle (n-1)  
       (fun (x,y) -> (x+1,y+.1./.((float_of_int x)+.1.)))
       (1,1.));;


let rec c™tŽ  angle longueur n  =
    let (x,y) = current_point () in
    if (n=0) 
(* arr�t de la rŽcursion et tracŽ du  segment *)    
    then lineto 
         (x + int_of_float (longueur *. cos (angle)))
         (y + int_of_float (longueur *. sin (angle)))
(* le dŽplacement est relatif *)
    else begin
(* si n<>0  on subdivise le c™tŽ en quatre segments
   de longueur "longueur/3" et on trace rŽcursivement *)    
         c™tŽ angle (longueur /. 3.) (n-1);
         c™tŽ (angle -. (pi/.3.)) (longueur /. 3.) (n-1);
         c™tŽ (angle +. (pi/.3.)) (longueur /. 3.) (n-1);
         c™tŽ angle (longueur /. 3.) (n-1)
         end;;


let flocongood n =
    clear_graph ();
    let (ox,oy) = (ref 100., ref 100.) in
    c™tŽ 0.0 200. n ;
    c™tŽ ((2. *. pi) /. 3.) 200. n;
    c™tŽ (-.((2. *. pi) /. 3.)) 200. n
    where rec c™tŽ  angle longueur n  =
      if (n=0) 
      then begin
           moveto (int_of_float !ox) (int_of_float !oy);
(* voilˆ la correction *)
           ox := !ox +. longueur *. cos (angle);
           oy := !oy +. longueur *. sin (angle);
           lineto (int_of_float !ox) (int_of_float !oy)
           end
      else begin
(* si n<>0  on subdivise le c™tŽ en quatre segments
   de longueur "longueur/3" et on trace rŽcursivement *)    
           c™tŽ angle (longueur /. 3.) (n-1);
           c™tŽ (angle -. (pi/.3.)) (longueur /. 3.) (n-1);
           c™tŽ (angle +. (pi/.3.)) (longueur /. 3.) (n-1);
           c™tŽ angle (longueur /. 3.) (n-1)
           end;;


(*  FONCTIONS AUXILIAIRES *)
let rec isole = fun
	| i []     ->  "",[]
	| 0 (a::r) -> (a,r)
	| i (a::r) -> if (i < 0) 
                  then failwith "erreur sur i"
                  else let e,reste = isole (i-1) r in
                       e, a:: reste;;
  
let rec ins�re  = fun
	| "" l -> l
	| e [] -> [e]
	| e (a::r)  -> if e<a then e::a::r else a::(ins�re e r);;
(* on ins�re une cha”ne dans une liste maintenue ordonnŽe 
afin de pouvoir par la suite tester l'identitŽ de deux configurations *)

let correcte = function
    | ["chevre";_] -> false
    | _ -> true;;

(* L'AFFICHAGE DES SOLUTIONS *)

let rec print_list = function
	| [] -> ()
	| a::r -> print_string a; print_string " "; print_list r;;


let rec print_rive i = function
	| [] -> print_string "la rive "; print_int i; print_string " est vide"
	| r  -> print_string "sur la rive "; print_int i; 
         print_string " on a : "; print_list r;;


let rec afficher (i,rive1,rive2) = 
                      print_string "La barque est sur la rive ";
	                     print_int i; print_newline ();
	                     print_rive 1 rive1; print_newline ();
	                     print_rive 2 rive2;print_newline ();;

	                     
let rec afficher_solution  = function
    | [] -> ()
    | [etat] -> print_newline ();
                print_string "j'ai trouvŽ une solution :"; 
                print_newline ();
                afficher etat
    | etat::reste -> afficher_solution reste; 
                     print_string "------- une traversŽe -------";
                     print_newline ();
                     afficher etat;;
    (* on affiche dans l'ordre chronologique *)



(* LE CORPS DU PROGRAMME *)

let  rec rive1_ˆ_2   = function
    | (1,rive1,rive2)::reste_lc as liste_configuration ->
        for i=0 to list_length rive1  do
            let element,nouvelle_rive1 = isole i rive1 in
                if correcte nouvelle_rive1 
                then let nouvelle_rive2=ins�re element rive2 in
                     if not ( mem (2,nouvelle_rive1,nouvelle_rive2) reste_lc ) 
                          (* on teste si on ne boucle pas *)
                     then rive2_ˆ_1 
                      ((2,nouvelle_rive1,nouvelle_rive2)::liste_configuration)                                                                          
        done
    |   _ -> failwith "erreur dans rive1_ˆ_2"
and rive2_ˆ_1  = function
    | (2,[],rive2)::reste_lc    as liste_configuration -> 
        afficher_solution liste_configuration (* on a trouvŽ *)  
    | (2,rive1,rive2)::reste_lc as liste_configuration ->
        for i=0 to list_length rive2  do
            let element,nouvelle_rive2 = isole i rive2 in
                if correcte nouvelle_rive2 
                then let nouvelle_rive1=ins�re element rive1 in
                     if not ( mem (1,nouvelle_rive1,nouvelle_rive2) reste_lc )
                           (* on teste si on ne boucle pas *)
                then rive1_ˆ_2 
                 ((1,nouvelle_rive1,nouvelle_rive2)::liste_configuration)
        done
   |   _ -> failwith "erreur dans rive2_ˆ_1";;   
(* on emploie des boucles for pour trouver TOUTES les solutions *)  


rive1_ˆ_2 [1,["chevre";"chou";"loup"],[]];;


j'ai trouvŽ une solution :
La barque est sur la rive 1
sur la rive 1 on a : chevre chou loup 
la rive 2 est vide
------- une traversŽe -------
La barque est sur la rive 2
sur la rive 1 on a : chou loup 
sur la rive 2 on a : chevre 
------- une traversŽe -------
La barque est sur la rive 1
sur la rive 1 on a : chou loup 
sur la rive 2 on a : chevre 
------- une traversŽe -------
La barque est sur la rive 2
sur la rive 1 on a : loup 
sur la rive 2 on a : chevre chou 
------- une traversŽe -------
La barque est sur la rive 1
sur la rive 1 on a : chevre loup 
sur la rive 2 on a : chou 
------- une traversŽe -------
La barque est sur la rive 2
sur la rive 1 on a : chevre 
sur la rive 2 on a : chou loup 
------- une traversŽe -------
La barque est sur la rive 1
sur la rive 1 on a : chevre 
sur la rive 2 on a : chou loup 
------- une traversŽe -------
La barque est sur la rive 2
la rive 1 est vide
sur la rive 2 on a : chevre chou loup 

j'ai trouvŽ une solution :
La barque est sur la rive 1
sur la rive 1 on a : chevre chou loup 
la rive 2 est vide
------- une traversŽe -------
La barque est sur la rive 2
sur la rive 1 on a : chou loup 
sur la rive 2 on a : chevre 
------- une traversŽe -------
La barque est sur la rive 1
sur la rive 1 on a : chou loup 
sur la rive 2 on a : chevre 
------- une traversŽe -------
La barque est sur la rive 2
sur la rive 1 on a : chou 
sur la rive 2 on a : chevre loup 
------- une traversŽe -------
La barque est sur la rive 1
sur la rive 1 on a : chevre chou 
sur la rive 2 on a : loup 
------- une traversŽe -------
La barque est sur la rive 2
sur la rive 1 on a : chevre 
sur la rive 2 on a : chou loup 
------- une traversŽe -------
La barque est sur la rive 1
sur la rive 1 on a : chevre 
sur la rive 2 on a : chou loup 
------- une traversŽe -------
La barque est sur la rive 2
la rive 1 est vide
sur la rive 2 on a : chevre chou loup 
- : unit = ()




**********************************
* chap3
**********************************

let sommets = [0;1;2;3;4;5;6;7;8;9];;

let aretes =
    [(0,1);(0,2);(1,0);(1,3);(1,4);(1,5);(2,0);(2,8);
     (3,1);(3,6);(3,7);(4,1);(5,1);(6,3);(6,8);(7,3);
     (8,2);(8,6)];;


let labyrinthe = make_matrix 10 10 false;;

let rec initialisation graphe = function
    | [] -> ()
    | (i,j)::q -> graphe.(i).(j) <- true;
         initialisation graphe q;;

initialisation labyrinthe aretes;;


#labyrinthe;;
- : bool vect vect =
[|
[|false; true;  true;  false; false; false; false; false; false; false|];
[|true;  false; false; true;  true;  true;  false; false; false; false|];
[|true;  false; false; false; false; false; false; false; true;  false|];
[|false; true;  false; false; false; false; true;  true;  false; false|];
[|false; true;  false; false; false; false; false; false; false; false|];
[|false; true;  false; false; false; false; false; false; false; false|];
[|false; false; false; true;  false; false; false; false; true;  false|];
[|false; false; false; true;  false; false; false; false; false; false|];
[|false; false; true;  false; false; false; true;  false; false; false|];
[|false; false; false; false; false; false; false; false; false; false|]
|]


let liste_voisins graphe i = 
    let resultat = ref [] in
        for j=((vect_length graphe)-1) downto 0 do
            if graphe.(i).(j) then resultat := j::(!resultat)
        done;
    !resultat;;


#liste_voisins labyrinthe 0;;
- : int list = [1; 2]
#liste_voisins labyrinthe 1;;
- : int list = [0; 3; 4; 5]
#liste_voisins labyrinthe 9;;
- : int list = []


let labyrinthe = 
 [| [1;2];[0;3;4;5];[0;8];[1;6;7];[1];
    [1]; [3;8]; [3]; [2;6]; [] |];;


let liste_voisins graphe noeud = graphe.(noeud);;	


let arbre = 
 [| [1;2];[0;3;4]; [0;5;6]; [1]; [1;7;8]; [2]; [2]; [4]; [4] |];;


let rec visite graphe chemin_parcouru noeuds_a_tester  =
	   if (noeuds_a_tester = []) (* on est dans un cul de sac *)
 		 then chemin_parcouru
 		 else let voisin_courant = (hd noeuds_a_tester) in
   		 	  if mem voisin_courant chemin_parcouru (* si on boucle *)
   		 	  then visite graphe
                    chemin_parcouru 
(* ici on ne note pas les passages par un sommet dŽjˆ visitŽ *)
                    (tl noeuds_a_tester)
    			  else let resultat = visite graphe
                             (voisin_courant::chemin_parcouru) 
                             (liste_voisins graphe voisin_courant)
    				      in visite graphe
    				                resultat
    				                (tl noeuds_a_tester);;
				        

let parcours graphe  noeud = 
	visite graphe [noeud] (liste_voisins graphe noeud);;


#parcours arbre 0;;
- : int list = [6; 5; 2; 8; 7; 4; 3; 1; 0]


			...
   else let resultat = 
               visite graphe
		 	                  chemin_parcouru@[voisin_courant]
		 	                  (liste_voisins graphe voisin_courant)
			in ...


let rec affichage_dans_l_ordre = function 
    | []   -> print_newline ()	        
    | a::r -> affichage_dans_l_ordre r; 
              print_string " "; print_int a;;


    ...
    if mem voisin_courant chemin_parcouru (* si on boucle *)
    then visite graphe
                (voisin_courant::chemin_parcouru) 
(* ici on note tous les sommets testŽs *)
                (tl noeuds_a_tester)
    else ...


#parcours arbre 0;;
- : int list = 
          [2; 6; 2; 5; 0; 2; 4; 8; 4; 7; 1; 4; 1; 3; 0; 1; 0]


let parcours_total graphe =
	let deja_visite = make_vect (vect_length graphe) false in
	for noeud=0 to ((vect_length graphe) -1) do
		 if not (deja_visite.(noeud)) then
		 print_int noeud; deja_visite.(noeud) <- true;
		 parcours_connexe graphe noeud (liste_voisins graphe noeud)
	done
	where rec
   parcours_connexe graphe noeud noeuds_a_tester  =
	     if (noeuds_a_tester <> []) 
		    then begin let voisin_courant = (hd noeuds_a_tester) in
		 	          if deja_visite.(voisin_courant) (* test de circularitŽ *)
		 	          then parcours_connexe graphe
				                                  noeud
				                                  (tl noeuds_a_tester)
		(* au besoin ici on peut ajouter un print_int voisin_courant *)
			           else begin 
			             print_int voisin_courant;
			             deja_visite.(voisin_courant)  <- true;
			             parcours_connexe graphe
		 	                           voisin_courant 
		 	                          (liste_voisins graphe voisin_courant);
                parcours_connexe graphe
				                                 noeud
				                                 (tl noeuds_a_tester)
				              end
			        end;;


#parcours_total arbre;;
013478256- : unit = ()
#parcours_total labyrinthe;;
0136827459- : unit = ()


let parcours_total graphe = 
	let deja_visite = make_vect (vect_length graphe) false in
	for noeud=0 to ((vect_length graphe)-1) do 
		   if not(deja_visite.(noeud))
		   then parcours_connexe graphe noeud 
	done
	where rec
 parcours_connexe graphe noeud_courant =
 	if not(deja_visite.(noeud_courant)) (* test de circularitŽ *)
 	then begin 
 		      print_int noeud_courant; print_string " ";
 		      deja_visite.(noeud_courant) <- true
 		    end;
 	let noeuds_a_tester = ref (liste_voisins graphe noeud_courant)
 	in while (!noeuds_a_tester <> []) do
 	     let voisin_courant = hd !noeuds_a_tester in
 		      if not deja_visite.(voisin_courant) 
 		      then parcours_connexe graphe voisin_courant;
 		      noeuds_a_tester := tl (!noeuds_a_tester)
 	  done;;	 


let rec visite_labyrinthe graphe chemin_parcouru noeuds_a_tester but =
	if (but = hd (chemin_parcouru))  (* on a trouvŽ *)
	then chemin_parcouru
	else if (noeuds_a_tester = []) (* on est dans un cul de sac *)
		 then []
		 else let voisin_courant = (hd noeuds_a_tester) in
		 	  if mem voisin_courant chemin_parcouru (* si on boucle *)
		 	  then visite_labyrinthe graphe
     				                     chemin_parcouru
     				                     (tl noeuds_a_tester)
     				                     but
		 	  else let resultat = 
           visite_labyrinthe graphe
                             (voisin_courant::chemin_parcouru) 
                             (liste_voisins graphe voisin_courant)
                             but                           
				   in
				   if (resultat <> []) (* l'essai avec voisin_courant a abouti *)
				   then resultat
				   else (* l'essai avec voisin_courant n'a pas rŽussi *)
				   visite_labyrinthe graphe
				                     chemin_parcouru
				                     (tl noeuds_a_tester)
                     but;;

let ariane graphe depart but = 
	visite_labyrinthe graphe [depart] (liste_voisins graphe depart) but;;


#ariane labyrinthe 0 7;;
- : int list = [7; 3; 1; 0]
#ariane arbre 1 2;;
- : int list = [2; 0; 1]
#ariane arbre 5 7;;
- : int list = [7; 4; 1; 0; 2; 5]


let rec visite_labyrinthe graphe chemin_parcouru noeuds_a_tester but =
   if (but = hd (chemin_parcouru))  (* on a trouvŽ *)
   then (true,[])
   else if (noeuds_a_tester = []) (* on est dans un cul de sac *)
       then (false,[])
       else let voisin_courant = (hd noeuds_a_tester) in
           if mem voisin_courant chemin_parcouru (* si on boucle *)
           then visite_labyrinthe graphe
                              chemin_parcouru
                              (tl noeuds_a_tester)
                              but
           else let (reponse, chemin)  = 
               visite_labyrinthe graphe
                                 (voisin_courant::chemin_parcouru) 
                                 (liste_voisins graphe voisin_courant)
                                 but   
               in
               if reponse (* l'essai avec voisin_courant a abouti *)
               then (reponse, voisin_courant::chemin)
        (* ici on construit le chemin "victorieux" ˆ l'endroit *)
               else (* l'essai avec voisin_courant n'a pas reussi *)
                   visite_labyrinthe graphe
                                     chemin_parcouru
                                     (tl noeuds_a_tester)
                                     but;;

let ariane graphe depart but = 
  depart::(snd (visite_labyrinthe graphe 
                                  [depart] 
                                  (liste_voisins graphe depart) 
                                  but));;


#ariane labyrinthe 0 7;;
- : int list = [0; 1; 3; 7]
#ariane arbre 1 2;;
- : int list = [1; 0; 2]
#ariane arbre 5 7;;
- : int list = [5; 2; 0; 1; 4; 7]


#ariane graphe 0 2;;
- : int list = [0; 1; 3; 6; 8; 2]


#let L = 1::2::3::[];;
L : int list = [1; 2; 3]


#let list_it f liste b =
    let rec list_it_f = function
        | [] -> b
        | a::r -> f a (list_it_f r) in
    list_it_f liste;;

list_it : ('a -> 'b -> 'b) -> 'a list -> 'b -> 'b = <fun>


let somme_liste l = list_it (prefix +) l 0;;
let produit_liste l = list_it (prefix *) l 1;;
let cons x l = x::l;;
let concatene_listes l1 l2 = list_it cons l1 l2;;
let rec hauteur_arbre_gŽnŽral  = fun
    | (Feuille n)            -> 1
    | (NÏud (s,liste_fils))  -> 1 + list_it 
                      (fun a -> max (hauteur_arbre_gŽnŽral a)) 
                      liste_fils 0;;


type ('f,'n) arbre = 
     Feuille of 'f | NÏud of 'n * ('f,'n) arbre list;;


#somme_liste [1;2;3];;
- : int = 6
#produit_liste [1;2;4];;
- : int = 8
#concatene_listes [1;2;3] [1;2;4];;
- : int list = [1; 2; 3; 1; 2; 4]
(* un exemple de (int, int) arbre *)
#let arbre = NÏud(0,[
     NÏud(1, [Feuille 3; NÏud(4, [Feuille 7; Feuille 8])]);
     NÏud(2, [Feuille 5; Feuille 6])
]);;
#hauteur_arbre_gŽnŽral arbre;;
- : int = 4


let rec recherche e = function
    | []   -> raise Not_found
    | t::q -> (e=t) || recherche e q;;


let recherche e = function l ->   
  let rec cherche i = function
    |  []  -> raise Not_found
    | t::q -> if e = t then i else cherche (i+1) q
  in cherche 0 l;;


let recherche_dicho v e =
    cherche v 0 ((vect_length v) - 1) e
    where rec cherche v i j e =
             if i=j 
             then  (e = v.(i)) 
             else let m = (i+j)/2 in 
                  if (e > v.(m))
                  then cherche v (m+1) j e 
                  else cherche v i m e;;


let recherche_dicho v e =
    cherche v 0 ((vect_length v) - 1) e
    where rec cherche v i j e =
             if i=j 
             then  if (e=v.(i))
                   then i
                   else raise Not_found 
             else let m = (i+j)/2 in 
                  if (e > v.(m))
                  then cherche v (m+1) j e 
                  else cherche v i m e;;


let succ y = x:= !x+1; y+1;;


sommet (empile e p)


type 'a pile == 'a list;;


type 'a pile = PileVide | Empile of 'a * 'a pile;;


type 'a pile = {contenu:'a vect; mutable sommet:int};;


let Pile_vide n objet = {contenu=make_vect n objet; 
                          sommet=(-1)};;


let Pile_vide () = {contenu=make_vect 10 0; sommet=(-1)};;


{contenu = [|1; 2; 8; 0; 0; 0; 0; 0; 0; 0|]; sommet = 2}


{contenu = [|1; 2; 8; 7; 0; 0; 0; 0; 0; 0|]; sommet = 2}.


let est_vide p = (p.sommet = (-1));;

let empile e p =
        if p.sommet = (vect_length p.contenu -1)
        then failwith "pile pleine"
        else begin
               p.sommet <- p.sommet+1;               
               p.contenu.(p.sommet) <- e;
               p
             end;;


let dŽpile p =
        if p.sommet = (-1)
        then failwith "pile vide"
        else begin
               p.sommet <- p.sommet-1;
               p
             end;;

let sommet p =
        if p.sommet = (-1)
        then failwith "pile vide"
        else p.contenu.(p.sommet);;


let p = empile 8 (empile 2 (empile 1 (Pile_vide ())));;


let rec taille  p = 
    if (est_vide p)
    then 0
    else 1 + taille (dŽpile p);;


let taille p =
    vect_length p.contenu;;


let f2 (p,q) =
    let x = q-p in
    ...;;


let f1  (x,y,z) = 
    let a = x*x 
    and b = y-6 in
    ...
    f2  (a+3, b*b - z);
    ...;;


let f0 n =
    let x = n+2 
    and y = 3*n
    and z = n - 4 in
    ...
    f1 (x,y,z);
    ...;;


type 'a file = {contenu : 'a vect; 
                mutable dŽbut : int; mutable fin :int};;


type 'a file = {contenu : 'a vect; 
                mutable dŽbut : int; mutable fin :int; 
                mutable vide : bool};;


let fmax = 10;;


let File_vide objet =
{contenu = make_vect fmax objet; 
 dŽbut = 0; fin = 0; vide = true};;


let File_vide () =
{contenu = make_vect fmax 0; 
 dŽbut = 0; fin = 0; vide = true};;


let est_vide f =
    f.vide;;


let ajoute e f =
    if (f.fin = f.dŽbut) && not(f.vide) 
    then failwith "file pleine"
    else begin
         f.contenu.(f.fin) <- e;
         f.fin <- (succ f.fin) mod fmax;
         f.vide <- false;
         f
         end;;


let premier  f =
    if (f.vide) 
    then failwith "file vide"
    else f.contenu.(f.dŽbut);;


let queue f =
    if (f.vide) 
    then failwith "file vide"
    else begin
         f.dŽbut <- (succ f.dŽbut) mod fmax;
         if (f.dŽbut = f.fin)
         then f.vide <- true;
         f
         end;;


let f = File_vide ();;
ajoute 1 f; ajoute 2 f; ajoute 3;;


let taille f =
    if (f.vide) 
    then 0
    else let t=(f.fin - f.dŽbut) in
         if t>0 then t else t+fmax;;


type 'f arbre = F of 'f | N of 'f arbre * 'f arbre;;
let rec t = N(F 1,t);;


type ('f,'n) arbre = 
 | Feuille of 'f 
 | NÏud of 'n * ('f,'n) arbre * ('f,'n) arbre ;;


let gŽnŽalogie = 
  NÏud(18,NÏud(7,Feuille "Antoine",Feuille"Bruno"),
    NÏud(52,Feuille"Nicolas",Feuille"Luc"));;

let t = 
  NÏud(4,NÏud(7,Feuille `A`,Feuille `B`),
    NÏud(80,Feuille `L`,Feuille `N`));;


let rec nombre_de_nÏuds = function 
 | F -> 0 
 | N(_,g,d) -> 1 + nombre_de_nÏuds g + nombre_de_nÏuds d;;

let rec nombre_de_feuilles = function 
 | F -> 1 
 | N(_,g,d) -> nombre_de_feuilles g + nombre_de_feuilles d;;


let rec hauteur = function 
 | F -> 0 
 | N(_,g,d) -> 1 + max (hauteur g) (hauteur d);;


let rec arbre_complet = function 
 | 1 -> F 
 | n -> let t = arbre_complet (n-1) in N(t,t);;

let rec peigne_droit = function 
 | 1 -> F 
 | n -> N(F,peigne_droit (n-1));;


let visite = function 
 | F -> () 
 | N(_,g,d) -> visite g;visite d;;


type arbre = F | N of int * arbre * arbre;;
let rec parcours t t_pr t_in t_post = match t with 
 | F -> () 
 | N(x,g,d) -> t_pr x; parcours g t_pr t_in t_post; 
    t_in x; parcours d t_pr t_in t_post; t_post x;;


let mon_arbre = N(5,N(8,F,F),N(4,F,N(9,F,F)));;
#mon_arbre : arbre = N (5, N (8, F, F), N (4, F, N (9, F, F)))
let traitement x = print_int x; print_char `*`;;
#traitement : int -> unit = <fun>
let rien x = ();;
#rien : 'a -> unit = <fun>
parcours mon_arbre traitement rien rien;;
#5*8*4*9*- : unit = ()
parcours mon_arbre rien traitement rien;;
#8*5*4*9*- : unit = ()
parcours mon_arbre rien rien traitement;;
#8*9*4*5*- : unit = ()


type ('n,'f) arbre = 
 | F of 'n | N of 'f * ('n,'f) arbre * ('n,'f) arbre;;

let rec traite_file f ftf ftn =
    if (est_vide f) 
    then ()
    else let e = premier f
         and q = queue f in
         match e with 
           | F x -> ftf x; traite_file q ftf ftn
           | N(y,g,d) -> ftn y; traite_file 
                 (ajoute d (ajoute g q)) ftf ftn;;

let parcours_en_largeur arbre ftf ftn = 
    traite_file (ajoute arbre (File_vide ())) ftf ftn;;





#let t = N(`a`,N(`b`,N(`d`,F 5,F 7),F 9),F 6);;
#parcours_en_largeur t print_int print_char;;
ab6d957- : unit = ()


type arbre = V | N of arbre*arbre;;


let rec C = function 
 | 0 -> 1 
 | n -> let temp = ref 0 in 
    for k=0 to n-1 do temp := !temp + C(k)*C(n-1-k) done;
    !temp;;


type 'a arbre = F | N of 'a * 'a arbre * 'a arbre;;
type comparaison = PrŽc�de | Est_Žgal_ˆ | Suit;; 
let rec cherche x t phi = match t with 
 | F -> failwith "la recherche a ŽchouŽ"
 | N(y,g,d) -> match phi x y with 
   | PrŽc�de    -> cherche x g phi 
   | Est_Žgal_ˆ -> failwith "la recherche a rŽussi"
   | Suit       -> cherche x d phi;;


#let compare_int x y = 
  if x<y then PrŽc�de else 
  if x=y then Est_Žgal_ˆ else Suit;;
compare_int : 'a -> 'a -> comparaison = <fun>
#let tt = N(5,N(2,F,F),N(9,N(7,F,F),F));;
tt : int arbre = N (5, N (2, F, F), N (9, N (7, F, F), F))
#cherche 4 tt compare_int;;
Exception non rattrapŽe: Failure "la recherche a ŽchouŽ"
#cherche 9 tt compare_int;;
Exception non rattrapŽe: Failure "la recherche a rŽussi"


let rec ins�re x t phi = match t with 
 | F -> N(x,F,F) 
 | N(y,g,d)     -> match phi x y with 
   | PrŽc�de    -> N(y,ins�re x g phi,d) 
   | Est_Žgal_ˆ -> t
   | Suit       -> N(y,g,ins�re x d phi);;


let rec extrait_nÏud_maximal = function 
 | N(x,g,F) -> (x,g) 
 | N(x,g,d) -> let (y,d') = extrait_nÏud_maximal d 
    in (y,N(x,g,d'));;


let rec supprime x t phi = match t with 
 | F -> failwith "Žtiquette non trouvŽe"
 | N(y,F,d) when y = x -> d 
 | N(y,g,d) when y = x -> let (y,g') = extrait_nÏud_maximal g 
    in N(y,g',d) 
 | N(y,g,d) -> match phi x y with 
   | PrŽc�de    -> N(y,supprime x g phi,d) 
   | Est_Žgal_ˆ -> t
   | Suit       -> N(y,g,supprime x d phi);;


let v =
[| [|4;5;6|]; [|1;1;1|]; [|1;4;2|]; [|2;1;3|];
              [|2;4;4|]; [|3;1;5|]; [|3;2;6|] |];;



let rec reines_aux n echiquier = 
    if bonne_position echiquier 
    then 
       if est_plein n echiquier 
       then echiquier
       else reines_aux n (ajoute_reine echiquier)
    else reines_aux n (nouvel_essai n echiquier);;


let reines n =
        reines_aux n [1];;


#union [1;2;3;4;5] [4;5;6;7];;
- : int list = [1; 2; 3; 4; 5; 6; 7]
#intersection [1;2;3;4;5] [4;5;6;7];;
- : int list = [4; 5]
#difference [1;2;3;4;5] [4;5;6;7];;
- : int list = [1; 2; 3]


#let infŽrieur_ˆ_dix n = (n < 10);;
infŽrieur_ˆ_dix : int -> bool = <fun>
#qqsoit infŽrieur_ˆ_dix [0;5;12;6;19];;
- : bool = false
#existe infŽrieur_ˆ_dix [0;5;12;6;19];;
- : bool = true
#filtre infŽrieur_ˆ_dix [0;5;12;6;19];;
- : int list = [0; 5; 6]


#ensemble_des_parties [1;2;3];;
- : int list list = 
      [[3; 2; 1]; [2; 1]; [3; 1]; [1]; [3; 2]; [2]; [3]; []]


#permutations [1;2;3];;
- : int list list =
 [[1; 2; 3]; [1; 3; 2]; [2; 1; 3]; [2; 3; 1]; [3; 1; 2]; [3; 2; 1]]


type 'a pile == 'a list;;


type 'a pile = PileVide | Empile of 'a * 'a pile;;





let compose f g x = f(g x);;


compose (t -> supprime x t phi) (t -> ins�re y t phi);;
compose (t -> ins�re y t phi) (t -> supprime x t phi);;


type arbre = F | N of (int*arbre*arbre);;



let graphe_orientŽ = [| [1;2];[3];[1];[]|];;

let liste_successeurs i = graphe_orientŽ.(i);;

let rec ajoute_successeur i graphe  = function
   | [] -> ()
   | a::r -> graphe.(a) <- i::(graphe.(a));
             ajoute_successeur i graphe r;;

let transpose graphe =
    let graphe_dual = make_vect (vect_length graphe) [] in
    for i=0 to (vect_length graphe) -1 do
      ajoute_successeur i graphe_dual (liste_successeurs i)
    done;
    graphe_dual;;

let graphe_orientŽ_dual = transpose graphe_orientŽ;;

let liste_predecesseurs i = graphe_orientŽ_dual.(i);;


#graphe_orientŽ_dual;;
graphe_orientŽ_dual : int list vect = [|[]; [2; 0]; [0]; [1]|]


let Nmax = 10;;


let transpose v =
     let tv = make_matrix Nmax 3 0 in  
     let c = v.(0).(0) and N=v.(0).(2) in
     tv.(0).(0) <- v.(0).(1);
     tv.(0).(1) <- c;
     tv.(0).(2) <- N;
     if N>0 then 
     let nl = make_vect c 0 in
     let accu = make_vect c 0 in
     for i=1 to N do
       nl.(v.(i).(1)-1) <- succ nl.(v.(i).(1)-1)
     done;
     accu.(0) <- 1;
     for i=1 to (c-1) do
       accu.(i) <- accu.(i-1) + nl.(i-1)
     done;
     for i=1 to N do
       let j=accu.(v.(i).(1)-1) in
       tv.(j).(0) <- v.(i).(1);
       tv.(j).(1) <- v.(i).(0);
       tv.(j).(2) <- v.(i).(2);
       accu.(v.(i).(1)-1) <- succ j
     done;
     tv
     else tv;;


#v;;
- : int vect vect =
 [|[|4;5;6|]; 
   [|1;1;1|]; [|1;4;2|]; [|2;1;3|]; [|2;4;4|]; [|3;1;5|]; 
   [|3;2;6|]; [|0;0;0|]; [|0;0;0|]; [|0;0;0|] |]
#nl;;
- : int vect = [|3; 1; 0; 2|]
#accu;;
- : int vect = [|1; 4; 5; 5|]


#transpose v;;
- : int vect vect =
 [|[|5; 4; 6|]; 
   [|1; 1; 1|]; [|1; 2; 3|]; [|1; 3; 5|]; [|2; 3; 6|]; [|4; 1; 2|];
   [|4; 2; 4|]; [|0; 0; 0|]; [|0; 0; 0|]; [|0; 0; 0|]|]




let rec atteint gauche droit = function
    | [] ->  false
    | a::r -> (gauche = a) or (droit = a) 
              or (atteint (gauche-1) (droit +1) r);;

let rec nouvel_essai n = function
    | [] -> [1]
(* cas superflu pour l'instant *)
    | a::r -> if a<n then (a+1)::r else nouvel_essai n r;;

let bonne_position = function
    | [] -> true
    | a::r -> not (mem a r) && not (atteint (a-1) (a+1) r);;

let est_plein n echiquier = list_length echiquier = n;;

let ajoute_reine echiquier = 1::echiquier;;


let rec reines_aux n echiquier = 
    if bonne_position echiquier 
    then 
       if est_plein n echiquier 
       then echiquier
       else reines_aux n (ajoute_reine echiquier)
    else reines_aux n (nouvel_essai n echiquier);;


let reines n =
        reines_aux n [1];;


exception fini;;
  
let rec atteint gauche droit = function
    | [] ->  false
    | a::r -> (gauche = a) or (droit = a) 
              or (atteint (gauche-1) (droit +1) r);;

let rec nouvel_essai n = function
    | [] -> raise fini
    | a::r -> if a<n then (a+1)::r else nouvel_essai n r;;

let bonne_position = function
    | [] -> true
    | a::r -> not (mem a r) && not (atteint (a-1) (a+1) r);;

let est_plein n echiquier = list_length echiquier = n;;

let ajoute_reine echiquier = 1::echiquier;;


let rec reines_aux n echiquier l = 
    try
    if bonne_position echiquier 
    then 
       if est_plein n echiquier 
       then
          begin 
               l:= echiquier::(!l);
               reines_aux n (nouvel_essai n echiquier) l
          end
       else reines_aux n (ajoute_reine echiquier) l
    else reines_aux n (nouvel_essai n echiquier) l
    with fini -> !l;;


let reines n =
    let liste_solutions = ref [] in
        reines_aux n [1] liste_solutions;;


let tout () =
    for i=1 to 8 do
    print_string "pour n="; print_int i;
    print_string ", le nombre de solutions est : ";
    print_int (list_length (reines i));
    print_newline ()
    done;;


#reines 4;;
- : int list list = [[2; 4; 1; 3]; [3; 1; 4; 2]]
#tout ();;
pour n=1, le nombre de solutions est : 1
pour n=2, le nombre de solutions est : 0
pour n=3, le nombre de solutions est : 0
pour n=4, le nombre de solutions est : 2
pour n=5, le nombre de solutions est : 10
pour n=6, le nombre de solutions est : 4
pour n=7, le nombre de solutions est : 40
pour n=8, le nombre de solutions est : 92


let rec union  = fun
    | [] l2     -> l2
    | (d::r) l2 -> if (mem d l2) 
                 then union r l2
                 else d::(union r l2);;

let rec intersection  = fun
    | [] l2     -> []
    | (d::r) l2 -> if (mem d l2) 
                 then d::(intersection r l2)
                 else (intersection r l2);;

let rec difference  = fun
    | [] l2     -> []
    | (d::r) l2 -> if (mem d l2) 
                 then difference r l2
                 else d::(difference r l2);;


let rec qqsoit p = function
    | []   -> true
    | e::r -> (p e) && (qqsoit p r);;

let rec existe p = function
    | []   -> false
    | e::r -> (p e) || (existe p r);;


let rec filtre p = function
    | []   -> []
    | e::r -> if p e 
              then e::(filtre p r)
              else filtre p r;;


let ensemble_des_parties l_n = 
  let rec ensemble_des_parties_aux l_n l =
    if l_n <> [] then
      ensemble_des_parties_aux (tl l_n) (hd l_n :: l) @ 
      ensemble_des_parties_aux (tl l_n) l 
    else [l]
  in ensemble_des_parties_aux l_n [];;


let rec permut fixe = fun
    | [] [] -> [fixe] 
    | debut [] -> [] 
    | debut (x :: suite) -> (permut (fixe @ [x]) []
                                  (debut @ suite)) @
                          (permut fixe (debut @ [x]) suite);;
let permutations l =
   permut [] [] l;;


type 'a pile == 'a list;;

let Pile_vide () = ([] : 'a pile);; 

let est_vide p = (p = (Pile_vide ()));;

let empile e (p: 'a pile) = ((e::p): 'a pile);;

let (dŽpile: 'a pile -> 'a pile)  = function
	| [] -> failwith "Pile vide"
	| s::r -> r;;

let (sommet : 'a pile -> 'a) = function
	| []  -> failwith "Pile vide"
	| s::r -> s;;

(* Taille d'une pile *) 
let taille (p: 'a pile) = list_length p;;
(* non indispensable car non destructif *)


type 'a pile = PileVide | Empile of 'a * 'a pile;;

let est_vide  = function
   | PileVide -> true
   | _ -> false;;

let empile e p = Empile (e,p);;

let dŽpile  = function
	| PileVide ->  failwith "Pile  vide"
	| Empile (s,p) -> p;;

let sommet  = function
	| PileVide ->  failwith "Pile  vide"
	| Empile (s,p) -> s;;


let Pile_vide () = PileVide;;


let rec taille  = function
	| PileVide -> 0
	| Empile (s,p) -> 1 + taille p;;


let rotation p =
(* place le sommet de la pile tout au fond *)
    let aux  = Pile_vide ()
    and s = sommet p in
(* on commence par mettre de c™tŽ le sommet *)
    dŽpile p;
(* on empile tous les autres ŽlŽments dans aux
   ils sont donc ˆ l'envers ! *)
    while not(est_vide p) do 
           empile (sommet p) aux;
           dŽpile p
    done;
(* on place s au fond *)
    empile s p;
(* on rŽempile au dessus les autres ŽlŽments
   qui se retrouvent ainsi dans le bon ordre *)
    while not(est_vide aux) do 
           empile (sommet aux) p; 
           dŽpile aux
    done;
    p;;


let rotation p =
    let aux  = ref (Pile_vide ()) in
    let res  = ref (dŽpile p) in
    let s = sommet p in
    while not(est_vide !res) do 
           aux := empile (sommet !res) !aux;
           res := dŽpile !res
    done;
    let res = ref (empile s (Pile_vide ())) in
    while not(est_vide !aux) do 
           res:=empile (sommet !aux) !res; 
           aux:=dŽpile !aux
    done;
    !res;;


exception expression_incorrecte;;

let eval expr = 
   try
   let p = ref (Pile_vide ()) in
   for i=0 to ((vect_length expr) -1) do
       match expr.(i) with
          | "+" -> let op2 = sommet !p in
                       p:= dŽpile !p;
                   let op1 = sommet !p in
                       p:= dŽpile !p; 
                       p:= empile (op1 + op2) !p
          | "*" -> let op2 = sommet !p in 
                       p:=dŽpile !p;
                   let op1 = sommet !p in 
                       p:=dŽpile !p;
                       p:=empile (op1 * op2) !p
          | x -> p:= empile (int_of_string x) !p
   done;
   sommet !p
   with Failure s -> raise expression_incorrecte;;


let infixe_of_postfixe expr = 
   try
   let p = ref (Pile_vide ()) in
   for i=0 to ((vect_length expr) -1) do
       match expr.(i) with
          | "+" -> let op2 = sommet !p in
                       p:= dŽpile !p;
                   let op1 = sommet !p in
                       p:= dŽpile !p; 
                       p:= empile ("(" ^ op1 ^" + "^ op2 ^")") !p
          | "*" -> let op2 = sommet !p in 
                       p:=dŽpile !p;
                   let op1 = sommet !p in 
                       p:=dŽpile !p;
                       p:=empile ("(" ^ op1 ^" * "^ op2 ^")") !p
          | x -> p:= empile x !p
   done;
   sommet !p
   with Failure s -> raise expression_incorrecte;;


type 'a file={mutable dŽbut :'a list; mutable fin :'a list};;


let File_vide () = {dŽbut =[]; fin=[]};;

let ajoute e f = 
   f.fin <- e :: f.fin;
   f;;


let est_vide f = (f.dŽbut = [] & f.fin = []);;


let miroir l =
	  let accu = ref [] and lref = ref l in
	      while !lref <> [] do
		       accu := (hd !lref) :: !accu; lref:= tl !lref
		     done;
   !accu;;

let premier f = 
    if (est_vide f) 
    then failwith "file vide"
    else begin
         if (f.dŽbut = [])
(* on normalise *)
         then begin 
                 let normal = miroir f.fin in  
                 f.dŽbut <-  normal; f.fin <- []
              end;
         hd f.dŽbut
         end;;	

let queue f = 
    if (est_vide f) 
    then  failwith "file vide"
    else begin 
         if (f.dŽbut = [])
(* on normalise *)
         then begin
                 let normal = miroir f.fin in 
                 f.dŽbut <- tl normal; f.fin <- []
              end 
         else f.dŽbut <- (tl f.dŽbut);
         f
         end;;		


type arbre =
 Feuile | NÏud of arbre list;;


type feuille = Entier of int | Cha”ne of string;;
type arbre = F of feuille | N of arbre * arbre;;


let Catalan n =
 let C = make_vect (n+1) 1 in
  for k = 1 to n do
   let s = ref 0 in
    for i = 0 to k-1 do s := !s + C.(i) * C.(k-1-i) done;
    C.(k) <- !s
  done; C;;


let Catalan2 n =
 let C = make_vect (n+1) 1 in
  for k = 1 to n do
    let s = ref 0 in
    for i = 0 to (k/2 - 1) do s := !s + C.(i) * C.(k-1-i) done;
    s := 2 * !s;
    if (k mod 2) = 1 then s := !s + C.(k/2) * C.(k/2);
    C.(k) <- !s
   done; C;;


type ('n,'f) filiforme =
 | G of ('n,'f) filiforme * 'f
 | D of 'f * ('n,'f) filiforme
 | B of 'f;;


exception Pas_abr;;

let rec teste_abr = function
 | N(x,F,F) -> (x,x)
 | N(x,F,d) -> let (md,Md) = teste_abr d in
    if x >= md then raise Pas_abr else (x,Md)
 | N(x,g,F) -> let (mg,Mg) = teste_abr g in
    if x <= Mg then raise Pas_abr else (mg,x)
 | N(x,g,d) -> let (md,Md) = teste_abr d in
    let (mg,Mg) = teste_abr g in
    if x <= Mg or x >= md then raise Pas_abr else (mg,Md);;


let est_abr t =
 try teste_abr t; true
 with Pas_abr -> false;;



******************************
* chap4.ml
******************************

exception TrouvŽ;;
let cherche x t = 
   try 
      for k=0 to vect_length t - 1 do
         if t.(k) = x then raise TrouvŽ done;
      false
   with TrouvŽ -> true;;


let minmax t = 
 let rec minmax_rec t i j = 
  if i=j then (t.(i),t.(i)) else 
  if i+1=j then
   begin 
    if t.(i)<t.(j) 
     then (t.(i),t.(j)) else (t.(j),t.(i)) end 
     else let k=(i+j)/2 in 
      let (min1,max1) = minmax_rec t i k 
      and (min2,max2) = minmax_rec t (k+1) j 
       in ((min min1 min2),(max max1 max2)) 
 in minmax_rec t 0 (vect_length t - 1);;


let Žchange u i j = let x = u.(i) in u.(i)<-u.(j);u.(j)<-x;;

let CFR t =
 let rec CFR_aux u i j =
  if i=j then () else
  if i+1=j then begin if u.(i)>u.(j) then Žchange u i j end else
  let k=(j+1-i)/3 in
    CFR_aux u i (j-k); CFR_aux u (i+k) j; CFR_aux u i (j-k)
 in CFR_aux t 0 (vect_length t - 1);;


    (* calcule le ppcm des ŽlŽments du vecteur "a"      *)
    (* on suppose que "a" contient au moins un ŽlŽment. *)
let ppcm a =
   let p = ref a.(0) in
       for i=1 to vect_length(a) - 1 do 
          p := ppcm(!p,a.(i)) done;
       !p;; 
    
    (* calcule le ppcm des ŽlŽments du vecteur "a"      *)
    (* on suppose que "a" contient au moins un ŽlŽment. *)
let rec ppcm_div a = match vect_length a with
    | 1 -> a.(0)
    | n -> let n'  = n/2  in
           let n'' = n-n' in
           let p'  = ppcm_div (sub_vect a 0 n')
           and p'' = ppcm_div (sub_vect a n' n'') in
             ppcm2(p',p'');;


let rec c = function
 | 1 -> 0
 | 2 -> 1
 | n -> 3 * c(n-n/3);;


c := proc(n) option remember; 3*c(n-iquo(n,3)) end;
c(1) := 0; c(2) := 1;



**************************************
* chap6
**************************************

#analyse "(a ou c) => (b et d)";;
- : proposition = Imp (Ou (Var "a", Var "c"),
                       Et (Var "b", Var "d"))


#variables (Ou (Et (Var "a", Var "b"), Var "c"));;
- : string list = ["a"; "b"; "c"]


#valeur (Ou (Et (Var "a", Var "b"), Var "c"))
   [("a",true);("b",false);("c",true)];;
- : bool = true


#assoc "b" [("a",1);("b",2);("c",3)];;
- : int = 2


#print_bool_list [("a",true);("b",false)];;
 a=true b=false.


#teste "non (a et b) <=> (non a) ou (non b)";;
"non (a et b) <=> (non a) ou (non b)" est une tautologie.
- : unit = ()
 
#teste "non (a et b) <=> (non a) et (non b)";;
"non (a et b) <=> (non a) et (non b)" est faux pour :
b=false a=true.
- : unit = ()


(* Definition des types *)
type lexeme =
  | LexParG
  | LexParD
  | LexVrai
  | LexFaux
  | LexNon
  | LexOu
  | LexEt
  | LexImp
  | LexEqu
  | LexVar of string;;

type proposition =
  | Vrai
  | Faux
  | Non of proposition
  | Et of proposition*proposition
  | Ou of proposition*proposition
  | Imp of proposition*proposition
  | Equ of proposition*proposition 
  | Var of string;;

(* Analyseur lexical *)

(* on initialise le tampon avec 32 caracteres blancs *)
let tampon = make_string 32 ` `;;

(* recherche d'identificateurs *)
let rec lire_mot position = function
(*  match flux with *)
  | [<'`a`..`z`|`A`..`Z`|`0`..`9`|`_` as c;
    (if position >= 32
        (* on tronque au dela de 32 caracteres *)
        then lire_mot position
        else
          begin
          set_nth_char tampon position c;
          lire_mot (position + 1)
        end)
    s>] -> s
  | [<>] -> (match sub_string tampon 0 position with
              | "and" -> LexEt
              | "et" -> LexEt
              | "or" -> LexOu
              | "ou" -> LexOu
              | "not" -> LexNon
              | "non" -> LexNon
              | "imp" -> LexImp
              | "equ" -> LexEqu
              | "vrai" -> LexVrai
              | "Vrai" -> LexVrai
              | "VRAI" -> LexVrai
              | "T" -> LexVrai
              | "faux" -> LexFaux
              | "Faux" -> LexFaux
              | "FAUX" -> LexFaux
              | "F" -> LexFaux
              | s -> LexVar s);;

let rec saute_blancs flux =
  match flux with
     | [<'(` ` | `\t` | `\n` ) >] -> saute_blancs flux
     | [<>] -> ();;

let rec lire_lexeme flux_de_car =
  saute_blancs flux_de_car;
  match flux_de_car with
  | [<'`(` ; saute_blancs _>]
         -> [< 'LexParG ; lire_lexeme flux_de_car >]
  | [<'`)` ; saute_blancs _>]
         -> [< 'LexParD ; lire_lexeme flux_de_car >]
  | [<'`<`;'`=`;'`>`; saute_blancs _>]
         -> [< 'LexEqu ; lire_lexeme flux_de_car >]
  | [<'`=`;'`>`; saute_blancs _>]
         -> [< 'LexImp ; lire_lexeme flux_de_car >]
  | [<'`&` ; saute_blancs _>]
         -> [< 'LexEt ; lire_lexeme flux_de_car >]
  | [<'`|` ; saute_blancs _>]
         -> [< 'LexOu ; lire_lexeme flux_de_car >]
  | [<'`a`..`z`|`A`..`Z` as c ;
    (set_nth_char tampon 0 c ; lire_mot 1) Lex >]
         -> [< 'Lex ; lire_lexeme flux_de_car >]
  | [<>] -> [<>];;

let flux_de_lex_of_flux_de_car mot =
      lire_lexeme (stream_of_string mot);;

(* Analyseur syntaxique *)
let rec mk1 flux_de_lex =
  let e1 = mk2 flux_de_lex in
    match flux_de_lex with
       | [< 'LexEqu ; mk2 e2 >] -> Equ(e1,e2)
       | [<>] -> e1
and mk2 flux_de_lex =
  let e1 = mk3 flux_de_lex in
    match flux_de_lex with
       | [< 'LexImp ; mk3 e2 >] -> Imp(e1,e2)
       | [<>] -> e1
and mk3 flux_de_lex =
  let e1 = mk4 flux_de_lex in
    match flux_de_lex with
       | [< 'LexOu ; mk3 e2 >] -> Ou(e1,e2)
       | [<>] -> e1
and mk4 flux_de_lex =
  let e1 = mk5 flux_de_lex in
    match flux_de_lex with
       | [< 'LexEt ; mk4 e2 >] -> Et(e1,e2)
       | [<>] -> e1
and mk5 flux_de_lex =
    match flux_de_lex with
       | [< 'LexNon ; mk6 e >] -> Non(e)
       | [<mk6 e>] -> e
and mk6 flux_de_lex =
    match flux_de_lex with
       | [< 'LexParG ; mk1 e ; 'LexParD>] -> e
       | [< 'LexVrai >] -> Vrai
       | [< 'LexFaux >] -> Faux
       | [< 'LexVar s >] -> Var s;;

let analyse mot = mk1 (flux_de_lex_of_flux_de_car mot);;


type clause == proposition list;;

type forme_clausale == clause list;;


#paires [1;2;3;4];;
- : ((int * int) * int list) list =
 [(1, 2), [3; 4]; (1, 3), [2; 4]; (1, 4), [2; 3];
  (2, 3), [1; 4]; (2, 4), [1; 3]; (3, 4), [1; 2]]


let variables expr_analysee =
  let rec var_aux expr liste =
     match expr with
        | Vrai -> liste
        | Faux -> liste
        | Non(e) -> var_aux e liste
        | Et(e1,e2) -> var_aux e1 (var_aux e2 liste)
        | Ou(e1,e2) -> var_aux e1 (var_aux e2 liste)
        | Imp(e1,e2) -> var_aux e1 (var_aux e2 liste)
        | Equ(e1,e2) -> var_aux e1 (var_aux e2 liste)
        | Var s -> if (mem s liste) then liste
                                       else s::liste
  in var_aux expr_analysee [];;

let rec valeur expr vv =
   match expr with
       | Vrai -> true
       | Faux -> false
       | Non(e) -> not(valeur e vv)
       | Et(e1,e2) -> (valeur e1 vv) & (valeur e2 vv)
       | Ou(e1,e2) -> (valeur e1 vv) or (valeur e2 vv)
       | Imp(e1,e2) -> (not (valeur e1 vv)) or (valeur e2 vv)
       | Equ(e1,e2) -> (valeur e1 vv) = (valeur e2 vv)
       | Var s -> assoc s vv;;

type nature = Tauto | Pastauto of (string*bool) list;;

let rec print_bool_list liste =
  match liste with
    | [] -> print_char `.`; print_newline()
    | (var,val)::s 
         -> print_char ` `;
            print_string var ;
            print_char `=`;
            print_string (string_of_bool val); 
            print_bool_list s;;

let teste chaine =
  let expr = analyse chaine
    in
    let rec verif liste_var liste_bool =
       match liste_var with
          | [] -> if valeur expr liste_bool then Tauto
                                  else Pastauto liste_bool
          | var::s -> match verif s ((var,true)::liste_bool)
              with | Pastauto liste_bool -> Pastauto liste_bool
                   | Tauto -> verif s ((var,false)::liste_bool)
      in
      print_char `"`; print_string chaine; print_char `"`;
      match verif (variables expr) [] with
        | Tauto -> print_string " est une tautologie.";
                  print_newline()
        | Pastauto liste_bool -> print_string " est faux";
            match liste_bool with
              | [] -> print_char `.`; print_newline()
              | (var,val)::s -> print_string " pour :";
                   print_newline();
                   print_string var; print_char `=`;
                   print_string (string_of_bool val);
                   print_bool_list s;;


type clause == proposition list;;

type forme_clausale == clause list;;

let rec union l1 l2 =
  match l1 with
    | []   -> l2
    | t::q -> if mem t l2
                then union q l2
                else t::(union q l2);;

let rec (prod : forme_clausale -> forme_clausale
                -> forme_clausale) =
  fun fc1 fc2 ->
  let rec distribue cl fc =
    match fc with
      | []   -> []
      | t::q -> (union cl t) :: (distribue cl q)
  in
  match fc1 with
    | []   -> []
    | t::q -> union (distribue t fc2) (prod q fc2);;

let rec (mfc : proposition -> forme_clausale) = fun prop ->
  match prop with
    | Faux          -> [[Faux]]
    | Non(Vrai)     -> [[Faux]]
    | Vrai          -> [[Non Faux]]
    | Non(Faux)     -> [[Non Faux]]
    | Var p         -> [[prop]]
    | Non (Var p)   -> [[prop]]
    | Et(a,b)       -> union (mfc a) (mfc b)
    | Ou(a,b)       -> prod (mfc a) (mfc b)
    | Imp(a,b)      -> prod (mfc (Non a)) (mfc b)
    | Equ(a,b)      -> union (prod (mfc (Non a)) (mfc b))
                             (prod (mfc (Non b)) (mfc a))
    | Non(Non a)    -> mfc a
    | Non(Et(a,b))  -> prod (mfc (Non a)) (mfc (Non b))
    | Non(Ou(a,b))  -> union (mfc (Non a)) (mfc (Non b))
    | Non(Imp(a,b)) -> union (mfc a) (mfc (Non b))
    | _             -> failwith "Je ne comprends plus rien !";;

let rec enleve elt liste =
  match liste with
    | []   -> []
    | t::q -> if elt=t 
                then enleve elt q
                else t::(enleve elt q);;

let rec purge cl =
  match cl with
    | []   -> []
    | t::q -> if mem (Non t) q
                then purge (enleve (Non t) q)
                else t::(purge q);;

let (resolutions : clause -> clause -> forme_clausale)
 = fun cl1 cl2 ->
  let parcours l1 l2 =
    let rec parcours_rec liste =
      match liste with
        | [] -> []
        | (Non a)::q -> if mem a l2
	          then let r = purge (union (enleve (Non a) l1)
                                             (enleve a l2)) in
                      (if r = []
                         then [Faux] else r) :: (parcours_rec q)
                         else parcours_rec q
        | _::q -> parcours_rec q
    in parcours_rec l1
  in union (parcours cl1 cl2)  (parcours cl2 cl1);;

let succes fc =
  mem [Faux] fc;;

let paires liste =
  let rec prod_rec x lis1 =
    match lis1 with
      | []   -> []
      | y::q -> let ll = enleve y (enleve x liste) in
              ((x,y),ll)::(prod_rec x q)
  in
    let rec iter lis2 =
      match lis2 with
        | []   -> []
        | d::f -> (prod_rec d f) @ (iter f)
    in
      iter liste;;

let decision p =
  let rec essai ((x,y),l) =
    let liste_res = resolutions x y 
    in
      if succes liste_res
        then true
        else exists (fun r -> derive (r::l)) liste_res
  and
      derive = function
        | []  -> false
        | [c] -> false
        | l   -> exists essai (paires l)
  in
    derive (mfc  p);;


#let prop1 = analyse "(a et b) => a";;
prop1 : proposition = Imp (Et (Var "a", Var "b"), Var "a")
#mfc prop1;;
- : forme_clausale = [[Non (Var "a"); Non (Var "b"); Var "a"]]
#let prop2 = analyse "a => (a et b)";;
prop2 : proposition = Imp (Var "a", Et (Var "a", Var "b"))
#mfc prop2;;
- : forme_clausale = [[Non (Var "a"); Var "a"];
                     [Non (Var "a"); Var "b"]]
#let prop3 = analyse "(a => (a => b)) => b";;
prop3 : proposition = Imp (Imp (Var "a",
                           Imp (Var "a", Var "b")), Var "b")
#mfc prop3;;
- : forme_clausale = [[Var "a"; Var "b"];
                      [Non (Var "b"); Var "b"]]


#let prop = analyse "(n=>p) et (p=>(non f))
                     et ((non n)=>(non f)) et f";;
prop : proposition =
 Et
  (Imp (Var "n", Var "p"),
   Et
    (Imp (Var "p", Non (Var "f")),
     Et (Imp (Non (Var "n"), Non (Var "f")), Var "f")))
#decision prop;;
- : bool = true


#let prop = analyse "(((non e) => c) et (k ou (non c))
           et (m => (non d)) et (d <=> e) et (k => (e et m))
           et (e => k)) et vrai";;
prop : proposition =
 Et
  (Et
    (Imp (Non (Var "e"), Var "c"),
     Et
      (Ou (Var "k", Non (Var "c")),
       Et
        (Imp (Var "m", Non (Var "d")),
         Et
          (Equ (Var "d", Var "e"),
           Et (Imp (Var "k", Et (Var "e", Var "m")),
               Imp (Var "e", Var "k")))))),
   Vrai)
#decision prop;;
- : bool = true


> with(logic);
[bequal, bsimp, canon, convert/MOD2, convert/frominert,
    convert/toinert, distrib, dual, environ, randbool,
    satisfy, tautology]

> p:=((a &and b) &or (&not a &and c)) &implies (b &implies c);
       p := a &and b &or &not(a) &and c &implies b &implies c

> canon(p,{a,b,c},DNF);
&or(&and(&not(b), c, a),
    &and(&not(b), c, &not(a)),
    &and(&not(b), &not(c), a),
    &and(&not(b), &not(c), &not(a)),
    &and(c, a, b),
    &and(c, &not(a), b),
    &and(&not(c), &not(a), b))

> canon(p,{a,b,c},CNF);
                       &or(&not(b), c, &not(a))


> with(logic):

> # Premi�re proposition : (a T (b T a))

> for t in [`&and`, `&or`, `&implies`, `&iff`, `&nand`,
>           `&nor`,`&xor`] do
> if tautology(t(`a`, t(`b`,`a`)))
>   then printf(`pour %-8s la proposition est une
>                          tautologie\n`,`t`)
>   elif tautology(&not t(`a`, t(`b`,`a`)))
>     then printf(`pour %-8s la proposition est une
>                          antilogie\n`,`t`)
>     else printf(`pour %-8s la proposition est
>                          neutre\n`,`t`)
>     fi;
> od;
pour &and     la proposition est neutre
pour &or      la proposition est neutre
pour &implies la proposition est une tautologie
pour &iff     la proposition est neutre
pour &nand    la proposition est neutre
pour &nor     la proposition est neutre
pour &xor     la proposition est neutre

> # Deuxi�me proposition : ((b T a) T non (a T b))

> for t in [`&and`, `&or`, `&implies`, `&iff`, `&nand`,
>           `&nor`, `&xor`] do
> if tautology(t(t(`b`,`a`), &not t(`a`,`b`)))
>   then printf(`pour %-8s la proposition est une
>                         tautologie\n`,`t`)
>   elif tautology(&not t(t(`b`,`a`), &not t(`a`,`b`)))
>     then printf(`pour %-8s la proposition est une
>                          antilogie\n`,`t`)
>     else printf(`pour %-8s la proposition est
>                          neutre\n`,`t`)
>     fi;
> od;
pour &and     la proposition est une antilogie
pour &or      la proposition est une tautologie
pour &implies la proposition est neutre
pour &iff     la proposition est une antilogie
pour &nand    la proposition est une tautologie
pour &nor     la proposition est une antilogie
pour &xor     la proposition est une tautologie


> with(logic):

> for t in [`&and`, `&or`, `&implies`, `&iff`, `&nand`,
>           `&nor`, `&xor`] do
>   if tautology(t(t(`a`,`b`),`c`) &iff t(`a`,t(`b`,`c`)))
>      then printf(`%-8s est associatif\n`,`t`)
>      else printf(`%-8s n'est pas associatif\n`,`t`)
>   fi;
> od;
> 
&and     est associatif
&or      est associatif
&implies n'est pas associatif
&iff     est associatif
&nand    n'est pas associatif
&nor     n'est pas associatif
&xor     est associatif


> with(logic):

> bsimp(a &nand a);
                               &not(a)

> bsimp(&not a &nand &not b);
                               a &or b

> bsimp((a &nand b) &nand (a &nand b));
                               a &and b

> bsimp(a &nand true);
                               &not(a)

> bsimp((a &nand b) &nand true);
                               b &and a

> bsimp((a &nand true) &nand (b &nand true));
                               b &or a


> with(logic):

> bsimp(&not(a &and b) &and (a &or (&not b)) &and (a &or b));
                            a &and &not(b)


> with(logic):

> canon((((&not p) &or q) &and r) &iff (p &xor r),{p,q,r},DNF);
&or(&and(&not(p), r, q), &and(&not(p), r, &not(q)),
    &and(p, r, &not(q)), &and(&not(r), &not(p), q),
    &and(&not(r), &not(p), &not(q)))

> canon((((&not p) &or q) &and r) &iff (p &xor r),{p,q,r},CNF);
&and(&or(&not(p), q, r), &or(&not(p), r, &not(q)),
     &or(&not(p), &not(r), &not(q)))


> with(logic):

> tautology(&not (a &and b) &iff (&not a &or &not b));
                                 true


> with(logic):

> bsimp((p &and q) &or r &or (&not q &and &not r)
>            &or (&not p &and &not r));
                                 true

> bsimp(p &or (&not p &and r) &or (&not q &and &not r)
>            &or (q &and &not r));
                                 true

> tautology((p &and q) &or r &or (&not q &and &not r)
>             &or (&not p &and &not r));
                                 true

> tautology(p &or (&not p &and r) &or (&not q &and &not r)
>             &or (q &and &not r));
                                 true