program ANAL_DON;                  {24.11.91}

uses CRT, PROC_COM;

const
   E = 2.17   ;
   J9 = 8;                                                 // nbre de fonction Y=f(X)
   DATA : array[1..J9,1..3] of string[9] = (('Y = ',' + ',' * X'),
                                            ('Y = ',' * X ** ',' '),
                                            ('Y = ',' * E ** (',' * X)'),
                                            ('Y = ',' + ',' * LOG(X)'),
                                            ('Y = X / (',' * X + ',')'),
                                            ('Y = ',' + ',' * 1 / X'),
                                            ('Y = ',' + ',' SQRT(X)'),
                                            ('Y = ',' + ',' X * X') );

type
  TCH3 = string[3];
var
  SX, SY, SXY, SX2, SY2 : array[1..J9] of real;  // sommes de X, Y, ...
  LIGNE : string[78];
  I, CHOIX, NBRE, NUMEQUAT : byte;
  COEF_A, COEF_B, COEF_R2 : real;
  ABSX, ORDY : real;
  CH : char;
  TESTEQUAT : array[1..J9] of boolean;

function PUIS ( X, Y : real) : real; { Calcul de X ‚lev‚ … la puissance Y }
begin
  PUIS := EXP( Y * LN(X) );
end;


procedure P_TEST_X_Y(J : byte; var R2 : real);
                     {X ou Y n‚gatif ou ‚gal … 0}
begin
{  case J of
  2 : if (IUN <> ' ') or (IDE <> ' ') then R2 := 0;
  3 : if IDE <> ' ' then R2 := 0;
  4 : if IUN <> ' ' then R2 := 0;
  5 : if (IUN = 'X=0') or (IDE = 'Y=0') then R2 := 0;
  6 : if IUN = 'X=0' then R2 := 0;
  7 : if IUN = 'X<0' then R2 := 0;
  end;                             }
  if not TESTEQUAT[J] then R2 := 0;
end;

procedure P_CAL_SOM( J : byte; V, W : real);
                                                   {calcul des sommes}
begin
  SX[J] := SX[J] +  V;
  SY[J] := SY[J] +  W;
  SXY[J] := SXY[J] +  V * W;
  SX2[J] := SX2[J] +  V * V;
  SY2[J] := SY2[J] +  W * W;
end;

procedure P_CAL_YdeX( J : byte; A, B, X : real; var Y : real);
                                                           {Calcul de Y à partir de X}
begin
  case J of
  1 : Y := A + B * X;
  2 : Y := A * PUIS(X , B);
  3 : Y := A * PUIS(E, B*X);
  4 : Y := A + B * LN(X);
  5 : Y := X / ( A*X + B);
  6 : Y := A + B / X;
  7 : Y := A + B * SQRT(X);
  8 : Y := A + B * X * X ;
  end;
end;

procedure P_TEST_EQUAT;
                  {equations test‚es}
var
  J : byte;
begin
  writeln;
  for J := 1 to J9 do
  begin
    if TESTEQUAT[J] then
    begin
      gotoxy(4,wherey);
      writeln(J:2,' - ',DATA[J,1],' A ',DATA[J,2],' B ',DATA[J,3]);
    end;
  end;
end;

procedure P_AFFICH( M : byte; A, B, R :real; N : byte);
                  {affichage}
var VARIANCE : real;
begin
  writeln;
  writeln('   Equations de base  test‚es');
  P_TEST_EQUAT;
  writeln;
  writeln('   Equation de la meilleure courbe repr‚sentative');
  writeln(' ',DATA[M,1], A:10:4, DATA[M,2], B:10:4, DATA[M,3]);
  writeln;
  writeln(' R2 = ',R:10:4,'  -  R = ', sqrt(r) );
  VARIANCE := (SY2[M]-sqr(SY[M])/N)*(1-R)/(N-2);
       {  (SY2[M]/(N-1)-sqr(SY[M])/(N-1)/N)*(1-R);  }
  if VARIANCE >= 0 then
  begin
    writeln(' Ecart type Y/X : ', sqrt( VARIANCE ));
    if 1-R>0 then
    begin
      writeln(' T de Student   : ', sqrt(R*(N-2)/(1-R)) );
      writeln(' Nbre de degr‚ de libert‚ : ', N-2 );
    end;
  end;
  CH := readkey;
end;

procedure P_CAL_A_B( M, N : byte; var A, B :real);
                                                             {calcul de A et B}
begin
  B := (SXY[M]-SX[M]*SY[M]/N) / (SX2[M]-SX[M]*SX[M]/N);
  A := SY[M]/N - B*SX[M]/N;
  if (M=2) or (M=3) then A := exp(A);
end;

procedure P_CAL_R2( J, N : byte; var R2 : real);
                                                                {Calcul de R2}
var  N2 : real;
begin
  N2 := SXY[J]-SX[J]*SY[J]/N;
  R2 := N2*N2 / (SX2[J]-SX[J]*SX[J]/N) / (SY2[J]-SY[J]*SY[J]/N);
end;

procedure P_CAL_R2MAX( N :byte; var R : real; var M : byte);
                  {Calcul de R2 max}
var J : byte;
    R2 : real;
begin
  R := 0;
  M := 0;
  for J := 1 to J9 do
  begin
    P_CAL_R2(J,N,R2);
{    P_TEST_X_Y(J,R2); }     if not TESTEQUAT[J] then R2 := 0;
    if R2 > R then
    begin
      R := R2;
      M := J;
    end;
  end;
end;

procedure P_INIT( var N : byte);
                                                            {Initialisation}
var J : byte;
begin
  for J := 1 to J9 do
  begin
    SX[J] := 0;
    SY[J] := 0;
    SXY[J] := 0;
    SX2[J] := 0;
    SY2[J] := 0;
    TESTEQUAT[J] := true;
  end;
  N := 0;
end;

procedure P_SOMMES(var N : byte);
                                                           {Calcul des sommes}
var
  I, P : byte;
  X, Y : real;

begin
  writeln;
  write('Nbre de POINTS : ');
  repeat
    readln(P);
    if P < 3  then writeln('    IL FAUT PLUS DE 3 POINTS  ****** : ');
  until P > 3;
  for I:=1 to P do
  begin
    write('    Donner X et Y : '); readln(X,Y);
    P_CAL_SOM(1,X,Y);
    if (X > 0) and (Y > 0) then P_CAL_SOM(2,ln(X),ln(Y))
                           else TESTEQUAT[2] := false;
    if (Y > 0) then P_CAL_SOM(3,X,ln(Y))
               else TESTEQUAT[3] := false;
    if (X > 0) then P_CAL_SOM(4,ln(X),Y)
               else TESTEQUAT[4] := false;
    if (X<>0) and (Y<>0) then P_CAL_SOM(5,1/X,1/Y)
                         else TESTEQUAT[5] := false;
    if (X<>0) then P_CAL_SOM(6,1/X,Y)
              else TESTEQUAT[6] := false;
    if (X>=0) then P_CAL_SOM(7,sqrt(X),Y)
              else TESTEQUAT[7] := false;
    P_CAL_SOM(8,X*X,Y);
  end;
  N := P;
end;

procedure MENU(var I : byte);
begin
  clrscr;
  LIGNE:= '   1 - Introduction des DONNEES';
  AFFLIGN(LIGNE,3);
  LIGNE:= '   2 - Calcul de la meilleure APPROXIMATION';
  AFFLIGN(LIGNE,4);
  LIGNE:= '   3 - Param‚tres d''une ‚quation d‚termin‚e';
  AFFLIGN(LIGNE,5);
  LIGNE:= '   4 - Estimation de Y … partir de X';
  AFFLIGN(LIGNE,6);
  LIGNE:= '   5 - Approximation d''une nouvelle s‚rie';
  AFFLIGN(LIGNE,7);
  LIGNE:= '   9 - TERMINE';
  AFFLIGN(LIGNE,8);
  LIGNE:= '       Quel EST votre CHOIX : ';
  AFFLIGN(LIGNE,10);
  readln(I);
end;

begin
  COULEUR('T');
  P_INIT(NBRE);

  repeat
  MENU(CHOIX);
  case CHOIX of
  1 : begin
        P_SOMMES(NBRE);
      end;
  2 : begin
        P_CAL_R2MAX(NBRE,COEF_R2,NUMEQUAT);
        P_CAL_A_B(NUMEQUAT,NBRE,COEF_A,COEF_B);
        P_AFFICH(NUMEQUAT,COEF_A,COEF_B,COEF_R2,NBRE);
      end;
  3 : begin
        P_TEST_EQUAT;
        write('  Quel Nø d''‚quation ? : '); readln(I);
        P_CAL_R2(I, NBRE,COEF_R2); NUMEQUAT := I;
        P_CAL_A_B(NUMEQUAT,NBRE,COEF_A,COEF_B);
        P_AFFICH(NUMEQUAT,COEF_A,COEF_B,COEF_R2,NBRE);
      end;
  4 : begin
        write('  Donner X : '); readln(ABSX);
        P_CAL_YdeX(NUMEQUAT,COEF_A,COEF_B,ABSX,ORDY);
        writeln('  Pour X = ',ABSX,'  Y = ',ORDY);
        CH := readkey;
      end;
  5 : begin
        P_INIT(NBRE);
      end;
  end;

  until CHOIX > 5;
end.