Здравствуйте все!

Есть задание:
Решить систему линейных алгебраических уравнений методом простых итерации с точностью e=0,001.
x1+5*x2-x3=7
x1-x2+5*x3=7
8*x1+x2+x3=26

Вот мое решение:

uses crt;
const n=3;
      eps=0.001;
      a:array[1..n,1..n] of shortint=(( 1,5,-1),(1,-1,5),( 8,1,1));
      b:array[1..n] of shortint=(7,7,26);
 
var x:array[1..n,1..n] of real;
    i,j,p,k:byte;
    x1,x2,x3,tmp1,tmp2,tmp3:real;
begin
     clrscr;
     writeln('система уравнений:');
     for i:=1 to n do
         begin
              for j:=1 to n do write(a[i,j]:3);
              writeln(b[i]:3);
         end;
     {проверка диоганалей}
     for i:=1 to n do
         begin
              p:=0;
              for j:=1 to n do
                  if i<>j then p:=p+a[i,j];
              if a[i,i]<p then break;
         end;
     {перестановка строк}
     for i:=n downto 2 do
         begin
              for j:=1 to n do
                  begin
                       p:=a[i,j];
                       a[i,j]:=a[i-1,j];
                       a[i-1,j]:=p;
                  end;
              p:=b[i];
              b[i]:=b[i-1];
              b[i-1]:=p
         end;
     for i:=1 to n do
         begin
              for j:=1 to n do write(a[i,j]:3);
              writeln(b[i]:3);
         end;
     writeln;
     {искл. диагоналей}
     for i:=1 to n do
         begin
              j:=1;k:=0;
              while (k<=n) and (j<=n) do
                    if j<>i then
                       begin
                            inc(k);
                            x[i,k]:=a[i,j]/-a[i,i];
                            inc(j);
                       end
                       else inc(j);
              x[i,n]:=b[i]/a[i,i];
         end;
     for i:=1 to n do
         begin
              for j:=1 to n do write(x[i,j]:7:3);
              writeln;
         end;
     x1:=0;x2:=0;x3:=0;k:=1;
     repeat
           tmp1:=x[k,1]*x2+x[k,2]*x3+x[k,3];
           inc(k);
           tmp2:=x[k,1]*x1+x[k,2]*x3+x[k,3];
           inc(k);
           tmp3:=x[k,1]*x1+x[k,2]*x2+x[k,3];
           k:=1;
           x1:=tmp1;x2:=tmp2;x3:=tmp3;
           writeln('x1=',x1:6:3,' x2=',x2:6:3,' x3=',x3:6:3);
     until (x1<=eps)or(x2<=eps)or(x3<=eps);
     readln;
end.

Проблема заключается в том что последний цикл не решается, т.е. сам пример. Решил проверить в ручную и тоже самое.
Неужели это система не решаемое? или я что-то на путал? Объясните пожалуйста.

П.С. если уж она не решается, подскажите ка закончить программу для сдачи преподу.

Интересно получается )). Ты посмотри на условие выхода из цикла. Что оно означает? Что ты ждешь, что решение будет нулевым.

Надо сравнивать с заданной точностью НЕ САМИ решения, а их разности на последовательных итерациях.
Короче, я подправил (и не только), и программа успешно завершается. Но я совершенно не знаю, что ты делаешь выше этого цикла. Например, зачем нужен кусок, который у тебя называется "проверка диоганалей" (орфография сохранена)), если он не оказывает совершенно никакого влияния на выполнение программы? Это просто так - потусоваться что ли? ))

const
  n= 3;
  e= 0.001;
  a: array[1..n,1..n] of shortint=(( 1,5,-1),(1,-1,5),( 8,1,1));
  b: array[1..n] of shortint=(7,7,26);

var
  x: array[1..n,1..n] of real;
  i,j,p,k: byte;
  x1,x2,x3,t1,t2,t3:real;

begin
  writeln('система уравнений:');
  for i:=1 to n do begin
    for j:=1 to n do write(a[i,j]:3);
    writeln(b[i]:3);
  end;
     {проверка диоганалей}
  for i:=1 to n do begin
    p:=0;
    for j:=1 to n do
      if i<>j then p:=p+a[i,j];
    if a[i,i]<p then break;
  end;
     {перестановка строк}
  for i:=n downto 2 do begin
    for j:=1 to n do begin
      p:=a[i,j];
      a[i,j]:=a[i-1,j];
      a[i-1,j]:=p;
    end;
    p:=b[i];
    b[i]:=b[i-1];
    b[i-1]:=p
  end;
  for i:=1 to n do begin
    for j:=1 to n do write(a[i,j]:3);
    writeln(b[i]:3);
  end;
  writeln;
     {искл. диагоналей}
  for i:=1 to n do begin
    j:=1;
    k:=0;
    while (k<=n) and (j<=n) do
      if j<>i then begin
        inc(k);
        x[i,k]:=a[i,j]/-a[i,i];
        inc(j);
      end
      else inc(j);
    x[i,n]:=b[i]/a[i,i];
  end;
  for i:=1 to n do begin
    for j:=1 to n do write(x[i,j]:7:3);
    writeln;
  end;
  x1:=0;
  x2:=0;
  x3:=0;
  repeat
    t1:= x1;
    t2:= x2;
    t3:= x3;
    x1:=x[1,1]*t2+x[1,2]*t3+x[1,3];
    x2:=x[2,1]*t1+x[2,2]*t3+x[2,3];
    x3:=x[3,1]*t1+x[3,2]*t2+x[3,3];
    writeln('x1=',x1:6:3,' x2=',x2:6:3,' x3=',x3:6:3);
  until (Abs(x1-t1)<=e) and (Abs(x2-t2)<=e) and (Abs(x3-t3)<=e);
  readln;
end.

Lapp, спасибо большое.


В справочниках, где говорилось про решение слау методом простых итерации, необходимо чтобы диагональные значения были больше суммы остальных данной строки, вот почему стоит проверка диагоналей.
Мне преподаватель говорил, что любой программист должен стремится к универсальности (как-то так примерно), т.е. писать программы не для единичного случая, а для схожих типов задач (типовых).
В данном случае это черновой вариант программы, надо лишь немного отредактировать (сделать подпрограммы) и будит МОЯ СОБСТВЕННАЯ типовая программа для решения слау методом простых итерации.

Еще раз спасибо.

Я ни секунды не возражаю. Все, что я сказал - это что тот кусок не оказывает ни малейшего воздействия на выполнение программы. Что его нет, что он есть - результат один. Разница только во времени выполнения (без него быстрее)).

Если делаешь проверку, то:
1. делай ее правильно;
2. используй ее результаты как-то.

Как не оказывает!?
А если в другом примере не нужно переставлять строки, и так все устраивает. Тогда действие перестановки строки будет не нужной и приводящая к неправильному решению.

Ее результат используется, нужна ли перестановка или нет

Зачем так эмоционально?
Компьютер не реагирует на эмоции, криком ничего с ним не добьешься.

Еще раз тебе говорю - вот этот кусок:

     {проверка диоганалей}
     for i:=1 to n do
         begin
              p:=0;
              for j:=1 to n do
                  if i<>j then p:=p+a[i,j];
              if a[i,i]<p then break;
         end;

- совершенно никакого действия на последующее выполнение программы не оказывает. Чем возмущаться, лучше проверь.

Верно данный кусок в моем примере никакого действия на последующее выполнение программы не оказывает. ОДНАКО, как я говорил, это черновой вариант и пишу под общий тип. Т.е. этот кусок будет у меня подпрограммой и выполнять проверку для других однотипных задач, где требуется перестановка, а где нет.

Что это верно, я знал с самого начала, мне твое подтверждение не требовалось.

Vitik, не надо нести чушь в оправдание.
Я видел только этот твой код и говорил, естественно, только про него.
Я указал на факт, на что ты отреагировал так: "Как не оказывает!?" Верно?
А теперь ты пишешь, это типа была часть плана?..
Простое "спасибо" за указание на ошибку тут было бы ГОРАЗДО уместнее.

Может, ты и научишься программировать. Но ОЧЕНЬ тебе рекомендую научиться признавать свои ошибки и не лезть в бутылку, когда тебе стараются помочь. В этом нет ничего страшного, и - главное - всем будет хорошо.

Успехов тебе.

Здравствуйте! Мне тоже понадобилась решение СЛАУ этим методом. Нашёл ваш код. Но возникла проблема при компиляции. Выдаёт ошибку, что "Невозможно присвоить константному объекту" в куске кода:

p:=b[i];
b[i]:=b[i-1];
b[i-1]:=p

Как решить данную проблемку?

А вообще мне нужно переделать прогу под размерность 4х4, но я думаю с этим сам справлюсь.

перенеси код из const в var