Program  RungeKutta;
uses crt,graph;
Var
  janafl:Text;
  s,i,k:integer;
  a,b,x0,y0,x1,x2,z,h,xmax,ymax,xmin,ymin:real;
  u,q1,q2,q3,q4,l1,l2,l3,l4:real;
  ImeFl:string;
  x,y,Q,L,P:array[0..1100] of real;
  c:array[1..1500,1..2] of real;
  smetka : boolean;

Function f(x,y:real):real;
  begin
     f:=y/x+sqr(y)+sqr(x);
  end;


Procedure Vavej;     {Procedure za vavejdane na dannite ot klaviatura }
Begin
k:=0;
writeln;
writeln('Reshavane na uravnenieto');
writeln;
writeln(' ','y/x+ya*ya+x*x');
writeln;
write('Dolna Granica: ');readln(a);
write('Gorna Granica: ');readln(b);
u:=x[0];
write('Nachalna Stoinost - X: ');
readln(x0);
write('Nachalna Stoinost - Y: ');
readln(y0);
write('Vavedi stupkata h: ');readln(h);
readln;
ClrScr;
smetka := false;
End;

Procedure Izv;         {Procedura za izvejdane na vhodnite danni}
Begin
writeln;
writeln('Reshavane na uravnenieto');
writeln;
writeln(' ','y/x+ya*ya+x*x');
writeln;
writeln('S nachalni stoinosti:');
writeln;
writeln(' Dolna Granica = ',a:9:3);
writeln(' Gorna Granica = ',b:9:3);
writeln(' Nachalna Stoinost (X) = ',x0:9:3);
writeln(' Nachalna Stoinost (Y) = ',y0:9:3);
writeln;
writeln(' Stupka: h= ',h:9:3);
readln;
ClrScr
End;

procedure Calculate(a, b, x0, y0, h: real);
var
    x, y, xi, yi: real;
    k1, k2, k3, k4: real;
    M, i: integer;
begin
    M:=round((b-a)/h);
    for i := 1 to M do
     begin c[i,1]:=0; c[i,2]:=0; end;
    xi:=x0; yi:=y0;
    xmax := -maxint; ymax := -maxint;
    xmin := maxint; ymin := maxint;

    c[1,1] := x0; c[1,2] := y0;
    for i:=2 to M do begin
        k1:=h*F(xi, yi);
        k2:=h*F(xi+h/2, y+k1/2);
        k3:=h*F(xi+h/2, y+k2/2);
        k4:=h*F(xi+h, yi+k3);
        xi:=xi+h;
        yi:=yi+(k1+2*k2+2*k3+k4)/6;
        if Xi>Xmax then Xmax:=xi;
        if Xi<Xmin then Xmin:=Xi;
        if Yi>Ymax then Ymax:=Yi;
        if Yi<Ymin then Ymin:=Yi;
        c[i,1]:= xi; c[i,2]:= yi;
    end;
end;



Procedure Rezul;       {Procedura za izvejdane na rezultata}
var row,M : integer;
Begin
{Calculate(a,b,x0,y0,h);}
Writeln;
writeln('Resheniata na uravnenieto');
writeln;
writeln('  ','y/x+ya*ya+x*x');
writeln;
writeln('   sa :');
writeln;
writeln('--------------------------------------------');
M:=round((b-a)/h);
for row := 1 to M do
begin
  writeln(' ',row,': X = ',C[row,1]:3:3,'  ,  Y = ', C[row,2]:3:3);
  if row mod 30 = 0 then
    begin
      writeln;
      write('Natisni ENTER za produljenie!'); readln;
      writeln;
    end;
end;
readln;
ClrScr
End;

Procedure ZapFile;   {Procedura za zapisvane vuv fail vavedenite danni}
Begin
writeln;
write('  Ime na faila:');  {zadava se ime na faila janafl se svurzva s imeto ,                              faila se suzdava}
readln(imefl);
assign(janafl,imefl);
rewrite(janafl);
writeln(janafl,a:3:3);
writeln(janafl,b:3:3);
writeln(janafl,x0:3:3);
writeln(janafl,y0:3:3);
writeln(janafl,h:3:3);
close(janafl);    {faila se zatvarq}
writeln('faila e sazdaden');readln;
ClrScr;
End;

Procedure RezultFile;       {Procedura,koqto zapisva v fail reshenoto uravn}
var m:integer;
Begin
writeln;
write('Ime na faila:   ');
   {zadava se ime na faila janafl se svurzva s
   imeto,faila se sazdava}
readln(imefl);
assign(janafl,imefl);
rewrite(janafl);


writeln(janaFl,'  Tochka       X        Y      ');
writeln(janafl,'-------------------------------------');
M:=round((b-a)/h);
for i := 1 to M do
  writeln(janafl,i,'   ',C[i,1]:3:3,'   ',C[i,2]:3:3);

close(janafl);  {zatvarq se faila}
writeln('faila e sazdaden');readln;
ClrScr
End;


Procedure InFile;    {Procedura koqto vavejda vhodnite danni ot faila}
Begin
k:=0;
writeln;
write('Vavedete ime na faila:  ');  {vavejda se ime na faila i se proverqva
                                      dali tozi fail sashtestvuva}
readln(imefl);
assign(janafl,imefl);{$I-}
reset(janafl);{$I+}
If ioresult=0 then begin
writeln;
readln(janafl,a,b,x0,y0,h);
writeln(' Dannite sa vavedeni');
close(janaFl);End;
readln;
ClrScr;
End;

Procedure Graphh;
var
  GrD,grm:integer;
  p,j,M:integer;
  x,y,z:real;
  mx,my,hh,sf,oy,ox:real;
  fl:boolean;
  i : integer;
begin
  x := 0;
  GrD:=Detect;
  InitGraph(grd,grm,'C:\bp\bgi');
  p:=getmaxx-20;
  j:=getmaxy-20;
  mx:=p/(b-a);
  my:=j/(ymax-ymin);
    setcolor(red);
    oy:=10+ mx*(0+abs(abs(b)-abs(a)));
    Line (round(oy),0,round(oy),j);
    ox:=10+ j-(abs(ymin))*my;
    Line (0,round(ox),p,round(ox));
    setcolor(green);
    OutTextXY(p-10,round(ox)-20, 'X');
    OutTextXY( round(oy)+10,10, 'Y');
    fl:=true;
    setcolor(15);
    M:=round((b-a)/h);
    for i := 1 to M do
      begin
        if i = 1 then moveto(round(10+mx*(C[i,1])),round(40-(c[i,2])*my));
        lineto(round(10+oy+mx*(C[i,1])),round(ox-(c[i,2])*my));
      end;
     readln;
     CloseGraph;
   end;



{glavna programa}
BEGIN
  Repeat    {suzdava se cikal za izvejdane na menu}
   Repeat
     writeln;
     writeln(' programa za reshavane na  obiknoveno diferenc. uravnenie');
     WRITELN(' po metoda na Runge-Kuta ');
     writeln;
     writeln;
     writeln('':34,'Slednoto Menu: ');
     writeln;
     writeln('':15,'1-za vuvejdane na vhodnite danni ot klaviaturata');
     writeln('':15,'2-za vuvejdane na vhodnite danni ot tekstov fail');
     writeln('':15,'3-za zapis na vhodnnite danni v tekstov fail');
     writeln('':15,'4-za izvejdane na vhodnnite danni na ekrana ');
     writeln('':15,'5-za presmqtane na  uravnenieto');
     writeln('':15,'6-za izvejdane na rezultata ot presmetnatoto uravnenie');
     writeln('':15,'7-za zapisvane na resultata v tekstov fail');
     writeln('':15,'8-za izvejdane na grafika');
     writeln;
     writeln('':18,'0 - I Z H O D    ot   P R O G R A M A T A');
        {sazdava se cikal koito sledi dali se vavejdat korektni danni}
     writeln;
     write('':20,'Posochete operaciq: ');{$I-}
     readln(S);
     ClrScr;
     {$I+}
   Until(Ioresult=0) and(S>-1) and(S<9);
   Case S of
        1 : Vavej;
        2 : InFile;
        3 : ZapFile;
        4 : Izv;
        5 : Calculate(a,b,x0,y0,h);
        6 : Rezul;
        7 : RezultFile;
        8 : graphh;
   end;
 Until S=0;
END.  {Krai na programata}