# Linear Regression with Several Transformations

Language: Turbo Pascal.

Objective: This program performs the linear regression between a set of (X,Y) points, including the following transformations:

• Y = A + B * X
• Y = A * EXP(B * X)
• Y = A * X ^ B
• Y = A + B / X
• Y = 1 / (A + B * X)
• Y = X / (A + B * X)
• Y = A + B * LN(X)

The program has graphical capability, so you can plot dispersion graphics to verify grafically the fit between data and the proposed function.

Notes: The compilation of this program must be done under the Turbo Pascal compiler, version 5.0 or superior. It requires the Turbo Pascal Graphics Toolbox. After the compiling, the following files must be included in the same directory of the executable file:

• 4X6.FON
• 8X8.FON
• 14X9.FON
• ERROR.MSG

***** Begin of Program Listing *****

```Program Zardoz;

{--------------------------------------------------------------------------}
{-                                                                        -}
{-          Z         A         R         D         O         Z           -}
{-                                                                        -}
{-                                                                        -}
{-       Linear Regression Program  with  Several  Transformations        -}
{-                       and Graphical Capability                         -}
{-                                                                        -}
{-                                                                        -}
{-    Used Units:                                                         -}
{-    GDriver.TPU, GKernel.TPU, GWindow.TPU, GShell.TPU                   -}
{-                                                                        -}
{-    Used Files:                                                         -}
{-    4x6.fon, 8x8.fon (IBM color graphics),                              -}
{-    4x9.fon (Hercules mono graphics) and Error.msg.                     -}
{-                                                                        -}
{-                                                                        -}
{-               Antonio Augusto Gorni  ---  March 6, 1990                -}
{-                                                                        -}
{-                    Lattest Revision: June 6, 1992                      -}
{-                                                                        -}
{--------------------------------------------------------------------------}

uses
Dos, Crt, Printer, GDriver, GKernel, GWindow, GShell;

type
Boolean7 = array [1..7] of boolean;
Real7 = array [1..7] of real;
ColorArray = array[1..4] of byte;
GorniArray = array[1..600] of real;

const
IOerr : boolean = false;       { Detecta Erro de E/S }
LinSup : integer = 2;          { EGA =  2; CGA =  3 }
LinInf : integer = 25;         { EGA = 25; CGA = 24 }
PrinterMode = 6;               { EGA =  6; CGA =  1 }
NroFuncoes = 7;
WindowColor   : ColorArray = (Green, Magenta, LightCyan, White);
BackColor     : ColorArray = (Black, Black, Black, Black);

var
XData, YData : GorniArray;
Func, i : integer;
NumPoints : integer;
a, b : Real7;
Narq : string;

GraphArray : PlotArray;

procedure IOCheck;

{---------------------------------------------------}
{- Check for I/O error; print message if needed.   -}
{---------------------------------------------------}

type
String80 = string[80];

var
IOcode : integer;

procedure Error(Msg : String80);
begin
Writeln;
Write(^G); { Beep! }
Writeln(Msg);
Writeln;
end; { procedure Error }

begin { procedure IOCheck }
IOcode := IOresult;
IOerr := IOcode <> 0;
if IOerr then
case IOcode of
4   : Error('Too many open files.');
6   : Error('Invalid file handle.');
12  : Error('Invalid file access code.');
15  : Error('Invalid drive number.');
16  : Error('Cannot remove current directory.');
17  : Error('Cannot rename across drives.');
101 : Error('Disk write error.');
102 : Error('File not assigned.');
103 : Error('File not open.');
104 : Error('File not open for input.');
105 : Error('File not open for output.');
106 : Error('Invalid numeric format.');
else
begin
Writeln;
Writeln(^G);
Writeln('Unidentified error message = ', IOcode, '. See manual.');
Writeln;
end;
end; { case }
end; { procedure IOCheck }

function FileExists(Fname : String) : boolean;
var
CheckFile : file;
begin
Assign(CheckFile, Fname);
{\$I-} Reset(CheckFile); {\$I+}
if IOresult = 0 then
begin
FileExists := true;
Close(CheckFile)
end
else
FileExists := false;
end; { function FileExists }

procedure GetGraphData(var X, Y       : GorniArray;
var GraphArray : PlotArray;
NumPoints : Integer);
var
Index : Integer;

begin
for Index := 1 to NumPoints do
begin
GraphArray[Index, 1] := X[Index];
GraphArray[Index, 2] := Y[Index];
end;
end; { procedure GetGraphData }

procedure SetColors(Fore, Back : Integer);

begin
if MaxForeGround = 15 then
begin
SetForeGroundColor(Fore);
SetBackGroundColor(Back);
end;
end;    { Procedure SetColors }

procedure Tela1;

begin
TextMode(0);
GoToXY(1,6);
write('****************************************');
write('*                                      *');
write('*      Z    A    R    D    O    Z      *');
write('*                                      *');
write('*                                      *');
write('*          Developed by:               *');
write('*                                      *');
write('*    Antonio Augusto Gorni - EGT/T     *');
write('*                                      *');
write('*    Lattest Revision: 11/06/1992      *');
write('*                                      *');
write('****************************************');
delay(5000);
TextMode(2)
end; { procedure Tela1 }

procedure Flash;

begin
TextBackground(0);
TextColor(31);
end;

procedure Normal;

begin
TextBackground(0);
TextColor(7);
end;

procedure Inverse;

begin
TextBackground(7);
TextColor(0);
end;

procedure Centraliza(var Buffer : string);

begin
GotoXY(round((80-Length(Buffer))/2+1),1);
Inverse;
Writeln(Buffer);
Normal;
end;  {procedure Centraliza}

procedure Tabula(var Buffer, BufImpr : string;
Posicao : integer);

var
i, Compr : integer;

begin
for i := 1 to Posicao - Length(BufImpr) do
Buffer := ' ' + Buffer;
BufImpr:=BufImpr+Buffer;
end;   {Tabula}

procedure CabImpr(var BufImpr, Buffer : string;
var NroPag : integer);

var
Ano, Mes, Dia, DiaSemana, Hora, Minuto, Segundo, CentSegundo : word;

begin
Writeln(Lst,BufImpr);
Writeln(Lst,Buffer);
GetDate(Ano, Mes, Dia, DiaSemana);
GetTime(Hora, Minuto, Segundo, CentSegundo);
Write(Lst,'Page no. ',NroPag,' ***** ');
Write(Lst,Dia,'/',Mes,'/',Ano,', ',Hora,':');
If Minuto<10 then Write(Lst,'0');
Writeln(Lst,Minuto);
Writeln(Lst); Writeln(Lst); Writeln(Lst);
end; {CabImpr}

Procedure Eject;

begin
Writeln(Lst,#\$C);
end;   {Eject}

procedure Dir(var Caminho : string;
Espec : string);

var
Contador, i, j, NroLin : integer;
Flag : boolean;
Buffer : string;
Tipo : word;
ArqRes : Array [1..255] of string[12];

begin
Tipo := 0;
If DosError = 0 then
begin
Flag := true;
While Flag do
begin
If DosError = 0 then
begin
end
else Flag := false;
end;
end;
ClrScr;
Write('DIRETORIO: '); Inverse; Writeln(Caminho); Normal; Writeln;
begin
GotoXY(1,7); Flash;
Writeln('No File was Found in this Directory!');
Normal;
GotoXY(1,14); Write('Press  to Continue... '); Readln(Buffer);
end
else
begin
begin
if i mod 20 = 0 then
begin
Writeln; Writeln;
Write('Press  to Continue... '); Readln(Buffer); ClrScr;
GotoXY(1,4);
Write('DIRECTORY: '); Inverse; Writeln(Caminho); Normal; Writeln;
end;
for j := 1 to 5 do
begin
begin
GotoXY((j-1)*15+1,WhereY);
write(ArqRes[5*(i-1)+j]);
end;
end;
Writeln;
end;
Writeln; Writeln;
end;
end;     {Dir}

procedure IdentificaFuncao(var Funcao : integer;
var Saida : string);

begin
if Saida = 'Con' then
case Funcao of
1 : Writeln('<1> Y = A + B * X       ');
2 : Writeln('<2> Y = A * EXP(B * X)  ');
3 : Writeln('<3> Y = A * X ^ B       ');
4 : Writeln('<4> Y = A + B / X       ');
5 : Writeln('<5> Y = 1 / (A + B * X) ');
6 : Writeln('<6> Y = X / (A + B * X) ');
7 : Writeln('<7> Y = A + B * LN(X)   ');
end {case}
else
if Saida = 'String' then
case Funcao of
1 : Saida:='<1> Y = A + B * X';
2 : Saida:='<2> Y = A * EXP(B * X)';
3 : Saida:='<3> Y = A * X ^ B';
4 : Saida:='<4> Y = A + B / X';
5 : Saida:='<5> Y = 1 / (A + B * X)';
6 : Saida:='<6> Y = X / (A + B * X)';
7 : Saida:='<7> Y = A + B * LN(X)';
end {case}
else
case Funcao of
1 : Writeln(Lst,'<1> Y = A + B * X       ');
2 : Writeln(Lst,'<2> Y = A * EXP(B * X)  ');
3 : Writeln(Lst,'<3> Y = A * X ^ B       ');
4 : Writeln(Lst,'<4> Y = A + B / X       ');
5 : Writeln(Lst,'<5> Y = 1 / (A + B * X) ');
6 : Writeln(Lst,'<6> Y = X / (A + B * X) ');
7 : Writeln(Lst,'<7> Y = A + B * LN(X)   ');
end {case}
end;  {Identifica Funcao}

function Potencia(x, y  : real) : real;

begin
Potencia:=exp(Ln(x)*y);
end; {Potencia}

function CalculaFuncao(var i : integer;
var x : real;
var a, b : real;
var Bandeira : boolean) : real;

begin
Bandeira:=true;
case i of
1 : CalculaFuncao:=a+b*x;
2 : CalculaFuncao:=a*Exp(b*x);
3 : If x <= 0 then
begin
CalculaFuncao:=0.0;
Bandeira:=false;
end
else CalculaFuncao:=a*Potencia(x,b);
4 : If x = 0 then
begin
CalculaFuncao:=0.0;
Bandeira:=false;
end
else CalculaFuncao:=a+b/x;
5 : CalculaFuncao:=1/(a+b*x);
6 : CalculaFuncao:=x/(a+b*x);
7 : If x <= 0 then
begin
CalculaFuncao:=0.0;
Bandeira:=false;
end
else CalculaFuncao:=a+b*Ln(x);
end; {case}
end;   {CalculaFuncao}

var
Buffer : string;

begin
Window(1,1,80,25);
ClrScr;
Buffer := 'LINEAR REGRESSION WITH SEVERAL TRANSFORMATIONS';
Centraliza(Buffer);
GotoXY(29,6);  Writeln('<1> Data Input');
GotoXY(29,8);  Writeln('<2> Data Correction');
GotoXY(29,10); Writeln('<3> Data Suppression');
GotoXY(29,12); Writeln('<4> Data Output');
GotoXY(29,14); Writeln('<5> Curve Fitting');
GotoXY(29,16); Writeln('<6> Graphics');
GotoXY(29,18); Writeln('<7> End');
Funcao:=100;
While (Funcao < 1) or (Funcao > NroFuncoes) do
Begin
End;

var NumPoints : integer;
var Narq : string;

var
Buffer, Xtr, Ytr, Espec, Caminho : string;
Funcao, Cod, Nr, i : integer;
InFile : text;

begin
ClrScr;
Centraliza(Buffer);
Window(1,4,80,25);
begin
ClrScr;
write(^G);
GotoXY(1,9); Flash; Writeln('Data Not Saved Yet!'); Normal;
Buffer := '';
While ((Buffer <> 'Y') and (Buffer <> 'N')) do
begin
GotoXY(1,13); Write('Do You Want to Continue (Y/N)? '); Readln(Buffer);
end;
ClrScr;
end;
begin
GotoXY(32,6);  Writeln('<1> New Data');
GotoXY(32,10); Writeln('<2> More Data');
Funcao := 100;
While ((Funcao < 1) or  (Funcao > 2)) do
begin
end;
If Funcao = 1 then
begin
NumPoints := 0;
Narq:='';
end;
Buffer := 'INPUT OPTION';
Window(1,1,80,25);
ClrScr;
Centraliza(Buffer);
GotoXY(35,9);  Writeln('<1> Keyboard');
GotoXY(35,13); Writeln('<2> Disk');
Funcao := 100;
While ((Funcao < 1) or (Funcao > 2)) do
begin
end;
If Funcao = 1 then
begin
Buffer := 'INPUT VIA KEYBOARD';
Window(1,1,80,25);
ClrScr;
Centraliza(Buffer);
Window(1,4,80,25);
Writeln('Now Enter the Raw Data.');
Writeln('Write  to Finish.');
Writeln; Xtr := ''; Ytr := '';
While ((Xtr <> 'END') and (Ytr <> 'END')) do
begin
NumPoints := NumPoints + 1;
Writeln;
Writeln('Conjunto #', NumPoints);
Write('X? ');
If Xtr <> 'END' then
begin
Write('Y? ');
Val(Xtr,XData[NumPoints],Cod);
Val(Ytr,YData[NumPoints],Cod);
end;
end;
NumPoints := NumPoints - 1;
end
else
begin
Buffer := 'DISK INPUT';
Window(1,1,80,25);
ClrScr;
Centraliza(Buffer);
Window(1,4,80,25);
Narq := '?';
While Narq = '?' do
begin
GotoXY(1,6);
Write('File Name (? to List Directory)? ');
If Narq = '?' then
begin
Writeln; Write('Drive or Path? '); Readln(Caminho);
Dir(Caminho,'*.ZDZ'); ClrScr;
end;
end;
Narq := Narq + '.ZDZ';
If not FileExists(Narq) then
begin
ClrScr;
GotoXY(1,9);
Write(^G);
Writeln; GotoXY(1,13);
Write('Press  to Continue... ');
end
else
begin
Assign(InFile,Narq);
Reset(InFile);
IOCheck;
for i := 1 to Nr do
begin
YData[NumPoints+i]); {I+}
IOCheck;
end;
Close(InFile);
NumPoints := NumPoints + Nr
end;
end;
end;

Procedure CorrigeDados(var XData, YData : GorniArray;
var NumPoints : integer;

var
Buffer, Buffer1 : string;
Cod, Nponto : integer;

begin
ClrScr;
Buffer := 'DATA CORRECTION';
Centraliza(Buffer);
Window(1,4,80,25);
While Buffer <> 'END' do
begin
ClrScr;
GotoXY(1,7); Writeln('Point Index ( to Finish)? ');
If Buffer <> 'END' then
begin
Val(Buffer, Nponto, Cod);
If ((Nponto >= 1) and (Nponto <= NumPoints)) then
begin
writeln;
write('X = ',XData[Nponto],'.   New Value? ');
If Buffer1 <> '' then Val(Buffer1, XData[Nponto], Cod);
write('Y = ',YData[Nponto],'.   New Value? ');
If Buffer1 <> '' then Val(Buffer1, YData[Nponto], Cod);
end;
end;
end;

Procedure SuprimeDados(var XData, YData : GorniArray;
var NumPoints : integer;

var
Cod, Nponto, NroSupr, i, j, Troca : integer;
Vsupr : array [1..30] of integer;
Buffer, Buffer1 : string;

begin
NroSupr := 0;
ClrScr;
Buffer := 'DATA SUPPRESSION';
Centraliza(Buffer);
Window(1,4,80,25);
While Buffer <> 'END' do
begin
ClrScr;
GotoXY(1,7); Writeln('Point Index ( para Terminar)? ');
If Buffer <> 'END' then
begin
Val(Buffer, Nponto, Cod);
If ((Nponto >= 1) and (Nponto <= NumPoints)) then
begin
writeln;
write('X = ',XData[Nponto],' ***** ',YData[Nponto]);
Buffer1 := '';
While ((Buffer1 <> 'Y') and (Buffer1 <> 'N')) do
begin
GotoXY(1,12); Write(^G); Write('Confirm (Y/N)! ');
end;
If Buffer1 = 'Y' then
begin
NroSupr := NroSupr + 1; Vsupr[NroSupr] := Nponto;
end
else ClrScr;
end;
end;
end;
If NroSupr > 0 then
begin
GotoXY(1,14); Write(^G); Flash;
Writeln('Making Suppressions...');
Normal;
for i := 1 to NroSupr - 1 do for j := i + 1 to NroSupr do
If Vsupr[j] > Vsupr[i] then
begin
Troca := Vsupr[j]; Vsupr[j] := Vsupr[i]; Vsupr[i] := Troca;
end;
for j := 1 to NroSupr do
begin
For i := Vsupr[j] to NumPoints - 1 do
begin
XData[i] := XData[i+1]; YData[i] := YData[i+1];
end;
NumPoints := NumPoints - 1;
end;
end;

var NumPoints : integer;
var Narq : string;

var
Opcao, Contador, i, NroPag : integer;
Buffer, BufImpr, Mensagem, Caminho : string;
OutFile : text;

begin
ClrScr;
Buffer := 'DATA OUTPUT';
Centraliza(Buffer);
Window(1,4,80,25);
GotoXY(35,4);  Writeln('<1> Screen');
GotoXY(35,8);  Writeln('<2> Printer');
GotoXY(35,12); Writeln('<3> File');
Opcao := 100;
While ((Opcao < 1) or (Opcao > 3)) do
begin
end;
Case Opcao of
1 : begin
Window(1,1,80,25); ClrScr;
Buffer := 'DATA OUTPUT';
Centraliza(Buffer);
Window(1,4,80,25);
For i := 1 to NumPoints do
begin
Writeln('Point # ',i);
Write('X = ',XData[i]);
GotoXY(30,WhereY);
Writeln('Y = ',YData[i]);
Writeln;
If ((Contador >= 17) and (i < Numpoints)) then
begin
GotoXY(1,21);
Flash; Write('Press  to Continue...'); Normal;
ClrScr; GotoXY(1,1);
end;
end;
GotoXY(1,21);
Flash; Write('Press  to Continue.'); Normal;
ClrScr;
end;
2 : begin
Window(1,1,80,25); ClrScr;
Buffer := 'DATA PRINTER OUTPUT';
Centraliza(Buffer);
Window(1,4,80,25); GotoXY(1,8);
Writeln('Enter Data Identification Message.');
Writeln; Writeln; Writeln;
Write('Prepare Printer, Mark Start of Report.');
Writeln; Writeln;
Write('Press  to Continue...');
BufImpr := 'Data for Curve Fitting';
For i:=1 to NumPoints do
begin
Str(i,Buffer);
BufImpr := '#' + Buffer;
Str(XData[i],Buffer);
Tabula(Buffer,BufImpr,10);
Str(YData[i],Buffer);
Tabula(Buffer,BufImpr,35);
Writeln(Lst,BufImpr);
If ((Contador >= 55) and (i < NumPoints)) then
begin
NroPag := NroPag + 1; Eject;
BufImpr := 'Data for Curve Fitting';
end;
end;
Eject;
ClrScr;
end;
3 : begin
Window(1,1,80,25); ClrScr;
Buffer := 'DATA SAVING IN DISK';
Centraliza(Buffer);
Window(1,4,80,25);
GotoXY(1,6);
If Narq<>'' then
begin
Buffer:='';
While ((Buffer<>'Y') and (Buffer<>'N')) do
begin
GotoXY(1,8); Write('Do Your Want to Save in '); Flash; Write(Narq);
Normal; Write(' (Y/N)? '); Readln(Buffer); ClrScr;
end;
end;
If ((Narq='') or (Buffer='N')) then
begin
Narq := '?';
While Narq = '?' do
begin
GotoXY(1,6);
Write('File Name (? para listar Diretorio)? ');
If Narq = '?' then
begin
Writeln; Write('Drive or Path? '); Readln(Caminho);
Dir(Caminho,'*.ZDZ'); ClrScr;
end
else Narq:=Narq+'.ZDZ';
end;
end;
GotoXY(1,16); Write('Writing '); Flash; Writeln(Narq);
Assign(OutFile,Narq);
Rewrite(OutFile);
{I-} Writeln(OutFile, NumPoints); {I+}
IOCheck;
for i := 1 to NumPoints do
begin
{I-} Writeln(OutFile, XData[i], ' ', YData[i]); {I+}
IOCheck;
end;
end;
end; {Case}

Procedure AjustaCurvas(var XData, YData : GorniArray;
var NumPoints : integer;
var a, b : Real7;

var
Console, Impressora, Buffer, BufImpr, BufAux : string;
a1, b1, s1, s2, y, st, d, p1, d2, be, xe, z, ff, d1, ae, fe, ye,
SomXY, SomX, SomY, SomX2, z1, st1, st2, MediaY : real;
Ano, Mes, Dia, DiaSemana, Hora, Minuto, Segundo, CentSegundo : word;
Bandeira : boolean;
c, ep, p : real7;
Impressao : array[1..7,1..2] of string[80];
XTransf, YTransf : GorniArray;
Solution : array[1..2] of real;

begin
Console:='Con';
Impressora:='Lst';
ClrScr;
Buffer := 'CURVE FITTING';
Centraliza(Buffer);
Window(1,4,80,25);
For i:=1 to NroFuncoes do
begin
IdentificaFuncao(i,Console);
for j:=1 to NumPoints do
begin
case i of
1 : begin
XTransf[j]:=XData[j]; YTransf[j]:=YData[j];
end;
2 : if YData[j] <= 0 then Estado[i]:=false
else
begin
XTransf[j]:=XData[j]; YTransf[j]:=Ln(YData[j]);
end;
3 : if YData[j] <= 0 then Estado[i]:=false
else
if XData[j] <= 0 then Estado[i]:=false
else
begin
XTransf[j]:=Ln(XData[j]); YTransf[j]:=Ln(YData[j]);
end;
4 : begin
YTransf[j]:=YData[j];
else XTransf[j]:=1/XData[j];
end;
5 : begin
XTransf[j]:=XData[j];
else
YTransf[j]:=1/YData[j];
end;
6 : if YData[j]=0 then Estado[i]:=false
else
begin
YTransf[j]:=1/YData[j];
else XTransf[j]:=1/XData[j];
end;
7 : if XData[j] <= 0 then Estado[i]:=false
else
begin
XTransf[j]:=Ln(XData[j]);
YTransf[j]:=YData[j];
end
end; {case}
end;
begin
GotoXY(5,WhereY+1); Inverse; Writeln('IMPOSSIBLE!'); Normal;
end
else
begin
SomX:=0.; SomY:=0.; SomXY:=0.; SomX2:=0.;
for j:=1 to NumPoints do
begin
SomX:=SomX+XTransf[j]; SomY:=SomY+YTransf[j];
SomX2:=SomX2+Sqr(XTransf[j]); SomXY:=SomXY+XTransf[j]*YTransf[j];
end;
Solution[2]:=(SomXY-SomX*SomY/NumPoints)/(SomX2-Sqr(SomX)/NumPoints);
Solution[1]:=(SomY-Solution[2]*SomX)/NumPoints;
case i of
1 : begin
a[i]:=Solution[1]; b[i]:=Solution[2];
end;
2 : begin
a[i]:=Exp(Solution[1]); b[i]:=Solution[2];
end;
3 : begin
a[i]:=Exp(Solution[1]); b[i]:=Solution[2];
end;
4 : begin
a[i]:=Solution[1]; b[i]:=Solution[2];
end;
5 : begin
a[i]:=Solution[1]; b[i]:=Solution[2];
end;
6 : begin
a[i]:=Solution[2]; b[i]:=Solution[1];
end;
7 : begin
a[i]:=Solution[1]; b[i]:=Solution[2];
end;
end; {case}
st:=0.; st1:=0.;
for j:=1 to NumPoints do st1:=st1+YData[j];
MediaY:=st1/NumPoints;
st1:=0.;
for j:= 1 to NumPoints do
begin
y:=CalculaFuncao(i,XData[j],a[i],b[i],Bandeira);
d:=YData[j]-y; st:=st+d*d; d:=YData[j]-MediaY; st1:=st1+d*d;
end;
c[i]:=abs(1-(st/(NumPoints-2))/(st1/(NumPoints-1)));
if c[i]>1 then c[i]:=0.001;
ep[i]:=sqrt(st/NumPoints); ff:=c[i]*(NumPoints-2)/(1-c[i]);
p1:=1; d1:=1; d2:=NumPoints-2;
if ((d1=0) or (d2=0) or (ff=0)) then p[i]:=p1
else
begin
if ff < 1 then
begin
ae:=d2; be:=d1; fe:=1/ff
end
else
begin
ae:=d1; be:=d2; fe:=ff
end;
a1:=2/(9*ae); b1:=2/(9*be); xe:=(1-b1)*Potencia(fe,0.3333333)-1+a1;
ye:=sqrt(b1*Potencia(fe,0.66666667)+a1); z:=abs(xe/ye);
if be < 4 then z:=z*(1+0.08*Potencia(z,4)/Potencia(be,3));
z1:=0.115194+z*(0.000344+z*0.019527);
p1:=0.5/Potencia(1+z*(0.196854+z*z1),4);
if ff<0 then p[i]:=p1*100
else p[i]:=(1-p1)*100;
end;
if p[i]=100 then p[i]:=99.999999;
for j:=1 to 2 do Impressao[i,j]:='';
BufImpr:=''; Str(a[i],BufAux);
BufImpr:='A = '+BufAux; Str(b[i],BufAux); Buffer:='B = '+BufAux;
Tabula(Buffer,BufImpr,27); Str(c[i],BufAux); Buffer:='r2 = '+BufAux;
Tabula(Buffer,BufImpr,54); Writeln(BufImpr);
Impressao[i,1]:=BufImpr; Buffer:='';
Str(ep[i],BufAux); BufImpr:='E = '+BufAux; Str(p[i],BufAux);
Buffer:='% Conf = '+BufAux; Tabula(Buffer,BufImpr,27);
Impressao[i,2]:=BufImpr;
begin
Writeln(^G);
Flash; Write('Press  to Continue...'); Normal; Readln(Buffer);
end;
end;
end;
Writeln(^G);
Flash; Write('Press  to Continue...'); Normal; Readln(Buffer);
Buffer:='';
While ((Buffer<>'Y') and (Buffer<>'N')) do
begin
ClrScr; GotoXY(1,9); Write('Do You Want to Print Results (Y/N)? ');
end;
if Buffer = 'Y' then
begin
ClrScr; GotoXY(1,8);
GotoXY(1,12); Writeln('Prepare Printer and Press !');
Writeln(Lst,'LINEAR REGRESSION WITH SEVERAL TRANSFORMATIONS');
If Narq<>'' then
begin
Write(Lst,'Data from');
Write(Lst,' from the File ',Narq,' *** ')
end
else
Write(Lst,'Data Entered via Keyboard *** ');
GetDate(Ano, Mes, Dia, DiaSemana);
GetTime(Hora, Minuto, Segundo, CentSegundo);
Write(Lst,Dia,'/',Mes,'/',Ano,', ',Hora,':');
If Minuto<10 then Write(Lst,'0');
Writeln(Lst,Minuto);
Writeln(Lst,''); Writeln(Lst,BufImpr); Writeln(Lst,''); Writeln(Lst,'');
for i:=1 to NroFuncoes do
begin
IdentificaFuncao(i,Impressora);
begin
Writeln(Lst,Impressao[i,1]); Writeln(Lst,Impressao[i,2]);
Writeln(Lst,'');
end
else
begin
Writeln(Lst,'     IMPOSSIBLE!'); Writeln(Lst,''); Writeln(Lst,'');
end;
end;
end;
end; {AjustaCurvas}

Procedure PlotaCurvas(var XData,YData : GorniArray;
NumPoints : integer;
a, b : Real7;

var
i, j, k, Opcao, Funcao, Cod, NX, NY, CharCode : integer;
X0, X1, Y0, Y1, XCalc, Incr : real;
Buffer, Console, LabelX, LabelY : string;
Bandeira, Loop : boolean;

begin
Loop:=true;
Opcao:=0; Funcao:=0;
Console:='Con';
X0:=XData[1]; X1:=X0; Y0:=YData[1]; Y1:=Y0;
for i:=1 to NumPoints-1 do
for j:=i+1 to NumPoints do
begin
if XData[j]X1 then X1:=XData[j];
if YData[j]Y1 then Y1:=YData[j]
end;
NX:=5; NY:=5; LabelX:=''; LabelY:=''; CharCode:=8;
While Loop do
begin
Window(1,1,80,25); ClrScr;
Buffer := 'GRAPHIC PLOTTING';
Centraliza(Buffer);
GotoXY(29,7);  Writeln('<1> Function Definition');
GotoXY(29,9);  Writeln('<2> Axis Definition');
GotoXY(29,11); Writeln('<3> Plot Graphic');
GotoXY(29,13); Writeln('<4> Show Graphic');
GotoXY(29,15); Writeln('<5> Print Graphic');
Opcao:=0;
While (Opcao < 1) or (Opcao > NroFuncoes) do
begin
end;
case Opcao of
1 : begin
ClrScr; Buffer:='FUNCTION TO BE PLOTTED'; Centraliza(Buffer);
GotoXY(29,6);
for i:=1 to NroFuncoes do
begin
GotoXY(29,WhereY); IdentificaFuncao(i,Console); Writeln;
end;
Funcao:=0;
While (Funcao < 1) or (Funcao > NroFuncoes) do
begin
If (Funcao >= 1) and (Funcao <= NroFuncoes) then
end;
end;
2 : If (Funcao<>0) and (Estado[Funcao]) then
begin
ClrScr; Buffer:='AXIS DEFINITION'; Centraliza(Buffer);
Window(1,4,80,25);
GotoXY(1,3);
Write('Current Minimum X: ',X0,' - New: '); Readln(Buffer);
If Buffer<>'' then Val(Buffer,X0,Cod);
Write('Current Maximum X: ',X1,' - New: '); Readln(Buffer);
If Buffer<>'' then Val(Buffer,X1,Cod);
Writeln; Writeln;
Write('Current Minimum Y: ',Y0,' - New: '); Readln(Buffer);
If Buffer<>'' then Val(Buffer,Y0,Cod);
Write('Current Maximum Y: ',Y1,' - New: '); Readln(Buffer);
If Buffer<>'' then Val(Buffer,Y1,Cod);
Writeln; Writeln;
Write('Current Tick Density in the X-Axis: ',NX,
' - New (-9 a +9): ');
If Buffer<>'' then Val(Buffer,NX,Cod);
Write('Current Tick Density in the Y-Axis: ',NY,
' - New (-9 a +9): ');
If Buffer<>'' then Val(Buffer,NY,Cod);
If (Abs(NX)>9) or (Abs(NY)>9) then
begin
Writeln(^G); Inverse;
Writeln('Illegal Tick Density!'); Normal
end;
Writeln; Writeln;
Write('Current X-Axis Label: ',LabelX,' - New: ');
If Buffer<>'' then LabelX:=Buffer;
Write('Current Y-Axis Label: ',LabelY,' - New: ');
If Buffer<>'' then LabelY:=Buffer;
Writeln; Writeln;
Write('Current Point Type: ',CharCode,' - New: ');
If Buffer<>'' then Val(Buffer,Charcode,Cod);
end;
3 : If (Funcao <> 0) and (Estado[Funcao]) then
begin
RAMScreenGlb := true;
Incr:=(X1-X0)/MaxPlotGlb; XCalc:=X0;
for k:=1 to MaxPlotGlb do
begin
GraphArray[k,1]:=XCalc;
GraphArray[k,2]:=CalculaFuncao(Funcao, XCalc,
a[Funcao], b[Funcao],
Bandeira);
XCalc:=XCalc+Incr;
If (GraphArray[k,1]X1) or
(GraphArray[k,2]Y1) or
not Bandeira then
begin
GraphArray[k,1]:=X0;
GraphArray[k,2]:=Y0;
end;
end;
EnterGraphic;
DefineWindow(1, 0, 0, XMaxGlb, YMaxGlb);
DefineWorld(1,X0,Y0,X1,Y1);
SelectWorld(1); SelectWindow(1); SetBackground(0);
ClearScreen;
Buffer:='String';
IdentificaFuncao(Funcao,Buffer);
Buffer:='Fitted Function ' + Buffer;
GotoXY(1,LinSup); Writeln(LabelY);
GotoXY(80-Length(LabelX),LinInf); Writeln(LabelX);
DrawAxis(NX, NY, 0, 15, 0, 15, -1, -1, true);
DrawPolygon(GraphArray, 1, MaxPlotGlb, -9, 1, 0);
ResetAxis;
GetGraphData(XData, YData, GraphArray, NumPoints);
DrawPolygon(GraphArray, 1, NumPoints, -CharCode, 2, 0);
SwapScreen;
LeaveGraphic;
end;
4 : begin
EnterGraphic;
SwapScreen;
SwapScreen;
LeaveGraphic;
end;
5 : begin
Window(1,1,80,25); ClrScr;
Buffer:='PRINTING GRAPHIC';
Centraliza(Buffer);
GotoXY(1,12);
Writeln('Prepare Printer and Press  to Continue!');
EnterGraphic;
SwapScreen;
HardCopy(false,PrinterMode);
SwapScreen;
LeaveGraphic;
Writeln(Lst,Chr(27),'@');
end;
6 : Loop:=false;
end {case}
end
end;  {PlotaCurvas}

var
Buffer : string;

begin
begin
ClrScr;
Buffer := 'END OF PROGRAM RUN';
Centraliza(Buffer);
Window(1,4,80,25);
GotoXY(1,9); Flash;
Writeln(^G'Data Not Saved Yet!');
Normal;
Buffer := '';
While ((Buffer<>'Y') and (Buffer<>'N')) do
begin
end;
if Buffer = 'Y' then
begin
ClrScr;
Halt;
end;
end
else
begin
ClrScr;
Halt
end;
end;   {Fim}

begin { program Zardoz }
InitGraphic;
SetColors(WindowColor[1], BackColor[1]);
LeaveGraphic;
Tela1;
for i:=1 to NroFuncoes do Estado[i]:=false;
While true do
begin
case Func of