ЧМ СЛАУ Итерация Опции

[Leito]

нужно написать программу решающую СЛАУ методом итерации. вот система
0.13x1-0.14x2-2x3=0.15
0.75x1+0.18x2+0.77x3=0.11
0.28x1-0.17x2+0.39x3=0.12
она же в виде с преобладающим диагональным коэфициентом
1.16x1-0.13x2-0.84x3=0.38
-0.76x1-2.08x2+0.04x3=0.52
0.13x1-0.14x2-2x3=0.15
или с уравнениями, поделенными на этот самый преобладающий коэфициент
x1-0.112x2-0.724x3=0.328
0.365x1+x2-0.019x3=-0.25
-0.065x1+0.07x2+x1=-0.075
вот что вышло

uses crt;
Label 1;
var A:array[1..3,1..3] of real;
B,X,Y:array[1..3] of real;
n,i,j,k:integer;
e,Nl,Nm,Nk,Sm,Sl,S,Rx,Ry:real;
begin
clrscr;
n:=4;
e:=0.001;
a[1,1]:=1.16; a[1,2]:=-0.13; a[1,3]:=-0.84; b[1]:=0.38;
a[2,1]:=-0.76; a[2,2]:=-2.08; a[2,3]:=0.04; b[2]:=0.52;
a[3,1]:=0.13; a[3,2]:=-0.14; a[3,3]:=-2; b[3]:=0.15;
Nm:=0; Nl:=0; Nk:=0;
for i:=1 to n do
begin
Sm:=0; Sl:=0;
for j:=1 to n do
begin
Sm:=Sm+abs(A[i,j]);
Sl:=Sl+abs(A[j,i]);
Nk:=Nk+sqr(A[i,j]);
end;
if Nm<Sm then Nm:=Sm;
if Nl<Sl then Nl:=Sl;
end;
Nk:=sqrt(Nk);
if (Nm>1) and (Nl>1) and (Nk>1) then
begin
Writeln ('prozess NE zbi}|{nij');
exit;
end
else
begin
Writeln ('prozess zbi}|{nij');
writeln ('Nm=',Nm:6:4,' Nl=',Nl:6:4,' Nk=',Nk:6:4);
end;
k:=0;
for i:=1 to n do Y[i]:=B[i];
1: for i:=1 to n do
begin
s:=0;
for j:=1 to n do s:=s+a[i,j]*Y[j];
X[i]:=B[i]+s;
end;
inc (k);
Rx:=0; Ry:=0;
for i:=1 to n do
begin
Rx:=Rx+abs(x[i]);
Ry:=Ry+abs(y[i]);
end;
if abs(Rx-Ry)>e then
begin
writeln('Iteraziya-',k);
for i:=1 to n do
begin
writeln('X[',i,']=',X[i]:6:4);
Y[i]:=X[i];
end;
goto 1;
end;
writeln('rozviazok sustemu');
writeln('Iteraziya-',k);
for i:=1 to n do writeln('X[',i,']=',X[i]:6:4);
readkey;
end.

пишет что ниодна метрика не подходит, исправьте плз что не верно
ЗЫ в маткаде система решается по любой из трех метрик

Сообщение отредактировано: Leito - 18.01.2009 15:36

[volvo]

Ну, вот эта реализация метода итераций находит за 5 проходов решение твоей системы:

const
  eps = 0.00001;
  n   = 3;

type
  matrix = array[1 .. n, 1 .. n + 1] of double;
  vector = array[1 .. n] of double;

const
  AnB: matrix = (
    ( 1.000, -0.112, -0.724, 0.328),
    ( 0.365,  1.000, -0.019, -0.25),
    (-0.065,  0.070,  1.000, -0.075)
  );

procedure OutVector(const X: vector; n: byte; iters: word);
var i: integer;
begin
  writeln(iters, ' iterations:');
  for i := 1 to n do begin
    writeln('X[', i, '] = ', X[i]:8 :5);
  end;
end;

function Normalize(var AnB: matrix; n: byte): byte;
var
  max, tmp: double;
  imax, i, j: byte;
begin
  Normalize:=2;
  for j :=1 to n do begin
    max:=Abs(AnB[1,j]);
    imax:=1;
    for i:=2 to n do
      if Abs(AnB[i,j]) > max then begin
        max:=Abs(AnB[i,j]);
        imax:=i;
      end;
    if max < Eps then begin
      Normalize:=0;
      Writeln('Error: a[i,i] = 0 !!!');
      exit;
    end
    else
      if j <> imax then
        for i:=1 to n+1 do begin
              tmp:=AnB[j,i];
              AnB[j,i]:=AnB[imax,i];
              AnB[imax,i]:=tmp;
            end;
  end;

  for i:=1 to n do begin
    tmp:=0;
    for j:=1 to n do
      if i <> j then tmp:=tmp+Abs(AnB[i,j]);
      if Abs(AnB[i,i]) < tmp then Normalize:=1;
  end;
end;

var
  X: vector;
  i,j: byte;
  tmp: double;
  delta: double;
  iters: word;

function Summ(i: byte): double;
var
  j: byte;
  res: double;
begin
  res:=AnB[i, n+1];
  for j:=1 to n do
    if i <> j then
      res:=res-AnB[i,j]*X[j];
  Summ:=res;
end;

begin
  for i := 1 to n do X[i] := 0;

  if Normalize(AnB,n) <> 2 then begin
    writeln('Error: !'); exit;
  end;

  delta := 1;
  iters := 0;
  while delta > Eps do begin
    delta:=0;
    for i:=1 to n do begin
      tmp:=Summ(i)/AnB[i,i];
      if delta < Abs(tmp-X[i]) then
        delta := Abs(tmp-X[i]);
      X[i] := tmp;
    end;
    inc(iters);
  end;
  OutVector(X, n, iters);
end.

Вот такой ответ выдается:

5 iterations:
X[1] = 0.26487
X[2] = -0.34731
X[3] = -0.03347

Это тебе показывает Маткад?

[Leito]

можно удолить это сообщение, я догнал)
написал вначале программы {$N+}

Сообщение отредактировано: Leito - 18.01.2009 22:25

[Unconnected]

На TP7 "Options>Compiler", и там в поле "Numeric processing" ставь крестик возле пункта "8027/80287".