Форум программистов, компьютерный форум, киберфорум
Pascal ABC
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.93/15: Рейтинг темы: голосов - 15, средняя оценка - 4.93
0 / 0 / 1
Регистрация: 01.03.2012
Сообщений: 5
1

Решение матриц по теореме Гаусса

21.04.2012, 10:37. Показов 2954. Ответов 5
Метки нет (Все метки)

Проверьте пожалуйста программу для решения матрицы, записанной в блокноте, по теореме Гаусса, не знаю в чем ошибка, но программа не работает...

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
program variant27;
 
type mat=array[1..5,1..6] of real;
vec=array[1..5] of real;
var i,j,k,n,k1,n1:integer; s,r:real; {Реальное число уравнений}
a:mat; x:vec;
var f:text;
 
begin
Write('Введите число уравнений N = '); readln(n);
assign(f,'mat.txt'); {имя файла данных на диске}
reset(f);
for i:=1 to n do
      begin      
        for j:=1 to n+1 do read(f,a[i,j]);   
        readln(f);
        end;
close(f);
        begin
          n1:=n+1;
          for k:=1 to n do
                 begin
                    k1:=k+1;
                    s:=a[k,k];j:=k;
                    for i:=k1 to n do
                        begin
                           r:=a[i,k]; 
                           if abs(r)>abs(s) then
                               begin
                                  s:=r; j:=i;
                               end;
                        end;
     
                    if s=0 then
                           begin
                             writeln('Переставьте уравнения чтобы на главной диагонали не было нулевых коэффициентов !');
                             halt;
                           end;
                    if j<>k then
                    for i:=k to n+1 do
                           begin
                              r:=a[k,i]; a[k,i]:=a[j,i];a[j,i]:=r;
                           end;
                    for j:=k1 to n1 do a[k,j]:=a[k,j]/s;
                    for i:=k1 to n do
                          begin
                             r:=a[i,k];
                             for j:=k1 to n1 do
                             a[i,j]:=a[i,j]-a[k,j]*r;
                          end;
               end;
          if s<>0 then
          for i:=n downto 1 do
                 begin s:=a[i,n1];
                     for j:=i+1 to n do s:=s-a[i,j]*x[j];
                     x[i]:=s;
                 end;
       end;
 
  begin
     Write('Введите число уравнений N = '); readln(n);
     assign(f,'mat.txt'); {имя файла данных на диске}
     reset(f);
     for i:=1 to n do
           begin
              for j:=1 to n1 do read(f,a[i,j]);
              readln(f);
           end;
  close(f);
  for i:=1 to n do
  writeln('X[,i,]=',X[i]);
  writeln('Проверка:');
  for i:=1 to n do
       begin
          s:=0;
          for j:=1 to n do s:=s+a[i,j]*X[j];
          write('Уравнение ',i,' ',s,' = ',a[i,n+1]);
          writeln(' Погрешность ',
          abs((s-a[i,n+1])/s));
      end;
  end;
End.
__________________
Помощь в написании контрольных, курсовых и дипломных работ здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
21.04.2012, 10:37
Ответы с готовыми решениями:

Решение матриц Методом Гаусса
Ребят, не запускается программа на C++ для Решения матриц Методом Гаусса. Пожалуйста, запустите и...

Задача по Теореме Гаусса
Подскажите пожалуйста как решить эту задачу по Теореме Гаусса

Задача по теореме Гаусса
Ha двух бесконечных параллельных плоскостях равномерно распределены заряды c поверхностными...

Найти напряженность поля по теореме Остроградского-Гаусса
В шаре радиуса 2R, несущем равномерно распределенный заряд с объемной плотностью p=10мкКл/м^3,...

5
Почетный модератор
64085 / 47494 / 32734
Регистрация: 18.05.2008
Сообщений: 115,182
21.04.2012, 11:10 2
Чтение матрицы из файла.
в файле первое число количество уравнений, затем расширенная матрица
например
3
1.23 -3.56 1.36 12.56
0.35 -1.25 -0.23 8.23
5.32 8.23 1.36 15.06
читаем
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
assign(f,'mat.txt'); {имя файла данных на диске}
reset(f);
read(f,n);
for i:=1 to n do
 begin
  for j:=1 to n+1 do
   begin
    read(f,a[i,j]);
    write(a[i,j]:6:2);
   end;
  writeln;
 end;
close(f);
дальше не очень понял что Вы делаете и почему 2 раза чтение матрицы...
1
0 / 0 / 1
Регистрация: 01.03.2012
Сообщений: 5
21.04.2012, 12:22  [ТС] 3
При решении системы методом Гаусса перед проверкой нужно заново произвести ввод исходной матрицы из файла данных. Это нужно сделать потому, что исходная матрица A была преобразована в треугольную при прямом проходе и теперь требуется перечитать её исходное состояние для проведения проверки.
0
Почетный модератор
64085 / 47494 / 32734
Регистрация: 18.05.2008
Сообщений: 115,182
21.04.2012, 12:23 4
Понятно. Хотя можно и не читать второй раз, а просто сохранить копию матрицы
b:=a;
и делать проверку с ней.
1
0 / 0 / 1
Регистрация: 01.03.2012
Сообщений: 5
21.04.2012, 12:54  [ТС] 5
из-за этой проверки путаница..
b:=a;
и вместо "а" в проверке поставить "b"?

Добавлено через 30 минут
а как окончательно будет выглядеть программа?
0
Почетный модератор
64085 / 47494 / 32734
Регистрация: 18.05.2008
Сообщений: 115,182
21.04.2012, 15:12 6
Цитата Сообщение от dreder93 Посмотреть сообщение
а как окончательно будет выглядеть программа?
Как напишешь, так и будет выглядеть... Вряд ли у кого-то есть желание ковыряться в твоем коде, проще свой написать.

Добавлено через 2 часа 4 минуты
Я вот так написал.
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
program lab4;
uses crt;
const nmax=10;//макс кол уравнений
      e=0.001; //точность
var t:text;
    m,m1:array[1..nmax,1..nmax] of real;
    x,y:array[1..nmax] of real;
    n,i,j,k:integer;
    c,d:real;
    f:boolean;
begin
assign(t,'mat.txt');
reset(t);
read(t,n);
writeln('Коэффициенты уравнений:');
for i:=1 to n do
 begin
  for j:=1 to n+1 do
   begin
    read(t,m[i,j]);
    if j<=n then  write(m[i,j]:6:2)
    else write(m[i,j]:8:2);
   end;
  writeln;
 end;
close(t);
writeln;
m1:=m;  //запомним
for k:=1 to n-1 do
 begin
  if m[k,k]=0 then //если главный элемент=0
  for i:=k+1 to n do //то обмениваем строки
  if m[i,k]<>0 then
   begin
    for j:=1 to n+1 do
     begin
      c:=m[k,j];
      m[k,j]:=m[i,j];
      m[i,j]:=c;
     end;
    break;
   end;
  for i:=k+1 to n do //приводим к треугольному виду
   begin
    c:=-m[i,k]/m[k,k];
    for j:=1 to n+1 do
    m[i,j]:=m[i,j]+c*m[k,j];
   end;
 end;
for k:=n downto 2 do  //обратный ход
for i:=k-1 downto 1 do
 begin
  c:=-m[i,k]/m[k,k];
  for j:=1 to n+1 do
  m[i,j]:=m[i,j]+c*m[k,j];
 end;
for k:=1 to n do
  begin
   x[k]:=m[k,n+1]/m[k,k];
   writeln('x',k,'=',x[k]:0:3);
  end;
writeln('Проверка:');
f:=true;
for i:=1 to n do
 begin
  y[i]:=0;
  for j:=1 to n do
  y[i]:=y[i]+m1[i,j]*x[j];
  writeln('y[',i,']=',y[i]:0:2,' погрешность=',abs(m1[i,n+1]-y[i])/abs(m1[i,n+1]):0:4);
  if abs(m1[i,n+1]-y[i])>e then f:=false;
 end;
if f then writeln('Система решена верно!')
else writeln('Система решена не верно!');
end.
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
21.04.2012, 15:12

Решение системы линейных уравнений методом Гаусса и Жордана-Гаусса
Помогите пожалуйста начала работать сначала работать с методом Гаусса, но в Unit2 Delphi ругается...

Решение квадратного уравнения по теореме Виета
Ребят, не знаю как реализовать код для этого задания, очень прошу вас помочь!

Найти решение системы сравнений по китайской теореме об остатках
Здравствуйте! Решаю одну задачу, где нужно в кольце целых чисел найти x из системы сравнений по...

Найти общее решение и одно частное решение, используя метод Гаусса
Найти общее решение и одно частное решение используя метод Гаусса -15х1+2х2-11х3-3х4=1...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
6
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2022, CyberForum.ru