(*
Fichier : récursivité.pas
Description : TD2 Pascal : Conversion d'exercices du TD de révision et de récursivité.
Auteur : INGOUFF Christian
Dates : 24/11/11 (1.0), 28/11/11 (1.1), 1/12/11 (1.2)
Version : 1.2
*)

program TDPascal2;

(*
Procédure : calculImc
Description : Conversion de l'exercice 1 du TD révision en Pascal
Auteur : INGOUFF Christian
Date : 23/11/11 (1.0)
Version : 1.0
Variables : weight (réel) : Masse en kg (positif)
	    height (réel) : Taille en m (positif)
Retour : Indique l'état de santé ainsi que le nécessaire pour avoir une corpulence normale
*)

procedure calculImc;
var
weight, height, imc: real;
begin
	weight := -1;
	height := -1;

	while weight < 0 do
		begin	
		writeln('Entrez votre masse (en kg)');
		readln(weight);
		if weight<0 then
			writeln('Veuillez entrer une masse positive !');
		end;

	while height < 0 do
		begin
		writeln('Entrez votre taille (en m)');
		readln(height);
		if height<0 then
			writeln('Veuillez entrer une taille positive !');
		end;

	imc := weight/(height*height);
	writeln('Votre IMC est de : ',imc);

	if imc < 16.5 then
		writeln('Attention, vous êtes en dénutrition !')
	else if imc < 18.5 then
		writeln('Vous êtes maigre !')
	else if imc < 25 then
		writeln('Vous avez une corpulence normale.')
	else if imc < 30 then
		writeln('Vous êtes en surpoids.')
	else writeln('Attention, vous êtes obèse !');

	if imc < 18.5 then
		write(' Il vous faut gagner ',18.5-imc,' kg pour avoir une corpulence normale')
	else if imc > 25 then
		write(' Il vous faut perdre ',imc-25,' kg pour avoir une corpulence normale');
end;

(*
Fichier : money
Description : Conversion de l'exercice 2 du TD révision en Pascal
Auteur : INGOUFF Christian
Date : 23/11/11 (1.0)
Version : 1.0
Variables : input : La somme d'argent à décomposer (positif)
Retour : Le nombre de pièces de 1, de 2, et le nombre de billets de 5 et de 10 qu'il faut pour atteindre une somme d'argent définie
*)

procedure money;
var
input, nb10, nb5, nb2: integer;
begin
	input := -1;

	while input < 0 do
		begin
		writeln('Saisir une somme d''argent');
		readln(input);
		if input < 0 then writeln('Veuillez saisir une somme d''argent positive !');
		end;

	writeln('Pour avoir ',input,' €, il vous faut :');

	nb10 := input div 10;
	input := input mod 10;
	nb5 := input div 5;
	input := input mod 5;
	nb2 := input div 2;
	input := input mod 2;

	if nb10 = 1 then
		writeln('- ',nb10,' billet de 10')
	else if nb10 > 0 then
		writeln('- ',nb10,' billets de 10');
	if nb5 > 0 then
		writeln('- ',nb5,' billet de 5');
	if nb2 = 1 then
		writeln('- ',nb2,' pièce de 2')
	else if nb2 > 0 then
		writeln('- ',nb2,' pièces de 2');
	if input > 0 then
		writeln('- ',input,' pièce de 1');
end;

(*
Fonction : fiboNonTerm
Description : Suite de Fibonacci (notée F(n)) en récursivité non terminale
Auteur : INGOUFF Christian
Date : 24/11/11
Variables : nb (entier) : Correspond à n dans F(n), n >= 0
Retour (entier) : La valeur de F(n) pour n = nb
*)

function fiboNonTerm(nb : integer):integer;
begin
	if nb <= 1 then
		fiboNonTerm := nb
	else
		fiboNonTerm := fiboNonTerm(nb-1) + fiboNonTerm(nb-2);
end;

(*
Fonction : fiboTermA
Description : Suite de Fibonacci (notée F(n)) en récursivité terminale
Auteur : INGOUFF Christian
Date : 24/11/11
Variables : nb (entier) : Correspond à n dans F(n), n >= 0
	    fn2 (entier) : Correspond à F(n-2), valeur initiale F(0) = 0
	    fn1 (entier) : Correspond à F(n-1), valeur initiale F(1) = 1
Retour (entier) : La valeur de F(n) pour n = nb
Initialisation avec fiboTerm.
*)

function fiboTermA(fn2, fn1, nb:integer):integer;
begin
	if nb = 0 then
		fiboTermA := fn2
	else
		fiboTermA := fiboTermA(fn1, fn1+fn2, nb-1);
end;

function fiboTerm(nb:integer):integer;
begin
	fiboTerm := fiboTermA(0,1,nb);
end;

(*
Fonction : divent (Ex1 récursivité)
Description : Division entière de 2 entiers naturels en récursivité non terminale (exercice 1 TD récursivité)
Auteur : INGOUFF Christian
Date : 24/11/11
Variables : a (entier) : 1er terme dans l'opération (celui à gauche), a >= 0
	    b (entier) : 2è terme dans l'opération (celui à droite), b > 0
Retour (entier) : Le quotient des 2 termes
*)

function divent(a,b:integer):integer;
begin
	if a<b then
		divent := 0
	else
		divent := divent(a-b,b)+1;
end;

(*
Fonction : diventTermA (Ex1 récursivité)
Description : Division entière en récursivité terminale
Auteur : INGOUFF Christian
Date : 24/11/11
Variables : a (entier) : 1er terme de l'opération, a >= 0
	    b (entier) : 2è terme de l'opération, b > 0
	    acc (entier) : "Accumulateur"
Retour (entier) : Le quotient des 2 termes
Initialisation avec diventTerm.
*)

function diventTermA(a,b,acc:integer):integer;
begin
	if a<b then
		diventTermA := acc
	else
		diventTermA := diventTermA(a-b,b,acc+1);
end;

function diventTerm(a,b:integer):integer;
begin
	diventTerm := diventTermA(a,b,0);
end;

(*
Fonction : reste (Ex2 récursivité)
Description : Affiche le reste de la division euclidienne de 2 entiers naturels
Auteur : INGOUFF Christian
Date : 24/11/11
Variables : a (entier) : 1er terme de l'opération, a >= 0
	    b (entier) : 2è terme de l'opération, b > 0
Retour (entier) : Le reste de la division des 2 termes
*)

function reste(a,b:integer):integer;
begin
	if a<b then
		reste := a
	else
		reste := reste(a-b,b);
end;

(*
Fonction : multNonTerm (Ex3 révision)
Description : Multiplication de 2 entiers naturels seulement avec l'addition entière (non terminal)
Auteur : INGOUFF Christian
Date : 24/11/11
Variables : a (entier) : 1er terme de l'opération, a >= 0
	    b (entier) : 2è terme de l'opération, b >= 0
Retour (entier) : Le produit des 2 termes
*)

function multNonTerm(a,b:integer):integer;
begin
	if b=0 then
		multNonTerm := 0
	else
		multNonTerm := multNonTerm(a,b-1)+a;
end;

(*
Fonction : multTermA (Ex3 révision)
Description : Multiplication de 2 entiers naturels seulement avec l'addition entière (terminal)
Auteur : INGOUFF Christian
Date : 24/11/11
Variables : a (entier) : 1er terme de l'opération, a >= 0
	    b (entier) : 2è terme de l'opération, b >= 0
	    acc (entier) : "Accumulateur"
Retour (entier) : Le produit des 2 termes
Initialisation avec multTerm.
*)

function multTermA(a,b,acc:integer):integer;
begin
	if b=0 then
		multTermA := acc
	else
		multTermA := multTermA(a,b-1,acc+a);
end;

function multTerm(a,b:integer):integer;
begin
	multTerm := multTermA(a,b,0);
end;

(*
Procédure : hanoi
Description : Etude des tours de Hanoi
Auteur : INGOUFF Christian
Date : 24/11/11
Variables : n (entier) : Nombre de disques, n > 0
	    de (entier) : Origine des disques
	    vers (entier) : Destination des disques
	    par (entier) : Intermédiaire
	    total (entier) : Rappel de n
Retour : Instructions pour les tours de Hanoi, avec la trame.
Initialisation avec hanoiTest.
*)

procedure hanoi(n,de,vers,par,total:integer);
var
i : integer;
begin
	if n > 0 then
	begin
		for i:=0 to (total-n) do
			write('  ');
		writeln('hanoi(',n-1,',',de,',',par,',',vers,')');
		hanoi(n-1,de,par,vers,total);
		for i:=0 to (total-n) do
			write('  ');
		writeln('Bouger disque ',de,' vers ',vers);
		for i:=0 to (total-n) do
			write('  ');
		writeln('hanoi(',n-1,',',par,',',vers,',',de,')');
		hanoi(n-1,par,vers,de,total);
	end;
end;

procedure hanoiTest(n:integer);
begin
	hanoi(n,1,3,2,n);
end;


(*
Fonction : existeIterative (Ex4 révision)
Description : Indique si un chiffre donné se trouve dans un autre nombre (exercice 4 TD révision, en itératif)
Auteur : INGOUFF Christian
Date : 28/11/11
Variables : n (entier) : le nombre à scanner
	    i (entier) : le chiffre à vérifier (de 0 à 9)
Retour (entier) : VRAI si i est dans n, FAUX sinon.
*)

function existeIterative(n,i:integer):boolean;
var
nb:integer;
begin
	nb := n;
	while nb > 0 do
	begin
		existeIterative := nb mod 10 = i;
		if existeIterative then
			nb := 0
		else
			nb := nb div 10;
	end;
end;

(*
Fonction : existeRecursive (Ex4 révision)
Description : Indique si un chiffre donné se trouve dans un autre nombre (exercice 4 TD révision, en récursif)
Auteur : INGOUFF Christian
Date : 28/11/11
Variables : n (entier) : le nombre à scanner
	    i (entier) : le chiffre à vérifier (de 0 à 9)
Retour (entier) : VRAI si i est dans n, FAUX sinon.
*)

function existeRecursive(n,i:integer):boolean;
begin
	if n=0 then
		existeRecursive := FALSE
	else 
	begin
		existeRecursive := n mod 10 = i;
		if not existeRecursive then existeRecursive := existeRecursive(n div 10,i);
	end;
end;

(*
Fonction : palindrome (Ex3 récursivité)
Description : Vérifie si une chaîne de caractères est un palindrome (en omettant les espaces avec la fonction trim)
Auteur : INGOUFF Christian
Date : 30/11/11
Variables : c (chaîne) : La phrase ou le mot à vérifier
Retour (entier) : VRAI si la chaîne est un palindrome, FAUX sinon.
Initialisation avec palind.
*)

function trim(c:string):string;
var
i, lg: integer;
begin
	trim := '';
	lg := length(c);
	for i:=1 to lg do
		if (c[i]<>(' ')) then
			trim := trim+c[i];
end;

function palindrome(c:string;i:integer):boolean;
var
lg : integer;
begin
	lg := length(c);
	palindrome := i>lg;
	if not palindrome then
	begin
		palindrome := c[i]=c[lg-i+1];
		if palindrome then
			palindrome := palindrome(c,i+1);
	end;
end;

function palind(c:string):boolean;
begin
	palind := palindrome(trim(c),1);
end;

(*
Fonction : miroir (Ex4 récursivité)
Description : Retourne un mot ou une phrase à l'envers
Auteur : INGOUFF Christian
Date : 30/11/11
Variables : c (chaîne) : phrase ou mot à inverser (non vide)
	    res (chaîne) : Accumulateur
	    i (entier) : Position du caractère
	    lg (entier) : Longueur de la chaîne
Retour (entier) : La phrase ou le mot à l'envers
Initialisation : noitcnuf est initialisée par miroir.
*)

function noitcnuf(c,res:string;i,lg:integer):string;
begin
	if i<=lg then
		noitcnuf := noitcnuf(c,c[i]+res,i+1,lg)
	else
		noitcnuf := res;
end;

function miroir(c:string):string;
begin
	miroir := noitcnuf(c,'',1,length(c));
end;

(*
Fonction : puissDic (Ex5 récursivité)
Description : Calcule n^k avec la dichotomie, en terminal
Auteur : INGOUFF Christian
Date : 30/11/11
Variables : n (réel) : nombre auquel on applique la puissance
	    res (réel) : Accumulateur
	    k (entier) : exposant (entier relatif)
Retour (entier) : n^k
Initialisation avec puissance.
*)

function puissDic(n,res:real;k:integer):real;
begin
	if k<0 then
	begin
		puissDic := puissDic(n,res,-k);
		puissDic := 1/puissDic;
	end
	else
	begin
		if k=0 then
			puissDic := res
		else if k mod 2 = 0 then
			puissDic := puissDic(n,res*n,k-1)
		else
			puissDic := puissDic(n*n,res*n,k div 2);
	end;
end;

function puissance(n:real;k:integer):real;
begin
	puissance := puissDic(n,1,k);
end;

(*
Fonction : zerofct (Ex7 révision)
Description : Calcule la racine d'une fonction affine f définie
Auteur : INGOUFF Christian
Date : 1/12/11
Variables : x (réel) : Correspond à x dans f(x)
	    k (réel) : Correspond à A dans la fonction affine Ax + b
	    r (réel) : Correspond à b dans la fonction affine Ax + b
	    a (réel) : Borne inférieure de la recherche
	    b (réel) : Borne supérieure de la recherche
	    eps (réel) : Correspond à epsilon, la précision de la recherche (strictement positif)
	    Il faut que f(a) et f(b) ne soient pas de même signe pour que zerofct retourne quelque chose.
Retour (entier) : La racine de la fonction affine f
*)

function f(x,k,r:real):real;
begin
        f := k*x+r;
end;

function zerofct(k,r,a,b,eps:real):real;
var
mid : real;
begin
        mid := (a+b)/2;
        if abs(a-b)>eps then
        begin
                if (f(mid,k,r)*f(a,k,r)>0) then
			zerofct := zerofct(k,r,mid,b,eps)
                else
			zerofct := zerofct(k,r,a,mid,eps);
        end
        else
		zerofct := mid;
end;

function caca(c: string; i:integer):boolean;
begin
	if i < length(c) then
	begin
		caca := c[i] > c[i+1];
		if caca then caca := caca(c,i+1);
	end
	else caca := TRUE;
end;

var
chaine1: string;
terme1,terme2,fonction,result: integer;
real1, real2, real3, k, r: real;
resultbool: boolean;
resultstr: string;
resultreal: real;
begin
	writeln('Choisissez une fonction/procédure :');
	writeln('- -1 pour caca : Bourrin !');
	writeln('- 1 pour calculImc : Cette procédure calcule l''IMC et indique l''état de santé, ainsi que le nécessaire pour avoir une corpulence normale');
	writeln('- 2 pour money : Cette procédure calcule le nombre de pièces de 1, de 2, et le nombre de billets de 5 et de 10 qu''il faut pour atteindre une somme d''argent définie');
	writeln('- 3 pour fiboNonTerm : Cette fonction calcule F(n), la suite de Fibonacci (récursivité non terminale)');
	writeln('- 4 pour fiboTerm : Cette fonction calcule F(n), la suite de Fibonacci (récursivité terminale)');
	writeln('- 5 pour divent : Cette fonction effectue la division entière entre 2 entiers exclusivement avec l''addition entière (récursivité non terminale)');
	writeln('- 6 pour diventTerm : Cette fonction effectue la division entière entre 2 entiers exclusivement avec l''addition entière (récursivité terminale)');
	writeln('- 7 pour reste : Cette fonction calcule le reste de la division entière entre 2 entiers (récursivité terminale)');
	writeln('- 8 pour multNonTerm : Cette fonction effectue la multiplication entre 2 entiers (récursivité non terminale)');
	writeln('- 9 pour multTerm : Cette fonction effectue la multiplication entre 2 entiers (récursivité terminale)');
	writeln('- 10 pour hanoi : Cette procédure renvoie des instructions pour les Tours de Hanoi pour un nombre de disques défini (avec la trame)');
	writeln('- 11 pour existeIterative : Cette fonction vérifie si un chiffre se trouve dans un nombre (en itératif)');
	writeln('- 12 pour existeRecursive : Cette fonction vérifie si un chiffre se trouve dans un nombre (en récursif)');
	writeln('- 13 pour palindrome : Cette fonction vérifie si un mot ou une phrase est un palindrome (en faisant abstraction des espaces ; récursif terminal)');
	writeln('- 14 pour miroir : Cette fonction inverse l''ordre des lettres d''une phrase ou d''un mot (en récursif terminal)');
	writeln('- 15 pour puissance : Cette fonction calcule la puissance d''un réel par un entier relatif (en récursif terminal, avec la dichotomie)');
	writeln('- 16 pour zerofct : Cette fonction détermine la racine d''une fonction affine définie avec la dichotomie (en récursif terminal)');
	writeln('- 0 pour quitter');
	readln(fonction);
	case fonction of
		-1 :	begin writeln('chaîne à vérifier'); readln(chaine1); resultbool := caca(chaine1,1); if resultbool then writeln('Yep') else writeln('Nope.avi'); end;
		0 :     write('');
		1 :	calculImc;
		2 :	money;
		3 :	begin
				repeat
					writeln('Suite de Fibonacci F(n) : entrez n');
					readln(terme1);
					if terme1 < 0 then
						writeln('Une suite est définie pour les entiers positifs !')
				until terme1 >= 0;
				result := fiboNonTerm(terme1);
				writeln('F(',terme1,') = ',result,' (non terminal !)');
			end;
		4 : 	begin
				repeat
					writeln('Suite de Fibonacci F(n) : entrez n');
					readln(terme1);
					if terme1 < 0 then
						writeln('Une suite est définie pour les entiers positifs !')
				until terme1 >= 0;
				result := fiboTerm(terme1);
				writeln('F(',terme1,') = ',result,' (terminal !)');
			end;
		5 :	begin
				repeat
					writeln('Division entière : entrez un entier');
					readln(terme1);
					if terme1 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
				until terme1 >= 0;
				repeat
					writeln('Entrez un 2ème entier');
					readln(terme2);
					if terme2 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
					else if terme2 = 0 then
						writeln('La division par 0 n''est pas possible sur cette fonction')
				until terme2 > 0;
				result := divent(terme1,terme2);
				writeln(terme1,' / ',terme2,' = ',result,' (non terminal !)');
			end;
		6 :	begin
				repeat
					writeln('Division entière : entrez un entier');
					readln(terme1);
					if terme1 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
				until terme1 >= 0;
				repeat
					writeln('Entrez un 2ème entier');
					readln(terme2);
					if terme2 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
					else if terme2 = 0 then
						writeln('La division par 0 n''est pas possible sur cette fonction')
				until terme2 > 0;
				result := diventTerm(terme1,terme2);
				writeln(terme1,' / ',terme2,' = ',result,' (terminal !)');
			end;
		7 :	begin
				repeat
					writeln('Calcul du reste : entrez un entier');
					readln(terme1);
					if terme1 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
				until terme1 >= 0;
				repeat
					writeln('Entrez un 2ème entier');
					readln(terme2);
					if terme2 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
					else if terme2 = 0 then
						writeln('Erreur : division par 0')
				until terme2 > 0;
				result := reste(terme1,terme2);
				writeln(terme1,' mod ',terme2,' = ',result);
			end;
		8 :	begin
				repeat
					writeln('Multiplication entière : entrez un entier');
					readln(terme1);
					if terme1 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
				until terme1 >= 0;
				repeat
					writeln('Entrez un 2ème entier');
					readln(terme2);
					if terme2 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
				until terme2 >= 0;
				result := multNonTerm(terme1,terme2);
				writeln(terme1,' x ',terme2,' = ',result,' (non terminal !)');
			end;
		9 :	begin
				repeat
					writeln('Multiplication entière : entrez un entier');
					readln(terme1);
					if terme1 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
				until terme1 >= 0;
				repeat
					writeln('Entrez un 2ème entier');
					readln(terme2);
					if terme2 < 0 then
						writeln('Cette fonction ne fonctionne que pour les entiers positifs')
				until terme2 >= 0;
				result := multTerm(terme1,terme2);
				writeln(terme1,' x ',terme2,' = ',result,' (terminal !)');
			end;
		10 : 	begin
				repeat
					writeln('Tours de Hanoi : entrer le nombre de disques');
					readln(terme1);
					if terme1 <= 0 then
						writeln('Il faut au moins un disque !')
				until terme1 > 0;
				hanoiTest(terme1);
			end;
		11 :	begin
				writeln('Existe : Entrez l''entier à scanner');
				readln(terme1);
				repeat
					writeln('Entrez le chiffre à vérifier');
					readln(terme2);
					if (terme2 < 0) or (terme2 > 9) then
						writeln('Un chiffre se trouve entre 0 et 9')
				until (terme2 >= 0) and (terme2 <= 9);
				resultbool := existeIterative(terme1,terme2);
				if resultbool then
					writeln(terme2,' est dans ',terme1,' (pas récursif)')
				else
					writeln(terme2,' n''est pas dans ',terme1,' (pas récursif)');
			end;
		12 :	begin
				writeln('Existe : Entrez l''entier à scanner');
				readln(terme1);
				repeat
					writeln('Entrez le chiffre à vérifier');
					readln(terme2);
					if (terme2 < 0) or (terme2 > 9) then
						writeln('Un chiffre se trouve entre 0 et 9')
				until (terme2 >= 0) and (terme2 <= 9);
				resultbool := existeRecursive(terme1,terme2);
				if resultbool then
					writeln(terme2,' est dans ',terme1,' (récursif)')
				else
					writeln(terme2,' n''est pas dans ',terme1,' (récursif)');
			end;
		13 :	begin
				repeat
					writeln('Palindrome : Entrez la phrase ou le mot à vérifier');
					readln(chaine1);
					if chaine1 = '' then
						writeln('Une chaîne vide n''est pas un palindrome')
				until chaine1 <> '';
				resultbool := palind(chaine1);
				if resultbool then
					writeln(chaine1,' est un palindrome')
				else
					writeln(chaine1,' n''est pas un palindrome');
			end;
		14 :	begin
				repeat
					writeln('Miroir : Entrez la phrase ou le mot à retourner');
					readln(chaine1);
					if chaine1 = '' then
						writeln('Une chaîne vide ne peut pas être retournée')
				until chaine1 <> '';
				resultstr := miroir(chaine1);
				writeln(chaine1,' à l''envers donne : ',resultstr);
			end;
		15 :	begin
				writeln('Puissance : Entrez le 1er terme (celui en bas)');
				readln(real1);
				writeln('Entrez le 2ème terme (celui en exposant)');
				readln(terme2);
				resultreal := puissance(real1,terme2);
				writeln(real1,' ^ ',terme2,' = ',resultreal);
			end;
		16 :	begin
			        writeln('Définition de la fonction affine de la forme Kx + R :');
			        writeln('Veuillez définir K');
			        readln(k);
			        writeln('Veuillez définir R');
			        readln(r);
			        writeln('Recherche de la racine de la fonction :');
			        writeln('Veuillez définir la borne inférieure de la recherche');
			        readln(real1);
			        writeln('Veillez définir la borne supérieure de la recherche');
			        readln(real2);
				repeat
					writeln('Veuillez définir la précision de la recherche (distance entre les bornes)');
			        	readln(real3);
					if real3 <= 0 then
						writeln('La précision doit être positive')
				until real3 > 0;
			        if f(real1,k,r)*f(real2,k,r)>0 then
					writeln('La racine de la fonction ne se trouve pas entre ',real1,' et ',real2)
			        else
		        	begin
		        	        resultreal := zerofct(k,r,real1,real2,real3);
		        	        writeln('La racine de ',k,'x + ',r,'est :');
		        	        writeln(resultreal);
		        	        writeln('(à ',real3,' près)');
		        	end;
			end;
	else writeln('Fonction non reconnue !');
	end;
	readln;
end.
(*niabon*)