27.12.2010, 15:31 | #1 (permalink) |
Новичок
Регистрация: 19.12.2010
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Решение системы линейных уравнений - программа не работает
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. |
27.12.2010, 15:31 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
Вот темы, которые вам безусловно будут полезны Решение системы уравнений в Экселе Программа для определения температуры всей системы Не работает восстановление системы Датчик линейных перемещений Не работает восстановление системы |
27.12.2010, 18:04 | #3 (permalink) |
Новичок
Регистрация: 19.12.2010
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
программа должна решать систему линейных уравнений матричным методом и методом гаусса с любым количеством неизвестных.
примеры линейных уравнений 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 |
27.12.2010, 21:48 | #4 (permalink) | ||
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Уважаемый Kalugin, как-то вот не очень я верю, что (если, конечно, приведен реальный листинг) Вы могли не то, что данные ввести, а и просто программу оттранслировать. Дело, видите ли, в том, что подобных конструкций:
Цитата:
Цитата:
К сожалению, чтобы иметь возможность Вам помочь, мне, например, надо влезть в полузабытую алгебру, и, в частности, в матричный метод решения СЛАУ (гауссов я знаю). Одно я помню: получить обратную матрицу - дело ох, непростое, и даже изрядно муторное, а потому та краткость, с которой решается эта проблема в приведенном листинге, вызывает некоторые подозрения. Нет, я не утверждаю, что это неправильно, просто не знаю, надо разбираться. А вот разбираться в эти предновогодние дни мне, уж простите, просто некогда. Если дело терпит до января, то еще может быть, а нет - так увы, ничем не могу помочь. Впрочем, может быть кто-нибудь еще возьмется? |
||
28.12.2010, 03:33 | #5 (permalink) |
Новичок
Регистрация: 19.12.2010
Сообщений: 4
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
можете соорудить только гаусса? чтоб программа одним из способов решала
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
28.12.2010, 22:41 | #6 (permalink) | |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Цитата:
Код:
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; - недопустимо. |
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
|
|