|
Главная | Правила | Регистрация | Дневники | Справка | Пользователи | Календарь | Поиск | Сообщения за день | Все разделы прочитаны |
|
Опции темы | Опции просмотра |
11.06.2018, 12:32 | #1 (permalink) |
Новичок
Регистрация: 11.06.2018
Сообщений: 3
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Результат программы - Pascal
Т.е. исходная матрица должна равняться стартовой. От этого ошибка в дальнейших расчетах. program lr; type mtr = array[0..9, 0..9] of real; const eps = 0.00001;{ all numbers less than eps are equal 0 } var np: integer; n: byte; procedure trans_pob(var a: mtr; n: byte); var i, j: byte; x: real; begin for i := 1 to n do for j := 0 to i - 1 do begin x := a[i, j]; a[i, j] := a[j, i]; a[j, i] := x; end; writeln('Matrix transponirovannaya otnositelno pobochnoy diagonal '); for i := 0 to n - 1 do begin for j := 0 to n - 1 do write(a[i, j]:3); writeln; end; readln; end; function scal(a: mtr; n, st, sb: byte): real; var i: byte; s: real; begin s := 0; for i := 0 to n - 1 do s := s + a[st - 1, i] * a[i, sb - 1]; scal := s; end; procedure PrintMatr(m, m1: mtr; n, nz, nd: integer); var i, j: integer; begin for i := 1 to n do begin for j := 1 to n do write(m[i, j]:nz:nd); for j := 1 to n do write(m1[i, j]:nz:nd); writeln; end; end; procedure MultString(var a, b: mtr; 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 a, b: mtr; i1, i2: integer; r: real); { Процедура прибавляет к i1 строке матрицы a 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: mtr; var c: mtr); 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; var a, b, a0, d: mtr; w, i, j, s1, s2: byte; begin repeat write('Vvedite size matrix from 2 to 10, n = '); read(n); until n in [2..10]; randomize; writeln('Ishodnaya matrix '); for i := 0 to n - 1 do begin for j := 0 to n - 1 do begin a[i, j] := 1 + random(10); write(a[i, j]:3); end; writeln; end; writeln('Vyberite preobrazovanie'); writeln('1 - Perestanovka two strok'); writeln('2 - Transponirovanie matrix otnositelno pobochnoy diagonal'); writeln('3 - Skalyarnoe proizvedenie stroki and stolbza'); repeat read(w); until w in [1..3]; case w of 1: trans_pob(a, n); 2: begin repeat write('Vvedite number stroki from 1 to ', n, ' s1 = '); read(s1); if (s1 > n) then begin writeln('Stroki s vvedynnym number ne sushestvuet'); read; end else until s1 in [1..n]; repeat write('Vvedite number stolbza from 1 to ', n, ' s2 = '); read(s2); if (s2 > n) then begin writeln('Stolbza s vvedynnym number ne sushestvuet'); read; end else until s2 in [1..n]; writeln('Skalyarnoe proizvedenie stroki ', s1, ' and stolbza ', s2, ' = ', scal(a, n, s1, s2)); readln; end; 3: begin{ начало основной программы } for i := 1 to n do begin for j := 1 to n do begin b[i, j] := 0; d[i, j] := a[i, j]; end; b[i, i] := 1; end; for i := 1 to n do for j := 1 to n do a0[i, j] := d[i, j]; writeln('Starting matrix:');np := 0; PrintMatr(d, b, n, 6, 1); 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(d, b, i, j, sign(d[i, i]) * sign(d[j, i])); { PrintMatr(a,b,n,6,1);} { Прямой ход } if (abs(d[i, i]) > eps) then begin MultString(d, b, i, 1 / d[i, i]); for j := i + 1 to n do AddStrings(d, b, j, i, -d[j, i]); { PrintMatr(d,b,n,6,1);} end else begin writeln('Обратной матрицы не существует.'); halt; end end; {writeln('Обратный ход:');} if (d[n, n] > eps) then begin for i := n downto 1 do for j := 1 to i - 1 do begin AddStrings(d, b, j, i, -d[j, i]); end; { PrintMatr(d,b,n,8,4);} end else writeln('Обратной матрицы не существует.'); MultMatr(a0, b, d); writeln('Начальная матрица, обратная к ней матрица:'); PrintMatr(a0, b, n, 7, 3); writeln('Проверка: должна быть единичная матрица.'); PrintMatr(d, d, n, 7, 3); end; end; end. |
11.06.2018, 12:32 | |
Helpmaster
Member
Регистрация: 08.03.2016
Сообщений: 0
|
В более обсуждаемых темах можно найти полезные ответы Программы, Pascal Программы в Pascal Помогите с написанием программы на Pascal |
11.06.2018, 17:18 | #2 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Хотел бы попробовать Вам помочь, но для этого мне нужно:
1. ПОЛНОЕ задание (можно в виде прикрепленного файла doc (docx) или txt). 2. По возможности полное описание хода Ваших действий при решении задачи, включая алгоритм нахождения обратной матрицы (их есть несколько). Пока же я вижу какой-то сумбур. Вот что за бред: "исходная матрица должна равняться стартовой"? Если матрица — исходная, то она же, естественно, и стартовая и, конечно, равна сама себе. Если речь идёт о матрице после некоторых действий (например, двойного инвертирования), то так и надо писать. Далее, п.1 меню Вы обозначаете "Перестановка двух строк" и отсылаете к процедуре trans_pob. Но это процедура никакой не перестановки двух строк, а простого транспонирования матрицы (т.е. относительно ГЛАВНОЙ диагонали), в комментарии же внутри процедуры Вы утверждаете, что это транспонирование относительно ПОБОЧНОЙ диагонали, что несколько сложнее. И так далее, и тому подобное. |
11.06.2018, 18:55 | #3 (permalink) |
Новичок
Регистрация: 11.06.2018
Сообщений: 3
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Приложила саму программу и задание.
Да, к сожалению, не исправила "Перестановка строк" и т.д. Осталось с прошлой программы, подобной этой. Обратная матрица вычисляется с помощью метода Гаусса. |
11.06.2018, 19:06 | #5 (permalink) |
Новичок
Регистрация: 11.06.2018
Сообщений: 3
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
|
Хорошо, спасибо большое.
|
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
12.06.2018, 20:23 | #6 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Ох, боюсь, не справиться мне в назначенный срок. Старею, видать. Всю голову сломал над отладкой программы, а конца не видно. А тут ещё эта ненавистная СИ-шная нумерация с нуля, ужасно мешает. И критерий вырожденности матрицы какой-то мутный... Попробовал по-своему и окончательно запутался. Надеюсь, что добью.
|
13.06.2018, 17:00 | #7 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Так, ну начинает кое-что получаться. Правда, с этими критериями вырожденности и вообще с возможным возникновением нулевых элементов — некие непонятки. Но, во всяком случае, обратную матрицу я получил (по критерию результата произведения исходной и полученной матриц в виде единичной матрицы).
Тьфу ты, и не думал, что эта ерунда — такая сложная окажется. Ещё поковыряю, прежде чем выкладывать. |
14.06.2018, 14:28 | #8 (permalink) |
Специалист
Регистрация: 27.08.2008
Адрес: Санкт-Петербург
Сообщений: 27,807
Сказал(а) спасибо: 340
Поблагодарили 583 раз(а) в 208 сообщениях
Репутация: 113184
|
Уф, ну, не знаю, актуально ещё или нет, но, признаться, самого "заело". Вроде "добил".
Несколько замечаний. 1. Программа зациклена с возможностью выхода. 2. Транспонирование матрицы сделано "по рабоче-крестьянски", т.е. с генерацией другой матрицы, а не с преобразованием исходной. Это нужно затем, чтобы сохранить исходную матрицу для последующих действий, не куроча её. 3. Поиск обратной матрицы сделан "из первых принципов", т.е. процедура написана "с нуля". В принципе, ошибка может возникнуть, если диагональный элемент обнулился, а на него надо делить. Для такого случая предусмотрено завершение программы с выводом сообщения о невозможности решения. Впрочем, сколько ни гонял, на такое не напоролся ни разу. Вероятно, это может возникнуть, если матрица вырождена, но вырожденную матрицу нужно специально строить, случайное же её появление очень маловероятно. Код:
program lr; type mtr = array[0..9, 0..9] of real; const eps = 0.00001;{ all numbers less than eps are equal to zero } var a,b,d:mtr; w,i,j,s1,s2,n:byte; procedure Trans(m1:mtr;var m2:mtr); var i,j:byte; begin for i:=0 to n-1 do for j:=0 to n-1 do m2[i,j]:=m1[j,i]; end; function Scal(a:mtr; st,sb:byte):real; var i:byte; s:real; begin s:=0; for i:=0 to n-1 do s:=s+a[st-1,i]*a[i,sb-1]; scal:=s; end; procedure PrintMatr(m:mtr); var i,j:integer; begin for i:=0 to n-1 do begin for j:=0 to n-1 do write(m[i,j]:8:3); writeln; end; end; procedure Inversion(m:mtr; var c:mtr); var m1,e:mtr; i,j,k,p,r:byte; Q,Dummy:real; begin for i:=0 to n-1 do for j:=0 to n-1 do begin m1[i,j]:=m[i,j]; e[i,j]:=0; end; for i:=0 to n-1 do e[i,i]:=1; {Avers} for k:=0 to n-1 do begin Q:=m1[k,k]; if Abs(Q)<eps then begin Writeln('No solution!'); Readln; Halt; end else begin for j:=0 to n-1 do begin m1[k,j]:=m1[k,j]/Q; e[k,j]:=e[k,j]/Q; end; for i:=k+1 to n-1 do begin Q:=m1[i,k]; if Abs(Q)<eps then m1[i,k]:=0 else for j:=0 to n-1 do begin m1[i,j]:=m1[i,j]/Q; e[i,j]:=e[i,j]/Q; m1[i,j]:=m1[k,j]-m1[i,j]; e[i,j]:=e[k,j]-e[i,j]; end; end; end; end; {Revers} for k:=n-1 downto 0 do begin Q:=m1[k,k]; if Abs(Q)<eps then begin Writeln('No solution!'); Readln; Halt; end else begin for j:=n-1 downto 0 do begin m1[k,j]:=m1[k,j]/Q; e[k,j]:=e[k,j]/Q; end; if k>0 then begin for i:=k-1 downto 0 do begin Q:=m1[i,k]; if Abs(Q)<eps then m1[i,k]:=0 else for j:=n-1 downto 0 do begin m1[i,j]:=m1[i,j]/Q; e[i,j]:=e[i,j]/Q; m1[i,j]:=m1[i,j]-m1[k,j]; e[i,j]:=e[i,j]-e[k,j]; end; end; end; end; end; for i:=0 to n-1 do for j:=0 to n-1 do c[i,j]:=e[i,j]; end; procedure MultMatr(a,b:mtr; var c:mtr); var i,j,k:byte; s:real; begin for i:=0 to n-1 do for j:=0 to n-1 do begin s:=0; for k:=0 to n-1 do s:=s+a[i,k]*b[k,j]; c[i,j]:=s; end; end; Begin repeat write('Enter the matrix size from 2 to 10, n = '); readln(n); until n in [2..10]; randomize; for i:=0 to n-1 do for j:=0 to n-1 do a[i,j]:=1+random(10); Repeat writeln; writeln('Choose the action:'); writeln('1 - Matrix transposition'); writeln('2 - Scalar product of string and column'); writeln('3 - Inverse matrix'); writeln('4 - Quit'); repeat readln(w); until w in [1..4]; case w of 1: begin Trans(a,b); Writeln('Initial matrix:'); PrintMatr(a); Writeln; Writeln('Transposed matrix:'); PrintMatr(b); end; 2: begin repeat Writeln('Initial matrix:'); PrintMatr(a); Writeln; write('Enter the string number from 1 to ', n, ' s1 = '); readln(s1); if (s1>n) then writeln('String with this number does not exist'); until s1 in [1..n]; repeat write('Enter the column number from 1 to ', n, ' s2 = '); readln(s2); if (s2>n) then writeln('Column with this number does not exist'); until s2 in [1..n]; writeln('Scalar product of string ',s1,' and column ', s2, ' = ', Scal(a,s1,s2):0:3); end; 3: begin Inversion(a,b); Writeln('Initial matrix:'); PrintMatr(a); Writeln; Writeln('Inverse matrix:'); PrintMatr(b); Writeln; Writeln('Test. Product of initial and inverse matrix:'); MultMatr(a,b,d); PrintMatr(d); end; end; Until w=4; End. |
Ads | |
Member
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070
|
Опции темы | |
Опции просмотра | |
|
|