Задача на массивы

@karmen · Регистрация: 23.05.2009

Студворк — интернет-сервис помощи студентам

Задача следующая:
Найти произведение Х=Y[5,3]*Z[3,5] и Q=Z[3,5]*X[5,5] и результаты матрицы X и Q записать в файл a3. Матрица Y вводится из файла a2. Матрица Z вводится из файла a1.
1 столбец матрицы Y, 2 столбец матрицы Z и 4 столбец матрицы Х1 умножить на Р, где Р=max (произведение Х[i,j]; произведение Y[i,j]; произведение Z[i,j]). Преобразованные матрицы записать в те же файлы.
Найти произведение ненулевых элементов каждой матрицы. Результаты записать в файл a4.
Сделала вот так

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
program zadanie1;
uses crt;
type mass=array[1..5,1..5] of integer;
var y,z,x,q,y1,z1,x1:mass;
    a,pro1,pro2,pro3:integer;
    p,proy,proz,prox,proq,proy1,prox1,proz1:longint;
    a1,a2,a3,a4:text;
 
procedure vvod(name:string; i,j:byte;var x:mass);
    var n,m:byte;
          f:text;
    begin
    assign(f,name);
     reset(f);
    for n:=1 to i do
    for m:=1 to j do
    read (f,x[n,m]);
    close(f);
    end;
 
 
 
procedure pro(n,k,m:byte;  var a,b ,ab:mass);
    var i,j,s:byte;
        s1:integer;
    begin
    for i:=1 to n do
    for j:=1 to k do
            begin
    s1:=0;
    for s:=1 to m do
    s1:=s1+a[i,s]*b[s,j];
    ab[i,j]:=s1;
            end;
    end;
 
 
 procedure proizvedenie (i,j:byte;x1:mass;name:string;var proiz:longint);
    var n,k:byte;
          f:text;
          e:longint;
    begin
    assign(f,name);
    reset(f);
    e:=1;
    for n:=1 to i do
    for k:=1 to j do
    e:=e*x1[n,k];
    proiz:=e;
    writeln(proiz);
    close(f);
    end;
 
 
procedure maximum(s11,s22,s33:integer;var p:longint);
    var max:integer;
    begin
    if s11>s22 then max:=s11
    else     max:=s22;
    if max<s33 then max:=s33;
    p:=max;
    writeln('p=',p);
    end;
 
procedure stolb(i,j,k,p1:byte;  r:mass;  name:string;  var r1:mass);
    var f:text;
        n,m:byte;
    begin
    assign(f,name);
    append(f);
    writeln(f);
    for n:=1 to i do
    begin
    for m:=1 to j do
    begin
    if m=k then
    r[n,m]:=r[n,m] * p1;
    r1[n,m]:=r[n,m];
    write(f,' ',r1[n,m]);
    end;
    writeln(f);
    end;
    close(f);
    end;
 
 
procedure prnot0(name,name1:string; k,n,m,logik:byte;var prozxqy:longint);
    var i,j:byte;
        x:integer;
        f,fa:text;
        q:mass;
        p:longint;
    begin
    assign(f,name);
    assign(fa,name1);
    append(f);
    reset(fa);
    if logik=1 then
    for i:=1 to k do
    read(fa,x);
    for i:=1 to n do
    for j:=1 to m do
    
    read(fa,q[i,j]);
       close(fa);
    p:=1;
    for i:=1 to n do
    for j:=1 to m do
    if q[i,j]<>0 then
    p:=p*q[i,j];
    writeln(f,p);
    writeln(p);
    prozxqy:=p;
    close(f);
    end;
 
 
BEGIN
   clrscr;
   assign(a1,'c:\kurs\a1.txt');
   assign(a2,'c:\kurs\a2.txt');
   assign(a3,'c:\kurs\a3.txt');
   assign(a4,'c:\kurs\a4.txt');
   reset(a1);
   close(a1);
   reset(a2);
   close(a2);
   reset(a3);
   close(a3);
   rewrite(a4);
   close(a4);
   vvod ('c:\kurs\a1.txt',3,5,z);
   vvod ('c:\kurs\a2.txt',5,3,y);
   writeln;
   pro (5,5,3,y,z,x);
   pro (3,5,5,z,x,q);
   out('c:\kurs\a3.txt',5,5,x);
   out('c:\kurs\a3.txt',3,5,q);
   writeln('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
   writeln('proizvedenie matric');
   write('proizvedenie x=');
   proizvedenie(5,5,x,'c:\kurs\a3.txt',pro1);
   write('proizvedenie y=');
   proizvedenie(5,3,y,'c:\kurs\a2.txt',pro2);
   write('proizvedenie z=');
   proizvedenie(3,5,z,'c:\kurs\d1.txt',pro3);
   writeln('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
   write('maximum sredi proizvedenij ');
   maximum(pro1,pro2,pro3,p);
   stolb(3,2,5,p,z,'c:\kurs\a1.txt',z1);
   stolb(5,1,3,p,y,'c:\kurs\a2.txt',y1);
   stolb(5,4,5,p,x,'c:\kurs\a3.txt',x1);
   writeln('proizvedenie matric');
   writeln('________________________________________');
   write('proy=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a1.txt',0,3,5,0,proz);
   write('proy1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a1.txt',15,3,5,1,proz1);
   write('proz=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a2.txt',0,5,3,0,proy);
   write('proz1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a2.txt',15,5,3,1,proy1);
   write('prox=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',0,5,5,0,prox);
   write('prox1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',25,5,5,1,prox1);
   write('proq=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',34,3,5,1,proq);
   writeln('________________________________________');
   readkey;
END.

Но программа работает неверно. По моему, процедура stolb работает не так, как должна. Но что исправить надо я не пойму. Помогите. пожалуйста!

@Puporev · 24.05.2009, 08:35

Но программа работает неверно.

А она вообще не работает.
У вас не описана процедура

Pascal
1
2
out('c:\kurs\a3.txt',5,5,x);
out('c:\kurs\a3.txt',3,5,q);

@karmen · 24.05.2009, 10:03 **[ТС]**

А, ну да... забыла ее добавить. Вот так будет правильнее:

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
175
176
177
178
179
180
181
182
183
184
185
186
program zadanie1;
uses crt;
type mass=array[1..5,1..5] of integer;
var y,z,x,q,y1,z1,x1:mass;
    a,pro1,pro2,pro3:integer;
    p,proy,proz,prox,proq,proy1,prox1,proz1:longint;
    a1,a2,a3,a4:text;
 
procedure vvod(name:string; i,j:byte;var x:mass);
    var n,m:byte;
          f:text;
    begin
    assign(f,name);
     reset(f);
    for n:=1 to i do
    for m:=1 to j do
    read (f,x[n,m]);
    close(f);
    end;
 
 procedure out(name:string;n,m:byte;var xy:mass);
    var i,j:byte;
        f:text;
    begin
    assign(f,name) ;
    append(f);
    for i:=1 to n do
    begin
    for j:=1 to m do
    write (f,' ',xy[n,m]);
    writeln(f);
    end;
    writeln(f);
    writeln(f);
    close(f);
    end;
 
procedure pro(n,k,m:byte;  var a,b ,ab:mass);
    var i,j,s:byte;
        s1:integer;
    begin
    for i:=1 to n do
    for j:=1 to k do
            begin
    s1:=0;
    for s:=1 to m do
    s1:=s1+a[i,s]*b[s,j];
    ab[i,j]:=s1;
            end;
    end;
 
 
 procedure proizvedenie (i,j:byte;x1:mass;name:string;var proiz:longint);
    var n,k:byte;
          f:text;
          e:longint;
    begin
    assign(f,name);
    reset(f);
    e:=1;
    for n:=1 to i do
    for k:=1 to j do
    e:=e*x1[n,k];
    proiz:=e;
    writeln(proiz);
    close(f);
    end;
 
 
procedure maximum(s11,s22,s33:integer;var p:longint);
    var max:integer;
    begin
    if s11>s22 then max:=s11
    else     max:=s22;
    if max<s33 then max:=s33;
    p:=max;
    writeln('p=',p);
    end;
 
procedure stolb(i,j,k,p1:byte;  r:mass;  name:string;  var r1:mass);
    var f:text;
        n,m:byte;
    begin
    assign(f,name);
    append(f);
    writeln(f);
    for n:=1 to i do
    begin
    for m:=1 to j do
    begin
    if m=k then
    r[n,m]:=r[n,m] * p1;
    r1[n,m]:=r[n,m];
    write(f,' ',r1[n,m]);
    end;
    writeln(f);
    end;
    close(f);
    end;
 
 
procedure prnot0(name,name1:string; k,n,m,logik:byte;var prozxqy:longint);
    var i,j:byte;
        x:integer;
        f,fa:text;
        q:mass;
        p:longint;
    begin
    assign(f,name);
    assign(fa,name1);
    append(f);
    reset(fa);
    if logik=1 then
    for i:=1 to k do
    read(fa,x);
    for i:=1 to n do
    for j:=1 to m do
    
    read(fa,q[i,j]);
       close(fa);
    p:=1;
    for i:=1 to n do
    for j:=1 to m do
    if q[i,j]<>0 then
    p:=p*q[i,j];
    writeln(f,p);
    writeln(p);
    prozxqy:=p;
    close(f);
    end;
 
 
BEGIN
   clrscr;
   assign(a1,'c:\kurs\a1.txt');
   assign(a2,'c:\kurs\a2.txt');
   assign(a3,'c:\kurs\a3.txt');
   assign(a4,'c:\kurs\a4.txt');
   reset(a1);
   close(a1);
   reset(a2);
   close(a2);
   reset(a3);
   close(a3);
   rewrite(a4);
   close(a4);
   vvod ('c:\kurs\a1.txt',3,5,z);
   vvod ('c:\kurs\a2.txt',5,3,y);
   writeln;
   pro (5,5,3,y,z,x);
   pro (3,5,5,z,x,q);
   out('c:\kurs\a3.txt',5,5,x);
   out('c:\kurs\a3.txt',3,5,q);
   writeln('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
   writeln('proizvedenie matric');
   write('proizvedenie x=');
   proizvedenie(5,5,x,'c:\kurs\a3.txt',pro1);
   write('proizvedenie y=');
   proizvedenie(5,3,y,'c:\kurs\a2.txt',pro2);
   write('proizvedenie z=');
   proizvedenie(3,5,z,'c:\kurs\d1.txt',pro3);
   writeln('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
   write('maximum sredi proizvedenij ');
   maximum(pro1,pro2,pro3,p);
   stolb(3,2,5,p,z,'c:\kurs\a1.txt',z1);
   stolb(5,1,3,p,y,'c:\kurs\a2.txt',y1);
   stolb(5,4,5,p,x,'c:\kurs\a3.txt',x1);
   writeln('proizvedenie matric');
   writeln('________________________________________');
   write('proy=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a1.txt',0,3,5,0,proz);
   write('proy1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a1.txt',15,3,5,1,proz1);
   write('proz=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a2.txt',0,5,3,0,proy);
   write('proz1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a2.txt',15,5,3,1,proy1);
   write('prox=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',0,5,5,0,prox);
   write('prox1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',25,5,5,1,prox1);
   write('proq=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',34,3,5,1,proq);
   writeln('________________________________________');
   readkey;
END.

Но программа все равно работает неправильно.

@Puporev · 24.05.2009, 10:39

Прога как не компилировалась, так и не компилируется, Вы что издеваетесь? Вам влом ее запустить и исправить синтаксическиее ошибки?
Сейчас например встало на строке
proizvedenie(5,5,x,'c:\kurs\a3.txt',pro1 ); //несоответствие типов

@karmen · 24.05.2009, 13:58 **[ТС]**

Puporev, извините, сегодня что-то плохо соображаю.
Переправила все. Вот эта вот точно компилируется:

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
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
program zadanie1;
uses crt;
type mass=array[1..5,1..5] of longint;
var X, Y, Z, Q, Y1, Z1, X1:mass;
    a, pro1, pro2, pro3:longint;
    p, proY,proZ,proX,proQ,proY1,proX1,proZ1:longint;
    a1,a2,a3,a4:text;
 
 procedure vvod (name:string; i,j:byte; var x:mass);
    var n,m:byte;
        f:text;
    begin
      assign(f,name);
      reset(f);
      for n:=1 to i do
       begin
         for m:=1 to j do
         read (f,x[n,m]);
       end;
      close(f);
    end;
 
     procedure out(name:string; n,m:byte; var xy:mass);
    var i,j:byte;
        f:text;
    begin
      assign(f,name);
      append(f);
      for i:=1 to n do
       begin
        for j:=1 to m do
        write (f,' ',xy[n,m]);
        writeln(f);
       end;
      writeln(f);
      writeln(f);
      close(f);
    end;
 
 
 procedure pro(n,k,m:byte; var a,b ,ab:mass);
    var i,j,s:byte;
        S1:integer;
    begin
      for i:=1 to n do
      for j:=1 to k do
       begin
         S1:=0;
         for s:=1 to m do
         S1:=S1+A[i,s]*B[s,j];
         AB[i,j]:=S1;
       end;
    end;
 
 
 procedure proiz(i,j:byte; x1:mass; name:string; var proiz:longint);
    var n,k:byte;
        e:longint;
        f:text;
    begin
      assign(f,name);
      reset(f);
      e:=1;
      for n:=1 to i do
      for k:=1 to j do
      e:=e*x1[n,k];
      proiz:=e;
      writeln(proiz);
      close(f);
    end;
 
 
 procedure maximum(s11,s22,s33:longint; var p:longint);
    var max:longint;
    begin
      if s11>s22 then max:=s11
      else max:=s22;
      if max<s33 then max:=s33;
      P:=max;
      writeln('P=',P);
    end;
 
 
 procedure stolb(i,j,k,p1:byte; r:mass; name:string; var r1:mass);
    var f:text;
        n,m:byte;
    begin
      assign(f,name);
      append(f);
      writeln(f);
      for n:=1 to i do
       begin
        for m:=1 to j do
         begin
          if m=k then
          r[n,m]:=r[n,m] * p1;
          r1[n,m]:=r[n,m];
          write(f,' ',r1[n,m]);
         end;
        writeln(f);
       end;
      close(f);
    end;
 
 
 procedure prnot0(name,name1:string; k,n,m,logik:byte; var prozxqy:longint);
    var i,j:byte;
        x:integer;
        f,fa:text;
        q:mass;
        p:longint;
    begin
      assign(f,name);
      assign(fa,name1);
      append(f);
      reset(fa);
      if logik=1 then
      for i:=1 to k do
      read(fa,x);
      for i:=1 to n do
      for j:=1 to m do
      read(fa,q[i,j]);
      close(fa);
      p:=1;
      for i:=1 to n do
      for j:=1 to m do
      if q[i,j]<>0 then
      p:=p*q[i,j];
      writeln(f,p);
      writeln(p);
      prozxqy:=p;
      close(f);
    end;
 
BEGIN
   clrscr;
   assign(a1,'c:\kurs\a1.txt');
   assign(a2,'c:\kurs\a2.txt');
   assign(a3,'c:\kurs\a3.txt');
   assign(a4,'c:\kurs\a4.txt');
   reset(a1);
   close(a1);
   reset(a2);
   close(a2);
   reset(a3);
   close(a3);
   rewrite(a4);
   close(a4);
   vvod ('c:\kurs\a2.txt',5,3,y);
   vvod ('c:\kurs\a1.txt',3,5,z);
   out('c:\kurs\a3.txt',5,5,x);
   out('c:\kurs\a3.txt',3,5,q);
   writeln;
   pro (5,5,3,y,z,x);
   pro (3,5,5,z,x,q);
   writeln('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
   writeln('<><><><><><><><><><><><><><><><><><><><>');
   writeln('proizvedenie matric');
   write('proiz z=');
   proiz(3,5,z,'c:\kurs\a1.txt',pro1);
   write('proiz y=');
   proiz(5,3,y,'c:\kurs\a2.txt',pro2);
   write('proiz x=');
   proiz(5,5,x,'c:\kurs\a3.txt',pro3);
   writeln('^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^');
   write('maximalnoe proizvedenie  ');
   maximum(pro1,pro2,pro3,P);
   stolb(3,2,5,p,z,'c:\kurs\a1.txt',z1);
   stolb(5,1,3,p,y,'c:\kurs\a2.txt',y1);
   stolb(5,4,5,p,x,'c:\kurs\a3.txt',x1);
   writeln;
   writeln;
   writeln;
   writeln('          proizvedenie matric');
   writeln('________________________________________');
   write('proY=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a1.txt',0,3,5,0,proZ);
   write('proY1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a1.txt',15,3,5,1,proZ1);
   write('proZ=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a2.txt',0,5,3,0,proY);
   write('proZ1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a2.txt',15,5,3,1,proY1);
   write('proX=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',0,5,5,0,proX);
   write('proX1=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',25,5,5,1,proX1);
   write('proQ=');
   prnot0('c:\kurs\a4.txt','c:\kurs\a3.txt',34,3,5,1,proQ);
   writeln('________________________________________');
   readkey;
END.

@Puporev · 24.05.2009, 16:55

Поясните пожалуйста этот момент.

где Р=max (произведение Х[i,j]; произведение Y[i,j]; произведение Z[i,j]).

произведение X[i,j]- это что, произведение всех элементов матрицы? И, если в матрице есть хоть 1 ноль, то оно равно нулю.
А если нолей нет, то это тоже самое, что и условие

Найти произведение ненулевых элементов каждой матрицы.

@karmen · 24.05.2009, 19:23 **[ТС]**

Ну получается, что это произведение всех элементов матрицы.
Пожалуйста, Puporev, если вы знаете как решить ее, то покажите как это сделать.

@Puporev · 24.05.2009, 19:26

Почти переделал. Произведение элементов в полученных матрицах получается очень большое, придется применить тип extended. Может сделать матрицы вещественного типа и взять значения элементов в пределах скажем от -2 до 2?

@Puporev · 24.05.2009, 21:46

Выкладываю переделанный код программы, во вложении программа и образцы исходных файлов.
Если вдруг не будет работать с типом extended, зайдите в меню Option, вкладка Compiler, справа внизу против 8087/80287 нажмите на окошечко, чтоб появился крестик.

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
program zadanie1;
uses crt;
const n=5;
      m=3;
type matr=array[1..n,1..n] of extended;
{ввод матрицы из файла,входные параметры-файл, размеры, выходной-матрица}
procedure Vvod(var f:text;x,y:byte;var mt:matr);
var i,j:byte;
    s:string;
begin
reset(f);
readln(f,s);{читаем заголовок}
for i:=1 to x do{читаем матрицу}
for j:=1 to y do
read (f,mt[i,j]);
close(f);
end;
{умножение матрицы на матрицу, входные-2 размера+2 матрицы, выходной-новая сматрица}
procedure UmnMatr(x,y:byte;a,b:matr;var ab:matr);
var i,j,s:byte;
    s1:extended;
begin
for i:=1 to n do
for j:=1 to n do
  begin
   s1:=0;
   for s:=1 to m do
   s1:=s1+a[i,s]*b[s,j];
   ab[i,j]:=s1;
  end;
end;
{произведение элементов матрицы}
function PrzMatr(x,y:byte;mt:matr):extended;
var i,j:byte;
    e:extended;
begin
e:=1;
for i:=1 to x do
for j:=1 to y do
e:=e*mt[i,j];
PrzMatr:=e;
end;
{произведенеие ненулевых элементов измененных матриц}
function PrzNot0(x,y:byte;mt:matr):extended;
var i,j:byte;
    e:extended;
begin
e:=1;
for i:=1 to x do
for j:=1 to y do
if mt[i,j]<>0 then
e:=e*mt[i,j];
PrzNot0:=e;
end;
{максимальное из трех произведений}
function Max(s11,s22,s33:extended):extended;
var mx:extended;
begin
mx:=s11;
if s22>mx then mx:=s22;
if s33>mx then mx:=s33;
Max:=mx;
end;
{умножение столбца, входные-количество строк, номер столбца и на что умножать
(макс произведение), выходной-матрица} 
procedure UmnSbc(x,k:byte; p:extended;var mt:matr);
var i:byte;
begin
for i:=1 to x do
mt[i,k]:=mt[i,k]*p;
end;
{вывод в новый файл результатов умножения матриц, входные-размеры,названия матриц, выходные-файл,2 матрицы} 
procedure out_1(var f:text;n1,m1,n2,m2:byte;var ms1,ms2:matr;s1,s2:string);
var i,j:byte;
begin
rewrite(f);
writeln(f,s1);
for i:=1 to n1 do
 begin
  for j:=1 to m1 do
  write(f,ms1[i,j]:10:2);
  writeln(f,'');
 end;
writeln(f,s2);
for i:=1 to n2 do
 begin
  for j:=1 to m2 do
  write(f,ms2[i,j]:10:2,' ');
  writeln(f,'');
 end;
close(f);
end;
{запись в существующие файлы измененных матриц, входные-размеры и названия 3х матриц, 
выходные-три матрицы, 3 файла и входные и выходные}
procedure out_2(var f1,f2,f3:text;x1,y1,x2,y2,x3,y3:byte;var ms1,ms2,ms3:matr;s1,s2,s3:string);
var i,j:byte;
begin
append(f1);
writeln(f1,s1);
for i:=1 to x1 do
 begin
  for j:=1 to y1 do
  write(f1,ms1[i,j]:12:2);
  writeln(f1,'');
 end;
close(f1);
append(f2);
writeln(f2,s2);
for i:=1 to x2 do
 begin
  for j:=1 to y2 do
  write(f2,ms2[i,j]:12:2,' ');
  writeln(f2,'');
 end;
close(f2);
append(f3);
writeln(f3,s3);
for i:=1 to x3 do
 begin
  for j:=1 to y3 do
  write(f3,ms3[i,j]:12:2,' ');
  writeln(f3,'');
 end;
close(f3);
end;
{вывод в новый файл произведений, входные-названия матриц, выходные-файл и три произведения}
procedure out_3(var f:text;var p1,p2,p3:extended;s1,s2,s3:string);
begin
rewrite(f);
write(f,s1);
write(f,p1:20:2);
writeln(f,'');
write(f,s2);
write(f,p2:20:2);
writeln(f,'');
write(f,s3);
write(f,p3:20:2);
close(f);
end;
{раздел переменых программы после описания подпрограмм, 
чтоб не было глобальных переменных, кроме констант}
var a1,a2,a3,a4:text;{4 файла}
    x,y,z,q:matr;{4 матрицы}
    P,p1,p2,p3:extended;{макс произведение и 3 произведения}
BEGIN
clrscr;
assign(a1,'a1.txt');
assign(a2,'a2.txt');
assign(a3,'a3.txt');
assign(a4,'a4.txt');
vvod (a1,m,n,z);
vvod (a2,n,m,y);
UmnMatr (n,m,y,z,x);
UmnMatr (n,m,z,x,q);
Out_1(a3,n,n,m,m,x,q,'Matrica X=Y*Z:','Matryca Q=Z*X:');
P:=Max(PrzMatr(n,n,x),PrzMatr(n,m,y),PrzMatr(m,n,z));
UmnSbc(n,1,P,y);
UmnSbc(m,2,P,z);
UmnSbc(n,4,P,x);
Out_2(a2,a1,a3,n,m,m,n,n,n,y,z,x,'Matrica Y*P:','Matrica Z*P:','Matrica X*P:');
p1:=PrzNot0(n,m,y);writeln('p1=',p1:20:2);
p2:=PrzNot0(m,n,z);writeln('p2=',p2:20:2);
p3:=PrzNot0(n,n,x);writeln('p3=',p3:20:2);
out_3(a4,p1,p2,p3,'Proizvedenie Y[i,j]=','Proizvedenie Z[i,j]=','Proizvedenie X[i,j]=');
write('Faily zapisany:');
readln
end.

Новые блоги и статьи Все статьи Все блоги /
Ритм жизни kumehtar 27.02.2026 Иногда приходится жить в ритме, где дел становится всё больше, а вовлечения в происходящее — всё меньше. Плотный график не даёт вниманию закрепиться ни на одном событии. Утро начинается с быстрых,. . .	SDL3 для Web (WebAssembly): Сборка библиотек SDL3 и Box2D из исходников с помощью CMake и Emscripten 8Observer8 27.02.2026 Недавно вышла версия SDL 3. 4. 2 библиотеки SDL3. На странице официальной релиза доступны исходники, готовые DLL (для x86, x64, arm64), а также библиотеки для разработки под Android, MinGW и Visual. . .	SDL3 для Web (WebAssembly): Реализация движения на Box2D v3 - трение и коллизии с повёрнутыми стенами 8Observer8 20.02.2026 Содержание блога Box2D позволяет легко создать главного героя, который не проходит сквозь стены и перемещается с заданным трением о препятствия, которые можно располагать под углом, как верхнее. . .	Конвертировать закладки radiotray-ng в m3u-плейлист damix 19.02.2026 Это можно сделать скриптом для PowerShell. Использование . \СonvertRadiotrayToM3U. ps1 <path_to_bookmarks. json> Рядом с файлом bookmarks. json появится файл bookmarks. m3u с результатом. # Check if. . .
Семь CDC на одном интерфейсе: 5 U[S]ARTов, 1 CAN и 1 SSI Eddy_Em 18.02.2026 Постепенно допиливаю свою "многоинтерфейсную плату". Выглядит вот так: https:/ / www. cyberforum. ru/ blog_attachment. php?attachmentid=11617&stc=1&d=1771445347 Основана на STM32F303RBT6. На борту пять. . .	Камера Toupcam IUA500KMA Eddy_Em 12.02.2026 Т. к. у всяких "хикроботов" слишком уж мелкий пиксель, для подсмотра в ESPriF они вообще плохо годятся: уже 14 величину можно рассмотреть еле-еле лишь на экспозициях под 3 секунды (а то и больше),. . .	И ясному Солнцу zbw 12.02.2026 И ясному Солнцу, и светлой Луне. В мире покоя нет и люди не могут жить в тишине. А жить им немного лет.	«Знание-Сила» zbw 12.02.2026 «Знание-Сила» «Время-Деньги» «Деньги -Пуля»

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	24.05.2009, 10:39
	Прога как не компилировалась, так и не компилируется, Вы что издеваетесь? Вам влом ее запустить и исправить синтаксическиее ошибки? Сейчас например встало на строке proizvedenie(5,5,x,'c:\kurs\a3.txt',pro1 ); //несоответствие типов 0

@karmen 0 / 0 / 0 Регистрация: 23.05.2009 Сообщений: 7
	24.05.2009, 19:23 [ТС]
	Ну получается, что это произведение всех элементов матрицы. Пожалуйста, Puporev, если вы знаете как решить ее, то покажите как это сделать. 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	24.05.2009, 19:26
	Почти переделал. Произведение элементов в полученных матрицах получается очень большое, придется применить тип extended. Может сделать матрицы вещественного типа и взять значения элементов в пределах скажем от -2 до 2? 0