Технический форум
Вернуться   Технический форум > Программирование > Форум программистов > Помощь студентам


Ответ
 
Опции темы Опции просмотра
Старый 27.12.2010, 15:31   #1 (permalink)
kalugin66
Новичок
 
Регистрация: 19.12.2010
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Question Решение системы линейных уравнений - программа не работает

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


Program Gauss;
uses crt;
const N=3;
eps=0.00001; { all numbers less than eps are equal 0 }
type matr=array [1. n,1. n] of real;
mas=array [1. n] of real;
var
i,j: integer;
b,x: mas;
variant: byte;
a,c: matr;
dt: real;
imx,np: integer;
{*** печать исходной и обратной матрицы*** }
procedure PrintMatr2 (m,m1: matr; n,nz,nd: integer);
var i,j: integer;
begin
for i: =1 to n do
begin
if (i=1) then write (np: 2,': ')
else write (' ');
for j: =1 to n do
write (m [i,j]: nz: nd); write (' ');
for j: =1 to n do
write (m1 [i,j]: nz: nd);
writeln;
end;
inc (np);
end;
procedure MultString (var a,b: matr; i1: integer; r: real);
var j: integer;
begin
for j: =1 to n do
begin
a [i1,j]: =a [i1,j] *r;
b [i1,j]: =b [i1,j] *r;
end;
end;
procedure AddStrings (var а,b: matr; i1, i2: integer; r: real);
{ процедура прибавляет к i1 строке матрицы а i2-ю умноженную на r}
var j: integer;
begin
for j: =1 to n do
begin
a [i1,j]: =a [i1,j] +r*a [i2,j] ;
b [i1,j]: =b [i1,j] +r*b [i2,j] ;
end;
end;
procedure MultMatr (a,b: matr; var c: matr);
var i,j,k: byte;
s: real;
begin
for i: =1 to n do
for j: =1 to n do
begin
s: =0;
for k: =1 to n do
s: =s+a [i,k] *b [k,j] ;
c [i,j]: =s;
end;
end;
function sign (r: real): shortint;
begin
if (r>=0) then sign: =1 else sign: =-1;
end;
{************************************************* **}
{** вычеркивание из матрицы строки и столбца **}
procedure GetMatr (a: matr; var b: matr; m, i,j: integer);
var ki,kj,di,dj: integer;
begin
di: =0;
for ki: =1 to m-1 do
begin
if (ki=i) then di: =1;
dj: =0;
for kj: =1 to m-1 do
begin
if (kj=j) then dj: =1;
b [ki,kj]: =a [ki+di,kj+dj] ;
end;
end;
end;
{*** метод Гаусса *******}
procedure gauss (a: matr; b: mas; var x: mas; n: integer);
Var k: byte;
m, s: real;
begin
{ приведение к треугольному виду}
For k: =1 to N-1 do
For i: =k+1 to n do
begin
m: =a [i,k] /a [k,k] ;
a [i,k]: =0;
For j: =k+1 to N do
a [i,j]: =a [i,j] -m*a [k,j] ;
b [i]: =b [i] -m*b [k] ;
end;
{расчет неизвестных х в обратном порядке}
x [n]: =b [n] /a [n,n] ;
writeln;
writeln ('Вывод результатов решения системы уравнений методом Гаусса');
writeln ('x [',n,'] =',x [n]: 6: 2);
for i: = (n-1) downto 1 do
begin s: =0;
For j: =i+1 to n do
s: =s-a [i,j] *x [j] ;
x [i]: = (b [i] +s) /a [i, i] ;
writeln ('x [', i,'] =',x [i]: 6: 2);
end;
end;
{*** матричный способ ***}
procedure matrica (a: matr; y: mas; n: integer);
var z,a0: matr;
imx,np: integer;
s: mas;
begin
for i: =1 to n do
begin
for j: =1 to n do z [i,j]: =0;
z [i, i]: =1;
end;
for i: =1 to n do
for j: =1 to n do
a0 [i,j]: =a [i,j] ;
for i: =1 to n do
begin
{ к i-ой строке прибавляем (или вычитаем) j-ую строку
взятую со знаком i-того элемента j-ой строки. Таким образом,
на месте элементова a [i, i] возникает сумма модулей элементов i-того
столбца (ниже i-ой строки) взятая со знаком бывшего элемента a [i, i],
равенство нулю которой говорит о несуществовании обратной матрицы }
for j: =i+1 to n do
AddStrings (a,z, i,j,sign (a [i, i]) *sign (a [j, i]));
{ PrintMatr (a,b,n,6,1); }
{ прямой ход }
if (abs (a [i, i]) >eps) then
begin
MultString (a,z, i,1/a [i, i]);
for j: =i+1 to n do
AddStrings (a,z,j, i,-a [j, i]);
{ PrintMatr (a,b,n,6,1); }
end
else
begin
writeln ('Обратной матрицы не существует. ');
halt;
end
end;
{обратный ход: '); }
if (a [n,n] >eps) then
begin
for i: =n downto 1 do
for j: =1 to i-1 do
begin
AddStrings (a,z,j, i,-a [j, i]);
end;
{ PrintMatr (a,b,n,8,4); }
end
else writeln ('Обратной матрицы не существует. ');
MultMatr (a0,z,a);
writeln ('Начальная матрица, обратная к ней матрица: ');
PrintMatr2 (a0,z,n,7,3);
{** умножение обратной матрицы на столбец свободных членов **}
for i: =1 to n do s [i]: =0;
for i: =1 to n do
for j: =1 to n do
s [i]: =s [i] +z [i,j] *y [j] ;
writeln ('Вывод результатов решения системы уравненй матричным способом');
for i: =1 to n do write (' ', s [i]: 5: 2);
end;
begin {***** тело программы ******}
clrscr;
writeln ('ввод матрицы коэффициентов при неизвестных х');
for i: =1 to N do
for j: =1 to N do
begin
write (' введите a [', i,',',j,'] => ');
read (a [i,j]);
end;
writeln ('ввод столбца свободных членов');
for i: =1 to N do
begin
write (' введите b [', i,'] => ');
read (b [i]);
end;
writeln ('введите вариант ');
writeln (' 1 - решение системы линейных уравнений методом Гаусса ');
write (' 2 - решение системы линейных уравнений матричным методом => ');
readln (variant);
case variant of
1: gauss (a,b,x,n);
2: matrica (a,b,n);
else writeln ('неверно указан вариант');
end;
end.
kalugin66 вне форума   Ответить с цитированием

Старый 27.12.2010, 15:31
Helpmaster
Member
 
Аватар для Helpmaster
 
Регистрация: 08.03.2016
Сообщений: 0

Вот темы, которые вам безусловно будут полезны

Решение системы уравнений в Экселе
Программа для определения температуры всей системы
Не работает восстановление системы
Датчик линейных перемещений
Не работает восстановление системы

Старый 27.12.2010, 16:54   #2 (permalink)
shrek=)
Студент БГПУ
 
Аватар для shrek=)
 
Регистрация: 06.02.2010
Сообщений: 420
Записей в дневнике: 3
Сказал(а) спасибо: 1
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 470
По умолчанию

Я думаю было бы уместно выложить само задание.
shrek=) вне форума   Ответить с цитированием
Старый 27.12.2010, 18:04   #3 (permalink)
kalugin66
Новичок
 
Регистрация: 19.12.2010
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Exclamation

Цитата:
Сообщение от shrek=) Посмотреть сообщение
Я думаю было бы уместно выложить само задание.
программа должна решать систему линейных уравнений матричным методом и методом гаусса с любым количеством неизвестных.

примеры линейных уравнений

27x1-3x2+0,5x3=1,5
-2x1+4x2+1,7x3=12,5
-0,37x1-0,18x2+-3x3=10,25

0,3x1+3,3x2-9,5x3=12,5
6,1x1-4,3x2-1,1x3=-5,5
-4,7x1+6,7x2-7,4x3=41,41
kalugin66 вне форума   Ответить с цитированием
Старый 27.12.2010, 21:48   #4 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,347
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Уважаемый Kalugin, как-то вот не очень я верю, что (если, конечно, приведен реальный листинг) Вы могли не то, что данные ввести, а и просто программу оттранслировать. Дело, видите ли, в том, что подобных конструкций:
Цитата:
array [1. n,1. n], array [1. n]
не пропустит ни один Паскаль-транслятор, потому как диапазон обозначается через двойную точку, а не точку+пробел, т.е. надо так:
Цитата:
array [1..n,1..n], array [1..n]
Теперь по сути задачи.
К сожалению, чтобы иметь возможность Вам помочь, мне, например, надо влезть в полузабытую алгебру, и, в частности, в матричный метод решения СЛАУ (гауссов я знаю). Одно я помню: получить обратную матрицу - дело ох, непростое, и даже изрядно муторное, а потому та краткость, с которой решается эта проблема в приведенном листинге, вызывает некоторые подозрения. Нет, я не утверждаю, что это неправильно, просто не знаю, надо разбираться.
А вот разбираться в эти предновогодние дни мне, уж простите, просто некогда. Если дело терпит до января, то еще может быть, а нет - так увы, ничем не могу помочь.
Впрочем, может быть кто-нибудь еще возьмется?
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Старый 28.12.2010, 03:33   #5 (permalink)
kalugin66
Новичок
 
Регистрация: 19.12.2010
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
По умолчанию

можете соорудить только гаусса? чтоб программа одним из способов решала
kalugin66 вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Старый 28.12.2010, 22:41   #6 (permalink)
Vladimir_S
Специалист
 
Аватар для Vladimir_S
 
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 26,347
Сказал(а) спасибо: 288
Поблагодарили 507 раз(а) в 165 сообщениях
Репутация: 91953
По умолчанию

Цитата:
Сообщение от kalugin66 Посмотреть сообщение
можете соорудить только гаусса? чтоб программа одним из способов решала
Могу. Соорудил:
Код:
Program Gauss;
uses crt;
const
 N=3;
 eps=0.00001; { all numbers less than eps are equal to 0 }
type
 matr=array [1..n,1..n] of real;
 mas=array [1..n] of real;
var
 i,j: integer;
 b,x: mas;
 a: matr;
{*** метод Гаусса *******}
procedure gausss(ag: matr; bg: mas; var xg: mas; Ng: integer);
 Var
  k,ig,jg: byte;
  m,s: real;
  blg:boolean;
  c:mas;
 begin

{ приведение к треугольному виду}
  For k:=1 to Ng-1 do
   begin
    If ABS(ag[k,k])<eps then
     begin
      ig:=k;
      blg:=false;
      repeat
       Inc(ig);
       if ABS(ag[ig,k])>eps then
        begin
         blg:=true;
         c:=ag[k];
         ag[k]:=ag[ig];
         ag[ig]:=c;
         s:=bg[k];
         bg[k]:=bg[ig];
         bg[ig]:=s;
        end;
      until blg;
     end;
    m:=ag[k,k];
    for jg:=k to Ng do
     ag[k,jg]:=ag[k,jg]/m;
    bg[k]:=bg[k]/m;
    for ig:=k+1 to Ng do
     if ABS(ag[ig,k])>eps then
      begin
       m:=ag[ig,k];
       for jg:=k to Ng do
        ag[ig,jg]:=ag[k,jg]-ag[ig,jg]/m;
       bg[ig]:=bg[k]-bg[ig]/m;
      end
     else
      ag[ig,k]:=0;
   end;

{расчет неизвестных х в обратном порядке}
 xg[Ng]:=bg[Ng]/ag[Ng,Ng] ;
 for ig:=(Ng-1) downto 1 do
  begin
   s:=0;
   For jg:=ig+1 to Ng do
    s:=s+ag[ig,jg]*xg[jg] ;
   xg[ig]:=bg[ig]-s;
  end;
end;

BEGIN {***** тело программы ******}
 clrscr;
 writeln ('ввод матрицы коэффициентов при неизвестных х');
 for i:=1 to N do
  for j:=1 to N do
   begin
    write (' введите a [', i,',',j,'] => ');
    readln (a [i,j]);
   end;
 writeln ('ввод столбца свободных членов');
 for i:=1 to N do
  begin
   write (' введите b [', i,'] => ');
   readln (b [i]);
  end;
 Writeln;
 gausss (a,b,x,n);
 writeln ('Вывод результатов решения системы уравнений методом Гаусса');
 for i:=1 to n do
  writeln('x [',i,'] =',x[i]:6:2);
 readln;
END.
Между прочим, еще раз убедился, что Ваши уверения в том, что Вы якобы свою программу запускали, есть, извините за прямоту, чистой воды враньё. Ибо при таком количестве ошибок ни о какой даже трансляции, а не то что запуске, и речи быть не может. Отмечу (на будущее) главные:
1. Называть программу и процедуру одним именем - недопустимо (у Вас там и там "gauss").
2. Запись операции присваивания не допускает разрывов и пробелов, т.е:
x:= 45; - правильно, а
x: = 45; - недопустимо.
__________________
With Mozilla Firefox - straight to communism!
Vladimir_S вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
Ответ

Опции темы
Опции просмотра

Ваши права в разделе
Вы не можете создавать новые темы
Вы не можете отвечать в темах
Вы не можете прикреплять вложения
Вы не можете редактировать свои сообщения

BB коды Вкл.
Смайлы Вкл.
[IMG] код Выкл.
HTML код Выкл.
Trackbacks are Вкл.
Pingbacks are Вкл.
Refbacks are Выкл.




Часовой пояс GMT +4, время: 11:04.

Powered by vBulletin® Version 6.2.5.
Copyright ©2000 - 2014, Jelsoft Enterprises Ltd.