Ввод вручную - Паскаль, Turbo Pascal, PascalABC.NET

Camelot_2012 · 28.10.2015, 16:20

Здравствуйте, помогите пожалуйста сделать ручной ввод в программе вектора х, M и eps

Код:

uses crt;
const n=2; h=0.0005; eps=0.05;
type vector=array [1..n] of real;
var x, delta2x, grf, grf2, dx, a : vector;
    i,j, k, m :integer;
    tau, t, d, s :real;

function f(x:vector):real;
begin
     f:=sqr(x[1]-4)+sqr(x[2]-5);
end;

function g(x:vector):real;
begin
     g:=x[1]+sqr(x[2])-4;
end;

function norm(x:vector):real;
var S:real; i:integer;
begin
     S:=0;
     for i:=1 to n do S:= S + sqr(x[i]);
     norm:=sqrt(S);
end;

PROCEDURE gradf(x:vector; var Gr:vector);
var u,v:vector; i:integer;
          begin

          for i:=1 to n do
              begin
              u:=x;
              v:=x;
              u[i]:=x[i]+h;
              v[i]:=x[i]-h;
              Gr[i]:=(f(u)-f(v))/(2*h);
              end;
          end;



procedure calcA(x:vector; var A:vector);
var i : integer;
begin
     A[1] := 1;
     A[2] := 2 * x[2];
end;

procedure calcTau(x:vector; var tau:real);
begin
     tau := -g(x);
end;

// AT x (A x AT)^-1
procedure multA(a:vector; var tmpA:vector);
var i : integer;
    s : real;
begin
     s := 0;
     for i:= 1 to n do s := s + sqr(a[i]);
     for i:= 1 to n do tmpA[i] := a[i] / s;
end;

procedure calcDelta2X(a:vector; tau:real; var deltaX:vector);
var i: integer;
    tmpA : vector;
begin
     multA(a, tmpA);
     for i:= 1 to n do deltaX[i] := tmpA[i] * tau;
end;

procedure calcDX(a:vector; grf:vector; var dx:vector);
var i, j: integer;
    tmpA : vector;
    res : array[1.. n, 1..n] of real;
    s : real;
begin
     multA(a, tmpA);

     for i:=1 to n do
     for j:=1 to n do
     begin
          if( i = j ) then res[i, j] := 1 - tmpA[i] * a[j]
          else res[i, j]:= -tmpA[i] * a[j];
     end;
      
     for i:=1 to n do
     begin
          s := 0;
          for j:=1 to n do s := s + grf[j] * res[i, j];
          dx[i] := -s;
     end;
end;

procedure calcT(x:vector;dx:vector;grf:vector; var t:real);
var i : integer;
    sum : real;
    s : vector;
begin
     //s := 0;
     for i := 1 to n do sum := sum + dx[i] * grf[i];
     
     //t := -gamma * f(x) / s;
     
end;

BEGIN
     clrscr;
     m := 5;

     for i:= 1 to n do x[i]:= 0;
     
     for k := 0 to m+1 do
     begin
          calcA(x, a);
          calcTau(x, tau);
          calcDelta2X(a, tau, delta2X);
          gradf(x, grf);
          calcDX(a, grf, dx);

          
          
          if (norm(dx) <= eps) and (norm(delta2X) <= eps) then
          begin
               writeln('Calculation complete: dx <= eps && delta2X <= eps');
               break;
          end;
          
          if (norm(dx) <= eps) and (norm(delta2x) > eps) then
          begin
               for i:= 1 to n do dx[i] := 0;
               t := 0;
          end
          else
          begin
               if (norm(dx) > eps) and (norm(delta2x) <= eps) then for i:= 1 to n do delta2x[i] := 0;
               // #11: calc x^k
               // #12: calc tk
               
               d:= sqr(norm(grf));
               gradf(grf, grf2);
               s := 0;
               for i:=1 to n do s:= s + grf[i] * grf2[i];
               t := d/s;
               
          
          end;
          //proection(delta2x, t);

          // #13: calc x ^ k+1
          for i:=1 to n do
          x[i]:= x[i] + t * dx[i] + delta2x[i];

          writeln;
          write('x = ');
          for i:= 1 to n do write(x[i]:5:4, ' ');
          writeln;
          write('A = ');
          for i:= 1 to n do write(a[i]:5:4, ' ');
          writeln;
          writeln('Tau: ',tau:5:4);
          write('delta2x = ');
          for i:= 1 to n do write(delta2X[i]:5:4, ' ');
          writeln;
          write('gradf = ');
          for i:= 1 to n do write(grf[i]:5:4, ' ');
          writeln;
          write('dx = ');
          for i:= 1 to n do write(dx[i]:5:4, ' ');
          writeln;
          writeln('t = ', t:5:4);
          writeln('k = ', k);      
          
     end;

END.

Serge_Bliznykov · 28.10.2015, 17:45

если правильно понял:
в начале уберите eps из const и добавьте в var:

Код:

const n=2; h=0.0005;
type vector=array [1..n] of real;
var x, delta2x, grf, grf2, dx, a : vector;
    i,j, k, m :integer;
    tau, t, d, s :real;
    eps : real;

....
вместо

Цитата:

Код:

   m := 5;
   for i:= 1 to n do x[i]:= 0;

Код:

  WriteLn('Ввод параметров.')
  Write('Введите EPS: '); Readln(eps);
  Write('Введите M: '); Readln(m);
  Write('Введите построчно элементы массива X');
  for i:= 1 to n do  begin
     Write('X[',i,'] = '); ReadLn(x[i]);
  end;

Camelot_2012 · 28.10.2015, 18:23

Спасибо, правильно поняли. Но можете помочь еще разобраться почему я ввожу данные х(0,0), а программа берет (4, 3.3333)?

Serge_Bliznykov · 28.10.2015, 23:56

Цитата:

Но можете помочь еще разобраться почему я ввожу данные х(0,0), а программа берет (4, 3.3333)?

она берёт то, что Вы ввели (0, 0)
а потом делает кучу вычислений:

Цитата:

Код:

        calcA(x, a);
          calcTau(x, tau);
          calcDelta2X(a, tau, delta2X);
          gradf(x, grf);
          calcDX(a, grf, dx);

....
               // #11: calc x^k
               // #12: calc tk
               
               d:= sqr(norm(grf));
               gradf(grf, grf2);
               s := 0;
               for i:=1 to n do s:= s + grf[i] * grf2[i];
               t := d/s;

по потом использует эти вычисленные значения t, dx, delta2x для суммирования в X:

Цитата:

Код:

        // #13: calc x ^ k+1
          for i:=1 to n do
              x[i]:= x[i] + t * dx[i] + delta2x[i];

полученные X выводит на экран.
видимо, получаются значения 4, 3.3333

Camelot_2012 · 29.10.2015, 11:50

Цитата:

Сообщение от Serge_Bliznykov

полученные X выводит на экран.
видимо, получаются значения 4, 3.3333

Это я разобрал, но в книге на этой иттерации получается (4,5)
https://drive.google.com/file/d/0Bw_...it?usp=sharing
шаги расписаны на стр 298-301 (все иттерации)

помогите пожалуйста разобраться

Serge_Bliznykov · 29.10.2015, 12:11

Цитата:

помогите пожалуйста разобраться

извините, я это вряд ли смогу сделать.

проходите в отладчике, смотрите чему равны промежуточные значения, ищите, где идёт несовпадение...
Либо обратитесь к кому-нибудь более компетентному в математике.

сначала проверьте решение из учебника "вручную" - на калькуляторе или в MS Excel
пошагово. чтобы понять, откуда какие числа берутся.
а потому уже смотрите, что выдаёт ваша программа.

Успехов!

Camelot_2012 · 29.10.2015, 12:14

Цитата:

Сообщение от Serge_Bliznykov

извините, я это вряд ли смогу сделать.

проходите в отладчике, смотрите чему равны промежуточные значения, ищите, где идёт несовпадение...
Либо обратитесь к кому-нибудь более компетентному в математике.

Спасибо большое и на этом!

Camelot_2012 · 03.11.2015, 12:14

Цитата:

Сообщение от Serge_Bliznykov

извините, я это вряд ли смогу сделать.

проходите в отладчике, смотрите чему равны промежуточные значения, ищите, где идёт несовпадение...
Либо обратитесь к кому-нибудь более компетентному в математике.

сначала проверьте решение из учебника "вручную" - на калькуляторе или в MS Excel
пошагово. чтобы понять, откуда какие числа берутся.
а потому уже смотрите, что выдаёт ваша программа.

Успехов!

Код:

uses crt;
const n=2; h=0.0005;
type vector=array [1..n] of real;
var x, delta2x, grf, grf2, dx, a : vector;
    i,j, k, m :integer;
    tau, t, d, s, eps :real;

function f(x:vector):real;
begin
     f:=sqr(x[1])+sqr(x[2]);
end;

function g(x:vector):real;
begin
     g:=sqr(x[1]-1)+sqr(x[2])-4;
end;

function norm(x:vector):real;
var S:real; i:integer;
begin
     S:=0;
     for i:=1 to n do S:= S + sqr(x[i]);
     norm:=sqrt(S);
end;

PROCEDURE gradf(x:vector; var Gr:vector);
var u,v:vector; i:integer;
begin
for i:=1 to n do
     begin
     u:=x;
     v:=x;
     u[i]:=x[i]+h;
     v[i]:=x[i]-h;
     Gr[i]:=(f(u)-f(v))/(2*h);
     end;
end;

procedure calcA(x:vector; var A:vector);
var i : integer;
begin
     A[1] := 2 * (x[1]-1);
     A[2] := 2 * x[2];
end;

procedure calcTau(x:vector; var tau:real);
begin
     tau := -g(x);
end;

// AT x (A x AT)^-1
procedure multA(a:vector; var tmpA:vector);
var i : integer;
    s : real;
begin
     s := 0;
     for i:= 1 to n do s := s + sqr(a[i]);
     for i:= 1 to n do tmpA[i] := a[i] / s;
end;

procedure calcDelta2X(a:vector; tau:real; var deltaX:vector);
var i: integer;
    tmpA : vector;
begin
     multA(a, tmpA);
     for i:= 1 to n do deltaX[i] := tmpA[i] * tau;
end;

procedure calcDX(a:vector; grf:vector; var dx:vector);
var i, j: integer;
    tmpA : vector;
    res : array[1.. n, 1..n] of real;
    s : real;
begin
     multA(a, tmpA);

     for i:=1 to n do
     for j:=1 to n do
     begin
          if( i = j ) then res[i, j] := 1 - tmpA[i] * a[j]
          else res[i, j]:= -tmpA[i] * a[j];
     end;
      
     for i:=1 to n do
     begin
          s := 0;
          for j:=1 to n do s := s + grf[j] * res[i, j];
          dx[i] := -s;
     end;
end;

BEGIN
     clrscr;
     WriteLn('Ввод параметров');
     Write('Введите EPS: '); Readln(eps);
     Write('Введите M: '); Readln(m);
     WriteLn('Введите построчно элементы массива X');
     for i:= 1 to n do  begin
     Write('X[',i,'] = '); ReadLn(x[i]);
     end;
     for k := 0 to m+1 do
     begin
          calcA(x, a);
          calcTau(x, tau);
          calcDelta2X(a, tau, delta2X);
          gradf(x, grf);
          calcDX(a, grf, dx);

          
          
          if (norm(dx) <= eps) and (norm(delta2X) <= eps) then
          begin
               writeln('Calculation complete: dx <= eps && delta2X <= eps');
               break;
          end;
          
          if (norm(dx) <= eps) and (norm(delta2x) > eps) then
          begin
               for i:= 1 to n do dx[i] := 0;
               t := 0;
          end
          else
          begin
               if (norm(dx) > eps) and (norm(delta2x) <= eps) then for i:= 1 to n do delta2x[i] := 0;
               // #11: calc x^k
               // #12: calc tk
               
               d:= sqr(norm(grf));
               gradf(grf, grf2);
               s := 0;
               for i:=1 to n do s:= s + grf[i] * grf2[i];
               t := d/s;
               
          
          end;
          //proection(delta2x, t);

          // #13: calc x ^ k+1
          for i:=1 to n do
          x[i]:= x[i] + t * dx[i] + delta2x[i];

          writeln;
          write('x = ');
          for i:= 1 to n do write(x[i]:5:4, ' ');
          writeln;
          write('A = ');
          for i:= 1 to n do write(a[i]:5:4, ' ');
          writeln;
          writeln('Tau: ',tau:5:4);
          write('delta2x = ');
          for i:= 1 to n do write(delta2X[i]:5:4, ' ');
          writeln;
          write('gradf = ');
          for i:= 1 to n do write(grf[i]:5:4, ' ');
          writeln;
          write('dx = ');
          for i:= 1 to n do write(dx[i]:5:4, ' ');
          writeln;
          writeln('t = ', t:5:4);
          writeln('k = ', k);      
          
     end;

END.

ошибка при запуске, как исправить?

Camelot_2012 · 03.11.2015, 13:01

перезагрузил, заработало

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Удалить DX11 вручную.	Gresh2007	Софт	0	16.11.2012 13:57
Перетягивание формы вручную	_PROGRAMM_	Общие вопросы Delphi	4	26.10.2011 20:13
График вручную	Heming	Помощь студентам	0	18.10.2010 13:44
PostMessage программно и вручную	YuraL	Win Api	5	12.03.2009 07:54
Копирование *.exe вручную	v01umE	Общие вопросы C/C++	4	06.07.2008 20:06

03.11.2015, 13:01	#9
Camelot_2012 Пользователь Регистрация: 19.12.2011 Сообщений: 90	перезагрузил, заработало