PROGRAM epreuve03; { Laurent PARISE 2002 ------------------------------------}

uses crt;

const MAX  = 1000;
      MAX2 = 100;

type  tableau = record
                  tab : array[1..MAX] of integer;
                  taille : 0..MAX;
                end;
                
type  tableauchar = array[1..MAX2] of string[5];
type  fonction    = function(x:real):real;

const achar : tableauchar = ('ac','aiozo','asqkj','atzyi','awkid','bbqus','bctrh','bek','biypq','cjh','ckp','ctyyy','dc','dmvs','ed','el','epxih','erc','evw','feoah','ffpjv','fhmzb','fmmfv','fxlqp','fylhl','fyopi','gkytg','gp','heppv','hsiga','hyxi','iamli','ifkvz','ii','iiklk','ikseb','iljis','imxyu','jpkrg','jud','jwuve','kajmx','kicwg','kijap','klayp','kvumo','kvwlr','kxzls','lsfqg','lyaor','mdlg','mgfht','mjtez','ndpf','noq','nqozt','nwdld','nxnek','okxk','ou','pfsg','phigz','pibyr','pjl','pllz','poi','pwei','qge','qkr','qlf','qmawg','qmvta','qpek','qxbwa','rgupu','rnjha','rzz','sblz','sfpiu','sgepr','sgzor','tbuxy','toft','tyfg','usaaj','vsurp','wifsp','xfenx','xqqan','xtyot','xtz','xyiei','ykab','zfeir','zhfjh','zl','zourf','zp','zrihi','zzpfw');

var a   : tableau;
    ins : integer;

{----------------------------------------------------------------------------}
{--------------------------     PARTIE I    ---------------------------------}
{----------------------------------------------------------------------------}

function f1(x:real):real;
  begin
    f1:=x*x*x+3*x+1;
  end;

function racine1(f:fonction;a,b,eps:real):real;    { version itérative de la }
  begin                                            { recherche d'une racine  }
    while abs(b-a)>eps do                          { de f sur [a,b]          }
      if (f((a+b)/2)*f(a)>0) then a:=(a+b)/2
                             else b:=(a+b)/2;
    racine1:=a;
  end;

function racine2(f:fonction;a,b,eps:real):real;    { version récursive       }
  begin
    if abs(b-a)<eps then racine2:=a
      else if (f((a+b)/2)*f(a)>0) then racine2:=racine2(f,(a+b)/2,b,eps)
                                  else racine2:=racine2(f,a,(a+b)/2,eps);
  end;

{----------------------------------------------------------------------------}
{--------------------------     PARTIE II    --------------------------------}
{----------------------------------------------------------------------------}

procedure affiche(var a:tableau);   { les fonctions d'affichage ne sont pas  }
  var i,j:integer;                  { demandées dans l'énoncé                }
  begin
    writeln;
    for i:=1 to (a.taille div 12) do
      begin
        for j:=1 to 12 do write(a.tab[12*(i-1)+j]:6);
        writeln;
      end;
    for j:=12*trunc(a.taille/12)+1 to a.taille do write(a.tab[j]:6);
    writeln;
  end;

procedure affichechar(var a:tableauchar);  { affichage du tableau de chaines }
  var i,j:integer;                         { de caractères                   }
  begin
    writeln;
    for i:=1 to (MAX2 div 10) do
      begin
        for j:=1 to 10 do write(a[10*(i-1)+j]:6);
        writeln;
      end;
    for j:=10*trunc(MAX2/10)+1 to MAX2 do write(a[j]:6);
    writeln;
  end;
  
{----------------------------------------------------------------------------}

procedure creation(var a:tableau;t:integer);
  var i:integer;
  begin
    a.tab[1]:=random(6)+1;
    for i:=2 to t do a.tab[i]:=a.tab[i-1]+random(6)+1;
    a.taille:=t;
  end;

{----------------------------------------------------------------------------}

function cherche1(var a:tableau;var insertion:integer;x:integer):integer;
  var u,v:integer;                                       { version itérative }
  begin
    u:=1; v:=a.taille; insertion:=((u+v) div 2);
    while ((u<=v) and (a.tab[insertion]<>x)) do
      begin
        if a.tab[insertion]<x then u:=insertion+1
                              else v:=insertion-1;
        insertion:=((u+v) div 2);
      end;

    if u>v then begin insertion:=u; cherche1:=0 end
           else cherche1:=insertion;
  end;

function cherche2(var a:tableau;var insertion:integer;x,u,v:integer):integer;
  begin                                                  { version récursive }
    if (u>v) then begin
                    insertion:=u;
                    cherche2:=0;
             end
             else begin
                    insertion:=((u+v) div 2);
                    if a.tab[insertion]=x
                      then cherche2:=insertion
                      else if a.tab[insertion]<x then cherche2:=cherche2(a,insertion,x,((u+v) div 2)+1,v)
                                                 else cherche2:=cherche2(a,insertion,x,u,((u+v) div 2)-1);
                  end;
  end;

{----------------------------------------------------------------------------}

function inserer(var a:tableau;x:integer):boolean;
  var i,insertion:integer;
  begin
    if ((a.taille=MAX) or (cherche1(a,insertion,x)<>0))
         then inserer:=false
         else begin
                for i:=a.taille downto insertion do a.tab[i+1]:=a.tab[i];
                a.tab[insertion]:=x;
                a.taille:=a.taille+1;
                inserer:=true;
              end;
  end;
  
{----------------------------------------------------------------------------}

function supprimer(var a:tableau;x:integer):boolean;
  var i,insertion:integer;
  begin
    if cherche1(a,insertion,x)=0
        then supprimer:=false
        else begin
               for i:=insertion to a.taille-1 do a.tab[i]:=a.tab[i+1];
               a.taille:=a.taille-1;
               supprimer:=true;
             end;
  end;

{----------------------------------------------------------------------------}

function cherche3(var a:tableauchar;var insertion:integer;x:string):integer;
  var u,v:integer;              { recherche de la chaîne x dans le tableau a }
  begin
    u:=1; v:=MAX2;
    while u<=v do
      begin
        insertion:=((u+v) div 2);
        if (a[insertion]=x) then begin
                                   cherche3:=insertion;
                                   exit;
                                 end
                            else if a[insertion]<x then u:=insertion+1
                                                   else v:=insertion-1;
      end;
    insertion:=u;
    cherche3:=0;
  end;
  
{----------------------------------------------------------------------------}
{-----------------------------   PARTIE III   -------------------------------}
{----------------------------------------------------------------------------}

function f2(x:real):real;
  begin
    f2:=2*x-x*x;
  end;
  
function f3(x:real):real;
  begin
    f3:=-sqrt(x*x*x/(x-1));
  end;

{----------------------------------------------------------------------------}

function fibo(n:integer):real;                        { if faut prendre n>=1 }
  var i,u0,u1,aux:integer;
  begin
    u0:=1; u1:=1;
    for i:=2 to n do
      begin
        aux:=u1;
        u1:=u0+u1; u0:=aux;
      end;
    fibo:=(u1-u0)/u1;
  end;
  
{----------------------------------------------------------------------------}

function concave(f:fonction;a,b:real;n:integer):real;
  var i             : integer;
      u1,v1,fu1,fv1 : real;
  begin
    v1:=b-fibo(n)*(b-a); u1:=a+b-v1;
    fu1:=f(u1); fv1:=f(v1);

    for i:=2 to n-1 do
      if fv1>fu1 then begin a:=u1; u1:=v1; v1:=a+b-u1; fu1:=fv1; fv1:=f(v1); end
                 else begin b:=v1; v1:=u1; u1:=a+b-v1; fv1:=fu1; fu1:=f(u1); end;
    concave:=u1;
  end;

{----------------------------------------------------------------------------}
{-----------------------------    PARTIE IV    ------------------------------}
{----------------------------------------------------------------------------}

function f4(x:real):real;
  begin
    f4:=abs(x)/(x*x+1);
  end;
  
{----------------------------------------------------------------------------}

function S(f:fonction;x,y:real):real;     { Aproximation de int(f(u),u=x..y) }
  begin                                   { par la méthode de Simpson        }
    S:=(y-x)*(f(x)+4*f((x+y)/2)+f(y))/6;
  end;

function simpson(f:fonction;u,v,eps:real):real;     {  Simpson dichotomique  }
  var S1,S2:real;
  begin
    S1:=S(f,u,v);
    S2:=S(f,u,(u+v)/2)+S(f,(u+v)/2,v);

    if (abs(S2-S1)<=eps)
       then simpson:=S1
       else simpson:=simpson(f,u,(u+v)/2,eps/2)
       +simpson(f,(u+v)/2,v,eps/2);
  end;

{----------------------------------------------------------------------------}
{------------------------    Programme principal    -------------------------}
{----------------------------------------------------------------------------}

BEGIN
  clrscr; randomize;
{ Partie I   ----------------------------------------------------------------}
  writeln('Valeur approchée de la racine de x^3+3*x+1 à 10^(-6) près. '); writeln;
  writeln('Par dichotomie itérative : ',racine1(@f1,-1,0,0.000001):6:6);
  writeln('Par dichotomie récursive : ',racine2(@f1,-1,0,0.000001):6:6);
{ Partie II  ----------------------------------------------------------------}
  creation(a,40);
  affiche(a);
  writeln;
  writeln('Recherche de 45 dans la liste précédente.'); writeln;
  write('Par une méthode itérative : ');
  if cherche1(a,ins,45)<>0 then writeln('position ',ins) else writeln('à insérer en position ',ins);
  write('Par une méthode récursive : ');
  if cherche2(a,ins,45,1,a.taille)<>0 then writeln('position ',ins) else writeln('à insérer en position ',ins);
  writeln;
  if inserer(a,45)   then begin
                            writeln('Insertion de 45 dans le tableau.');
                            affiche(a); writeln;
                          end;
  if supprimer(a,48) then begin
                            writeln('Suppression de 48 dans le tableau.');
                            affiche(a);
                          end;
  readkey; clrscr;
  affichechar(achar);
  if cherche3(achar,ins,'mjtez')<>0 then writeln('"mjtez" en position ',ins);
  if cherche3(achar,ins,'tey')=0 then writeln('"tey" à insérer en position ',ins);
  readkey; clrscr;
{ Partie III ----------------------------------------------------------------}
  writeln('Maximum d''une fonction concave'); writeln;
  writeln('Essai avec la fonction x -> 2*x-x^2 entre 0 et 2 : ',concave(@f2,0,2,18):3:5);
  writeln('Essai avec la fonction x -> -sqrt(x^3/(x-1)) entre 1.1 et 3 : ',concave(@f3,1.1,3,19):3:5);
  writeln;
{ Partie IV  ----------------------------------------------------------------}
  writeln('Approximation de int(|x|/(1+x^2),x=-1..1) : '); writeln;
  writeln('Avec Simpson classique : ',S(@f4,-1,1):3:6);
  writeln('Avec Simpson dichotomique : ',simpson(@f4,-1,1,0.0000001):3:6);
  readkey;
END.