program polyfit;
uses  dos,crt,graph;


const mxhi=120;myhi=120;hh1=15;myh=50;

var b1,b2,b11,b33,b34,b35,b36: char;
    Name,name1,name2,kk,bild1,bild2,bild3,bild4: string;
    tex,tex2 :Text;
    i,ii,l,anz,anz0,imax,b3,b4,b5,b6:integer;
    xx,yy: real;

var graphdriver,graphmode:integer;
    mx,my,xp,yp,x0,y0,j,grad,imini,imaxi,xpalt,anzd:integer;
    r,dx,dy,xl,yl,invdifx:real;
    xmin,xmax,x,y,ymin,ymax,difx,dify,invdify,deltax,deltay:real;
    strxmin,strxmax,strymin,strymax,strr,sanz,strzahl:string;
    xr,yr:real;
    word5,wordx,wordy:string;
    c: array[0..20] of real;
    de: array[0..20] of extended;
    b:array[0..440] of extended;
    stelle:array [0..20] of integer;
    xmintxt,xmaxtxt,ymintxt,ymaxtxt,maxpix,nks,ischrift:integer;
    xmindef,xmaxdef,ymindef,ymaxdef:real;

procedure ig;
 begin
 initgraph(graphdriver,graphmode,'c:\tp\bgi');
 end;
function potdif(i:integer):real;
  var p1:real;
      l:integer;
  begin
  p1:=1;
  if i>0 then begin
  for l:=1 to i do begin
  p1:=p1*xx;end;end;
  potdif:=p1;end;
function yy100(xxx:real):real;
var il,jl:integer;
    yyy,ttt:extended;
  begin
if xxx=0 then ttt:=c[0] else begin
  ttt:=0;
  for il:=0 to grad do begin
  jl:=0;yyy:=1/xxx;
  repeat yyy:=xxx*yyy;jl:=jl+1;
  until jl=il+1;
  ttt:=ttt+yyy*c[il];end;end;
  yy100:=ttt;end;
procedure koeff;
var detb:real;
    faktor:extended;
    ka,ki,il,iil:integer;
begin
for il:=0 to grad do begin
iil:=-1;
repeat
iil:=iil+1;stelle[il]:=iil;
until b[(grad+1)*(il)+iil]<>0;
 if il<grad then begin
  for ka:=il+1 to grad do begin
  faktor:=b[(grad+1)*(ka)+iil]/b[(grad+1)*(il)+iil];
   for ki:=iil to grad do begin
   b[(grad+1)*(ka)+ki]:=b[(grad+1)*(ka)+ki]-faktor*b[(grad+1)*(il)+ki];
   end;
  b[(grad+1)*(ka)+iil]:=0;
  de[ka]:=de[ka]-faktor*de[il];
  end;
 end;
end;
end;

procedure koeff2;
var il,iil:integer;
begin
for il:=grad downto 1 do begin
  c[stelle[il]]:=de[il]/b[(grad+1)*il+stelle[il]];
    for iil:=il-1 downto 0 do begin
    de[iil]:=de[iil]-c[stelle[il]]*b[(grad+1)*iil+stelle[il]];
    end;
end;
c[stelle[0]]:=de[0]/b[stelle[0]];
end;

function komma(xxx:real):integer;
var il:integer;
begin
il:=0;
while xxx<1 do begin
xxx:=xxx*10;inc(il);end;
komma:=il;
end;


begin
repeat
 clrscr;
 writeln('Eingabe des Namen der Datei, in der sich die Meáwerte befinden, die');
 write('ausgewertet werden sollen: ');
 readln(name);
 write('Dateiformat X,Y (1) oder Y,X (2) ');readln(b6);
 writeln('Geben Sie die šberschrift der Grafik ein! (max. eine Zeile!)');
 readln(word5);
 write('X-Achsenbezeichnung: ');readln(wordx);
 write('Y-Achsenbezeichnung: ');readln(wordy);
 write('Autografik (j/n) ');readln(b35);
   if b35='n' then begin
   write('Xmin : ');readln(xmindef);
   write('Xmax : ');readln(xmaxdef);
   write('Ymin : ');readln(ymindef);
   write('Ymax : ');readln(ymaxdef);
   end;
 write ('Gitter mitzeichnen? (j/n) ');readln(b36);
 write('Grad des Polynoms: ');readln(grad);
 write('Sind alle Eingaben richtig? (j/n) ');readln(b11);
until b11='j';
for i:=0 to grad do begin
c[i]:=0;de[i]:=0;stelle[i]:=0;
for ii:=0 to grad do b[(grad+1)*ii+i]:=0;
end;
for b3:=1 to 2 do begin
 assign(tex,name);
 reset(tex);
 if not eof(tex) then begin
if b6=1 then begin
readln(tex,xx);
readln(tex,yy);
end else begin
readln(tex,yy);
readln(tex,xx);
end;
 end;
xmin:=xx;xmax:=xmin;
ymin:=yy;ymax:=yy;

while (not eof(tex)) do begin
  if not eof(tex) then begin
  if b6=1 then begin
  readln(tex,xx);
  readln(tex,yy);
  end else begin
  readln(tex,yy);
  readln(tex,xx);
  end;
  end;
  if xx<xmin then xmin:=xx;
  if xx>xmax then xmax:=xx;
  if yy<ymin then ymin:=yy;
  if yy>ymax then ymax:=yy;
 end;

end;
xmin:=xmin-0.1*abs(xmax-xmin);xmax:=xmax+0.09*abs(xmax-xmin);
ymin:=ymin-0.1*abs(ymax-ymin);ymax:=ymax+0.09*abs(ymax-ymin);
if b35='n' then begin
xmin:=xmindef;xmax:=xmaxdef;ymin:=ymindef;ymax:=ymaxdef;end;
graphdriver:=detect;ig;
mx:=getmaxx-20;my:=getmaxy-50;
for i:=mxhi to mx do begin putpixel(i,myhi,1);
                           putpixel(i,my,1);end;
for i:=myhi to my do begin putpixel(mxhi,i,1);
                           putpixel(mx,i,1);end;

dx:=(xmax-xmin);
if dx>0 then begin
r:=1;
    if dx>=100 then begin
           while dx>=100 do begin
                            dx:=dx/10;
                            r:=r*10;
                            end;                           {Ermittlung des}
                     end;                                  {X-Rasters}
    while dx<10 do begin
                   dx:=dx*10;
                   r:=r/10;
                   end;
    if dx>50 then deltax:=10*r
    else if dx>20 then deltax:=5*r
    else deltax:=2*r;
    nks:=komma(deltax);
    settextstyle(0,horizdir,0);
    settextjustify(centertext,righttext);
    invdifx:=(mx-mxhi)/(xmax-xmin);
    x:=int(xmin/deltax)*deltax;
    ischrift:=0;
    for j:=12 downto -1 do begin
    xr:=x+j*deltax;
    xl:=mxhi+(-xmin+x+j*deltax)*invdifx;
    x0:=round(xl);
    if (x0>=mxhi) and (x0<=mx) then begin
    inc(ischrift);
if ischrift<>2 then begin
str(xr:0:nks,strzahl);
outtextxy(x0,my+hh1,strzahl);
end else
outtextxy(x0,my+hh1,wordx);
if b36='j' then maxpix:=myhi else maxpix:=my-6;
    for i:=maxpix to my+6 do begin
    putpixel(x0,i,8);
    end;
    end;
    end;
x0:=round(mxhi-xmin*invdifx);
if (x0>=mxhi) and(x0<=mx) then begin
    for i:=myhi to my do begin
    putpixel(x0,i,4);
    end;
    end;
end;
{+++++++++++++++++++++++++++++}

xl:=mxhi+(-xmin+x+j*deltax)*invdifx;
dy:=ymax-ymin;
if dy>0 then begin
r:=1;
    if dy>=100 then begin
           while dy>=100 do begin
                            dy:=dy/10;
                            r:=r*10;
                            end;                           {Ermittlung des}
                     end;                                  {Y-Rasters}
    while dy<10 do begin
                   dy:=dy*10;
                   r:=r/10;
                   end;
    if dy>50 then deltay:=10*r
    else if dy>20 then deltay:=5*r
    else deltay:=2*r;
        nks:=komma(deltay);
        settextstyle(0,horizdir,0);                              
        settextjustify(righttext,centertext);
    y:=int(ymax/deltay)*deltay;
invdify:=(my-myhi)/(ymax-ymin);
    ischrift:=0;
    for j:=-1 to 12 do begin
    yr:=y-j*deltay;
    yl:=myhi+(ymax-y+j*deltay)*invdify;
    y0:=round(yl);
if((y0>=myhi)and(y0<=my)) then begin
    inc(ischrift);
    if ischrift<>2 then begin
str(yr:0:nks,strzahl);
outtextxy(mxhi-hh1,y0,strzahl);
end else
outtextxy(mxhi-hh1,y0,wordy);
if b36='j' then maxpix:=mx else maxpix:=mxhi+6;
    for i:=mxhi-6 to maxpix do begin                    
    putpixel(i,y0,8);
    end;
    end;
    end;

y0:=round(myhi+ymax*invdify);
if (y0>=myhi) and (y0<=my) then begin
    for i:=mxhi to mx do begin
    putpixel(i,y0,4);
    end; 
    end;
end;

reset(tex);
anzd:=0;
while not eof(tex) do begin
    if b6=1 then begin
    readln(tex,xx);
    readln(tex,yy);
    end else begin
    readln(tex,yy);
    readln(tex,xx);
    end;
    {xpalt:=xp;}
    x:=xx;
    y:=yy;                                             { Zeichnen der }
    x:=mxhi+(x-xmin)*invdifx;xp:=round(x);                { Meáwerte }
    y:=myhi+(ymax-y)*invdify;yp:=round(y);
    if((mxhi<xp)and(xp<mx)and(myhi<yp)and(yp<my))then begin
    inc(anzd);
    if ((anzd>1) and (xpalt<=xp)) then lineto(xp,yp) else begin
    sound(500);delay(40);nosound;delay(2000);end;
    moveto(xp,yp);
    circle(xp,yp,1);
    xpalt:=xp;
    end;
for i:=0 to grad do begin
for ii:=0 to grad do begin
b[(grad+1)*(ii)+i]:=b[(grad+1)*(ii)+i]+potdif(i)*potdif(ii)end;
de[i]:=de[i]+potdif(i)*yy;end;
end;


settextjustify(centertext,centertext);
settextstyle(0,horizdir,0);
outtextxy(round((mxhi+mx)/2),myhi-hh1,word5);

koeff;
koeff2;
readln;
imini:=mxhi;
imaxi:=round(mxhi+(xmax-xmin)*invdifx);
   for i:=imini to imaxi do begin
   x:=xmin+(i-mxhi)*(xmax-xmin)/(mx-mxhi);
   y:=yy100(x);
   if((ymax>y)and(y>ymin))then begin
   y:=myhi+(ymax-y)*invdify;yp:=round(y);
   putpixel(i,yp,13);
   end;
   end;

close(tex);
readln;
closegraph;
reset(tex);x:=0;
while not eof(tex) do begin
    readln(tex,xx);
    readln(tex,yy);
    y:=yy100(xx);
    x:=x+sqr(yy-y);
end;
close(tex);
writeln;
writeln('Das Polynom hat die Parameter');
for i:=0 to grad do begin
writeln('c',i,' : ',c[i]);
end;
writeln('Summe der Fehlerquadrate : ',x);
{assign(f,'nicrni50.p10');
rewrite(f);
for i:=0 to grad do begin
writeln(f,c[i]);
end;
close(f);}
repeat
write('Y-Wert aus Polynom berechnen?(j/n) ');readln (b33);
if b33='j' then begin
write(wordx,' : ');readln(xx);
writeln(wordy,'= ',yy100(xx):6:3);
end;
until b33<>'j';
write('Polynomdatei abspeichern? (j/n) ');readln(b34);
if b34<>'n' then begin
write('Dateiname : ');readln(name);
 assign(tex,name);
 rewrite(tex);
for i:=0 to grad do begin
writeln(tex,c[i]);
end;
close(tex);
end;
writeln('Programmende.');
readln;
end.