Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.11.2012, 15:33   #1
Camelot_2012
Пользователь
 
Регистрация: 19.12.2011
Сообщений: 90
По умолчанию Перевести на Паскаль

Всем привет! Помогите перевести код в Паскаль! Заранее благодарен!!!
Код:
double ab(double x1,double x2,double z2,double &a,double &b,double &N0)
{  int i=0;
   double y1,y2,d_alfa=1;
   y1=f(x1,x2);
   N0++;
   do{  
y2=f(x1,x2-d_alfa*(i+1)*z2);
N0++;
i++;
y1=y2;
      }while(y1<y2);
     b=(i+1)*d_alfa;
     if(i==0) a=0;
     else a=(i-1)*d_alfa;
     return a,b;
}
double minimiz_f_ZS(double x1,double x2,double z1,double z2,double a,double b,double &N,double &alfa)
{
  double y1,y2,t,alfa1,alfa2;
  t=(1+sqrt(5))/2;
  alfa1=b-(b-a)/t;
  alfa2=a+(b-a)/t;
  y1=f(x1-alfa1*z1,x2-alfa1*z2);
  y2=f(x1-alfa2*z1,x2-alfa2*z2);
  do{
     if(y1<y2){b=alfa2;alfa2=alfa1;y2=y1;
       alfa1=a+b-alfa2;
       y1=f(x1-alfa1*z1,x2-alfa1*z2);
               N++;
       }
    else{a=alfa1;alfa1=alfa2;y1=y2;
  alfa2=a+b-alfa1;
  y2=f(x1-alfa2*z1,x2-alfa2*z2);
  N++;
  }
     }while(b-a>2*E);
     if(y1<y2) b=alfa2;
     else b=alfa1;
     alfa=(a+b)/2;
     return alfa;
}
void main()
{
 double N1,N0,N,x1[100],x2[100],z1,z2,alfa,a,b,y1,y2;
 int i,k;
 k=0;
 N=0;
 x1[0]=-1;
 x2[0]=0;
 z1=dx1(x1[k],x2[k]);
 z2=dx2(x1[k],x2[k]);
 N1=2;
 clrscr();
 cout<<setw(5)<<"x1"<<setw(15)<<"x2"<<endl;
 do{
     ab(x1[k],x2[k],z2,a,b,N0);
     minimiz_f_ZS(x1[k],x2[k],z1,z2,a,b,N,alfa); //Z.S.
     x1[k+1]=x1[k]-alfa*z1;
     x2[k+1]=x2[k]-alfa*z2;
     z1=dx1(x1[k+1],x2[k+1]);
     z2=dx2(x1[k+1],x2[k+1]);
     N1=N1+2;
     k++;
     cout<<x1[k]<<setw(15)<<x2[k]<<endl;
   }while(sqrt(z1*z1+z2*z2)>E);
   cout<<endl;
   cout<<"x1~="<<x1[k]<<endl<<"x2~="<<x2[k]<<endl
   <<"y~="<<f(x1[k],x2[k]);
   cout<<endl<<"N="<<N+N0+N1<<endl
   <<"k="<<k;
   getch();
}
Camelot_2012 вне форума Ответить с цитированием
Старый 13.11.2012, 16:34   #2
grandmixer
Пользователь
 
Аватар для grandmixer
 
Регистрация: 30.10.2012
Сообщений: 31
По умолчанию

В коде не было переменных dx1,dx2,E и еще какой-то функции f()
что смог перевел xD

f
Код:
unction ab(var x1,x2,z2,a,b,N0:double):double;
var i:integer;
y1,y2,d_alfa:double;
begin
i:=1;
y1:=1;
y2:=1;
d_alfa:=1;
  y1:=f(x1,x2);
  N0:=N0+1;

  while y1<y2 do
  begin
        y2:=f(x1,x2-d_alfa*(i+1)*z2);
        N0:=N0+1;
        inc(i);
        y1:=y2;
  end;

  b:=(i+1)*d_alfa;

  if i=0 then a:=0
  else a:=(i-1)*d_alfa;
end;

function minimiz_f_ZS(var x1,x2,z1,z2,a,b,N,alfa:double):double;
var
y1,y2,t,alfa1,alfa2:double;
begin
  t:=(1+sqrt(5))/2;
  alfa1:=b-(b-a)/t;
  alfa2:=a+(b-a)/t;
  y1:=f(x1-alfa1*z1,x2-alfa1*z2);
  y2:=f(x1-alfa2*z1,x2-alfa2*z2);

  while b-a>2*E do
  begin
        if y1<y2 then
        begin
              b:=alfa2;
              alfa1:=a+b-alfa2;
              y1:=f(x1-alfa1*z1,x2-alfa1*z2);
              N:=N+1;
        end
        else begin
              a:=alfa1;
              alfa2:=a+b-alfa1;
              y2:=f(x1-alfa2*z1,x2-alfa2*z2);
              N:=N+1;
        end;
  end;
  if y1<y2 then b:=alfa2
  else b:=alfa1;

  alfa:=(a+b)/2;
  minimiz_f_ZS:=alfa;
end;

var
  N1,N0,N,z1,z2,alfa,a,b,y1,y2:double;
  x1,x2:array [0..100] of double;
  i,k:integer;
begin
k:=0;
N:=0;
x1[0]:=-1;
x2[0]:=0;
z1:=dx1(x1[k],x2[k]);
z2:=dx2(x1[k],x2[k]);
N1:=2;
writeln('     ','x1','               ','x2');

while sqrt(z1*z1+z2*z2)>E do
begin
     ab(x1[k],x2[k],z2,a,b,N0);
     minimiz_f_ZS(x1[k],x2[k],z1,z2,a,b,N,alfa);
     x1[k+1]:=x1[k]-alfa*z1;
     x2[k+1]:=x2[k]-alfa*z2;
     z1:=dx1(x1[k+1],x2[k+1]);
     z2:=dx2(x1[k+1],x2[k+1]);
     N1:=N1+2;
     inc(k);
     writeln(x1[k],'               ',x2[k]);
end;

writeln('x1~=',x1[k]);
writeln('x2~=',x2[k]);
writeln('y~=',f(x1[k],x2[k]));
writeln('N=',N+N0+n1);
writeln('k=',k);

end.
grandmixer вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Перевести с С++ на Паскаль xakkkkker Паскаль, Turbo Pascal, PascalABC.NET 0 15.05.2011 18:58
Перевести из С++ в паскаль Ver-Mishel Помощь студентам 0 15.02.2011 20:52
перевести из cos(a) в а (паскаль) Besidnuk Помощь студентам 5 26.12.2010 23:47
Перевести С++ в Паскаль alphadog900 Помощь студентам 6 11.12.2010 18:41