Ветвление алгоритма
31.01.2018, 06:58. Показов 481. Ответов 0
Строго не судите,уровень моих познаний в программировании школьный. Есть проблема,помогите пожалуйста разобраться!
Есть 4 самостоятельных алгоритма (сложение матриц,умножение матриц,нахождение определителя и нахождение обратной матрицы) их нужно объединить в один алгоритм с правом выбора с клавы примерно так:
Pascal | 1
2
3
4
5
6
7
8
| program PPP;
uses crt;
var
c: real;
begin
write('Здравствуйте! Какое действие над матрицами выполнить? Сложение (1), Умножение(2), Определитель(3), Обратная матрица(4):');
readln(R);
if (R='1') then |
|
Добавлено через 6 минут
Сложение:
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 Summa;
uses crt;
const
N1=1000;
type
Matrice=array[1..N1,1..N1] of real;
var
c: char;
a,b,s: Matrice;
m,n,i,j: integer;
procedure Vyvod1(var a :Matrice; N:integer; M:integer);{вывод матриц на экран}
var i,j:integer;
begin
for i:=1 to N do
begin
for j:=1 to M do
write(a[i,j]:7:2);
writeln;
end;
end;
procedure Vyvod2(var b :Matrice; N:integer; M:integer);{вывод матриц на экран}
var i,j:integer;
begin
for i:=1 to N do
begin
for j:=1 to M do
write(b[i,j]:7:2);
writeln;
end;
end;
begin
WriteLn ('Сложение двух матриц.');
write('Введите размерность матриц (N M):');
readln(N,M);
begin
writeln(' Введите элементы первой матрицы:');
for i:=1 to N do
for j:=1 to M do
begin
write('a[',i,',',j,']=');
readln(a[i,j]);
end;
end;
begin
writeln(' Введите элементы второй матрицы:');
for i:=1 to N do
for j:=1 to M do
begin
write('b[',i,',',j,']=');
readln(b[i,j]);
end;
end;
clrscr;
writeln('Первая исходная матрица:');
Vyvod1(a,N,M);
writeln(' +');
writeln('Вторая исходная матрица:');
Vyvod2(a,N,M);
begin
writeln;
writeln;
writeln('Сумма матриц равна: ');
for i:=1 to n do
begin
writeln;
for j:=1 to m do
begin
s[i,j]:=a[i,j]+b[i,j];
write(s[i,j],' ');
end;
end;
end;
readln;
end. |
|
УМНОЖЕНИЕ
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
| Program PROD ;
uses crt;
const
N=1000;
type
Matrice=array [1..N, 1..N] of real;
Var
N1, M1, N2, M2 : Integer;
i, j, k : Integer;
S : real;
A, B, Z:Matrice;
procedure Vyvod1(var A :Matrice; N1:integer; M1:integer );{вывод матриц на экран}
var i,j:integer;
begin
for i:=1 to N1 do
begin
for j:=1 to M1 do
write(A[i,j]:7:2);
writeln;
end;
end;
procedure Vyvod2(var B :Matrice; N2:integer; M2:integer );{вывод матриц на экран}
var i,j:integer;
begin
for i:=1 to N2 do
begin
for j:=1 to M2 do
write(B[i,j]:7:2);
writeln;
end;
end;
Begin
WriteLn ('Нахождение произведения двух матриц.');
Write ('Введите количество строк первой матрицы: ');
ReadLn (N1);
Write ('Введите количество столбцов первой матрицы: ');
ReadLn (M1);
WriteLn ('Введите элементы первой матрицы:');
For i := 1 To N1 Do
For j := 1 To M1 Do
Begin
Write ('A[', i, ',', j, '] = ');
ReadLn (A [i, j] );
End;
WriteLn ('Число строк 2-ой матрицы должно быть равно числу столбцов 1-ой матрицы.');
N2 := M1;
Write ('Введите количество столбцов второй матрицы: ');
ReadLn (M2);
WriteLn ('Введите элементы второй матрицы:');
For i := 1 To N2 Do
For j := 1 To M2 Do
Begin
Write ('B[', i, ',', j, '] = ');
ReadLn (B [i, j] );
End;
clrscr;
writeln('Исходная матрица № 1:');
Vyvod1(A,N1,M1);
writeln(' *');
writeln('Исходная матрица № 2:');
Vyvod2(B,N2,M2);
For i := 1 To N1 Do
For j := 1 To M2 Do
Begin
S := 0;
For k := 1 To N2 Do
S := S + A [i, k] * B [k, j];
Z [i, j] := S;
End;
WriteLn;
WriteLn ('Полученная матрица:');
For i := 1 To N1 Do
Begin
For j := 1 To M2 Do
Write (Z [i, j] : 5);
WriteLn;
End;
ReadLn;
End. |
|
ОПРЕДЕЛИТЕЛЬ
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
83
| Program Determinant;
uses crt;
const
N1=1000;
type
Matrice=array[1..N1,1..N1] of real;
var
A:matrice;
I,J,N:integer;
D:real;
Function Det(A:Matrice;N:integer):real;
var
B:matrice;
I:integer;
T,Mn,S:real;
Function Minor(var C:matrice;A:Matrice;N,I,J:integer):real;
var
Im,Jm,Ia,Ja,Nm:integer;
begin
Nm:=N-1; Im:=1; Ia:=1;
while Im<=Nm do
if Ia<>I then
begin
Jm:=1; Ja:=1;
while Jm<=Nm do
if Ja<>J then
begin
C[Im,Jm]:=A[Ia,Ja];
Ja:=Ja+1; Jm:=Jm+1;
end
else Ja:=Ja+1;
Ia:=Ia+1; Im:=Im+1;
end
else Ia:=Ia+1;
end; {*Minor*}
begin
if N=1 then Det:=A[N,N];
if N=2 then Det:=A[1,1]*A[2,2]-A[2,1]*A[1,2];
if N>2 then
begin
S:=0;
for I:=1 to N do
begin
Mn:=Minor(B,A,N,I,1);
if (I mod 2)=1 then begin
T:=Det(B,N-1);
S:=S+T*A[I,1];
end
else begin
T:=Det(B,N-1);
S:=S-T*A[I,1];
end;
end;
Det:=S;
end;
end; {*Determ*}
procedure Vyvod(var A:Matrice; n:integer);{вывод матриц на экран}
var I,J:integer;
begin
for I:=1 to n do
begin
for J:=1 to n do
write(A[I,J]:7:2);
writeln;
end;
end;
begin
WriteLn ('Нахождение определителя матрицы.');
n:=N1;
Write('Введите порядок матрици N: '); readln(n);
for I:=1 to n do
for J:=1 to n do
begin
write('A[',I,',',J,']=');
readln(A[I,J]);
end;
clrscr;
writeln('Исходная матрица:');
Vyvod(A,n);
D:=Det(A,N);
Writeln('Определитель равен: ',D:7:4);
readln;
end. |
|
ОБРАТНАЯ МАТРИЦА
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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
| Program Obr ;
uses crt;
const t=0.000001;{ограничиваем числа, близкие к нолю, на них делить}
N1=1000;
type
Matrice=array[1..N1,1..N1] of real;
procedure Per(n,k:integer;a:Matrice;var p:integer);{перестановка строк с макс. главным элементом}
var z:real;
j,i:integer;
begin
z:=abs(a[k,k]);
i:=k;
p:=0;
for j:=k+1 to n do
begin
if abs(a[j,k])>z then
begin
z:=abs(a[j,k]);
i:=j;
p:=p+1;
end;
end;
if i>k then
for j:=k to n do
begin
z:=a[i,j];
a[i,j]:=a[k,j];
a[k,j]:=z;
end;
end;
function znak(p:integer):integer;{изменение знака при перестановке строк матрицы}
begin
if p mod 2=0 then
znak:=1 else znak:=-1;
end;
function znak1(i,m:integer):integer;{изменение знака при перестановке строк при нахождении дополнений}
begin
if (i+m) mod 2=0 then
znak1:=1 else znak1:=-1;
end;
procedure opr(n,p:integer;a:Matrice;var det:real;var f:byte);{нахождение определителя матрицы}
var k,i,j:integer;
r:real;
begin
det:=1.0;f:=0;
for k:=1 to n do
begin
if a[k,k]=0 then per(k,n,a,p);
det:=znak(p)*det*a[k,k];
if abs(det)<t then
begin
f:=1;
writeln('Исходная матрица вырожденная. Обратной матрицы нет!');
readln;
exit;
end;
for j:=k+1 to n do
begin
r:=a[j,k]/a[k,k];
for i:=k to n do
a[j,i]:=a[j,i]-r*a[k,i];
end;
end;
end;
procedure opr1(n,p:integer;d:Matrice;var det1:real);{нахождение определений для дополнений}
var k,i,j:integer;
r:real;
begin
det1:=1.0;
for k:=2 to n do
begin
if d[k,k]=0 then per(n,k,d,p);
det1:=znak(p)*det1*d[k,k];
for j:=k+1 to n do
begin
r:=d[j,k]/d[k,k];
for i:=k to n do
d[j,i]:=d[j,i]-r*d[k,i];
end;
end;
end;
Procedure Peresch(n,p:integer;var b:Matrice;det1:real;var e:Matrice);{вычисление дополнений}
var i,m,k,j:integer;
z:real;
d,c:Matrice;
begin
for i:=1 to n do
for m:=1 to n do
begin
for j:= 1 to n do {перестановка строк}
begin
z:=b[i,j];
for k:=i downto 2 do
d[k,j]:=b[k-1,j];
for k:=i+1 to n do
d[k,j]:=b[k,j];
d[1,j]:=z;
end;
for k:=1 to n do {перестановка столбцов}
begin
z:=d[k,m];
for j:=m downto 2 do
c[k,j]:=d[k,j-1];
for j:=m+1 to n do
c[k,j]:=d[k,j];
c[k,1]:=z;
end;
Opr1(n,p,c,det1);{вычисление определителей}
e[i,m]:=det1*znak1(i,m);{вычисление дополнений}
end;
end;
procedure Transp(a:Matrice; n:integer;var at:Matrice);{транспонирование матрицы}
var k,j:integer;
begin
for k:= 1 to n do
for j:=1 to n do
at[k,j]:=a[j,k];
end;
Procedure Proverka(a,b:Matrice; n:integer;var c:Matrice);{проверка - умножение прямой матрицы на обратную}
var k,j,i:integer;
z:double;
begin
for k:=1 to n do
for j:=1 to n do
begin
c[k,j]:=0;
for i:=1 to n do
begin
z:=a[i,j]*b[k,i];
c[k,j]:=c[k,j]+z;
end;
end;
end;
procedure Vyvod(var a:Matrice; n:integer);{вывод матриц на экран}
var k,j:integer;
begin
for k:=1 to n do
begin
for j:=1 to n do
write(a[k,j]:7:2);
writeln;
end;
end;
var n,k,j,i,p:integer;{n-размер матрицы,k-счетчик по строкам,j-счетчик по столбцам,p-счетчик перестановок}
a,at,b,c,e:Matrice;{a-исходная, at-транспонированная, b-матрица дополнений, e-обратная, с-проверка}
det,det1:real;{det-определитель исходной матрицы,det1-определители-дополнения}
f:byte;{признак несуществования обратной матрицы}
begin
WriteLn ('Нахождение обратной матрицы.');
n:=N1;
Write('Введите порядок матрици N: '); readln(n);
for k:=1 to n do
for j:=1 to n do
begin
write('a[',k,',',j,']=');
readln(a[k,j]);
end;
clrscr;
writeln('Исходная матрица:');
Vyvod(a,n);
Opr(n,p,a,det,f); {вычисление определителя}{считаем определитель}
if f=1 then exit;
Transp(a,n,b); {транспонируем матрицу}
Peresch(n,p,b,det1,e); {считаем дополнения}
writeln('Обратная матрица:');
for k:=1 to n do
for j:=1 to n do
e[k,j]:=e[k,j]/det; {создаем обратную матрицу}
Vyvod(e,n);
writeln('Проверка:');
Proverka(a,e,n,c); {делаем проверку}
Vyvod(c,n);
readln
end. |
|
Добавлено через 1 час 19 минут
Проблема решена!
0
|