|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
15.05.2011, 12:25 | #1 |
Новичок
Джуниор
Регистрация: 15.05.2011
Сообщений: 2
|
Решение системы линейных уравнений
Добрый день помогите пожалуйста с программой ребят. Паскаль ругается на вот эту строчку AddStrings (var а,b: matr; i1, i2: integer; r: real);
Вот код программы: Program Lin_yravneniya; 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. Буду очень благодарен Вам за помощь |
15.05.2011, 12:49 | #2 |
Очень суровый
Участник клуба
Регистрация: 17.12.2009
Сообщений: 1,988
|
Зачем темы плодите?
Ненавижу быть как все, но люблю, чтобы все были как я.
|
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Решение системы линейных уравнений методом Гаусса. | maliyusha | Помощь студентам | 16 | 18.02.2013 15:44 |
Паралельное решение системы n линейных уравнений на паскале | ice_venom | Помощь студентам | 7 | 12.12.2010 19:55 |
Решение системы линейных уравнений. методы Крамера и Гаусса | Lumos | Помощь студентам | 3 | 05.12.2010 12:22 |
решение системы линейных алгебраических уравнений | LediDashuta | Помощь студентам | 0 | 23.05.2010 18:40 |