fork download
copy 
  1. program MNS;
  2.  
  3. {$APPTYPE CONSOLE}
  4.  
  5. uses
  6.   SysUtils;
  7.  
  8. const dx=0.0001;
  9. var x,df:array of real;
  10. eps,h,grad:real;
  11. i,j,n:integer;
  12.  
  13. function f(x:array of real):real;
  14. begin
  15.   f:=sqr(X[1]-4*X[2]))+(sqr(X[2]+5)
  16. end;//f//
  17.  
  18. procedure step (n:integer;var h,grad:real);
  19. var d2f: array of array of real;
  20.     i,j:integer;
  21.     s,s1,f0:real;
  22.  
  23. begin
  24. SetLength (d2f,n+1,n+1);
  25. f0:=f(x);
  26. for i:=1 to n do
  27.     begin
  28.       x[i]:=x[i]+dx;
  29.       df[i]:=(f(x)-f0)/dx;
  30.       x[i]:=x[i]-dx;
  31.     end;
  32.  
  33. for i:=1 to n do
  34.   begin
  35.     s:=-2*f(x);
  36.     x[i]:=x[i]+dx;
  37.     s:=s+f(x);
  38.     x[i]:=x[i]-2*dx;
  39.     s:=s+f(x);
  40.     x[i]:=x[i]+dx;
  41.     d2f[i,i]:=s/sqr(dx);
  42.   end;
  43.  
  44. for i:=1 to n-1 do
  45.   for j:=i+1 to n do
  46.     begin
  47.       s:=f(x);
  48.       x[i]:=x[i]-dx;
  49.       x[j]:=x[j]-dx;
  50.  
  51.         s:=s+f(x);
  52.         x[j]:=x[j]+dx;
  53.  
  54.           s:=s-f(x);
  55.           x[i]:=x[i]+dx;
  56.           x[j]:=x[j]-dx;
  57.  
  58.             s:=s-f(x);
  59.             x[j]:=x[j]+dx;
  60.             d2f[i,j]:=s/sqr(dx);
  61.             d2f[j,i]:=d2f[i,j];
  62. end;
  63.  
  64. s:=0;
  65. s1:=0;
  66.   for i:=1 to n do
  67.   s:=s+sqr(df[i]);
  68.     for i:=1 to n do
  69.     for j:=1 to n do
  70.     s1:=s1+d2f[i,j]*df[i]*df[j];
  71.     h:=s/s1;
  72.     grad:=sqrt(s);
  73. end;
  74.  
  75. begin
  76. writeln('Metod naiskorejshego gradientnogo spuska');
  77. writeln;
  78.     writeln('Ishodnnye dannye');
  79.     writeln;
  80.     write('Vvedite razmernost zadachi optimizacii n = ');
  81.     readln(n);
  82.     write ('Vvedite tochnost vychislenij eps = ');
  83.     readln(eps);
  84.     writeln('Vvedite znacheniya nachalnyh peremennyh');
  85.         SetLength (x,n+1);
  86.         SetLength (df,n+1);
  87.  
  88.           for i:=1 to n do
  89.             begin
  90.             write ('x[',i,']=');
  91.             readln(x[i]);
  92.             end;
  93.           repeat
  94.             step(n,h,grad);
  95.             for i:=1 to n do
  96.               x[i]:=x[i]-h*df[i];
  97.           until grad<eps;
  98.             writeln;
  99.             writeln('Rezultaty optimizacii:');
  100.             writeln;
  101.           for i:=1 to n do
  102.             writeln ('x[',i,']=',x[i]:4:4);
  103.             writeln;
  104.             writeln ('Znachenie funccii celi = ',f(x):4:4);
  105.             readln;
  106. end.
Compilation error #stdin compilation error #stdout 0s 0KB
comments (?)
stdin
copy 
Standard input is empty
compilation info 
prog.pas(15,22) Fatal: Syntax error, ";" expected but ")" found
Fatal: Compilation aborted
Error: /usr/bin/ppc386 returned an error exitcode (normal if you did not specify a source file to be compiled)
stdout
copy 
Standard output is empty
https://ideone.com/WM6X00
language:
Pascal (fpc 3.0.4)
created:
9 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!