Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Слау методом простых итерации. Не решаемое?

Автор: Vitik 11.05.2011 14:18

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

Есть задание:
Решить систему линейных алгебраических уравнений методом простых итерации с точностью 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.

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

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

Автор: Lapp 11.05.2011 15:52

Цитата(Vitik @ 11.05.2011 11:18)

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

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

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

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

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.

Автор: Vitik 12.05.2011 2:36

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

Цитата

зачем нужен кусок, который у тебя называется "проверка диоганалей" (орфография сохранена)), если он не оказывает совершенно никакого влияния на выполнение программы? Это просто так - потусоваться что ли? ))

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

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

Автор: Lapp 12.05.2011 6:31

Цитата(Vitik @ 11.05.2011 23:36)

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

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

Автор: Vitik 12.05.2011 13:38

Цитата

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

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

Цитата

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

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

Автор: -Lapp- 12.05.2011 15:11

Цитата(Vitik @ 12.05.2011 9:38)

Как не оказывает!?

Зачем так эмоционально?

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

Цитата

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

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

     {проверка диоганалей}
     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 12.05.2011 18:03

Цитата

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

     {проверка диоганалей}
     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;

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

Автор: Lapp 13.05.2011 3:46

Цитата(Vitik @ 12.05.2011 15:03)

Верно данный кусок в моем примере никакого действия на последующее выполнение программы не оказывает.

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

Цитата

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

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

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

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

Автор: -Дмитрий- 1.11.2012 1:58

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

Автор: Гость 1.11.2012 1:59

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

Автор: Гость 1.11.2012 2:01

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

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

Автор: Гость 26.06.2016 23:57

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