Определить значение среднего арифметического отрицательных элементов

@Kernait · Регистрация: 27.11.2013

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

Даны две матрицы А[Na,Ma] и В[Nb,Mb]. Для каждой определить значение среднего арифметического отрицательных элементов. Преобразовать матрицы, заменив найденным значением элементы первого и последнего столбцов. Матрицы А и В распечатать в исходном и преобразованном виде.
Решить с помощью подпрограмм.

Добавлено через 51 минуту
Пока вот, что получилось, дальше не особо понимаю как действовать и + не уверен за правильность этого. Прошу помочь.

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
Program MyProg;
const
N1=15;{ìàêñèìàëüíîå êîëè÷åñòâî ñòðîê ìàòðèöû}
M1=20;{ìàêñèìàëüíîå êîëè÷åñòâî ñòîëáöîâ ìàòðèöû}
type
Matrix=array[1..M1,1..N1] of real;
var
A, B : Matrix;
Na, Ma, Nb, Mb : byte;
MaxA, MaxB : real;
procedure Vvod(var X:Matrix; var N,M:byte; ch:char);
var
i, j:byte;
begin
write('Ââåäèòå ðàçìåðíîñòü ìàòðèöû',ch);
write('Êîëè÷åñòâî ñòðîê=');
read(N);
write('Êîëè÷åñòâî ñòîëáöîâ=');
read(M);
writeln('Ââåäèòå ýëåìåíòû ìàòðèöû',ch);
for i:=1 to N do
for j:=1 to M do
begin
write(ch,'[',i,',',j,']=');
read(X[i,j]);
end;
end; {Vvod}
function SrArOtr(A:matrix;n,m:byte):real;
var i,j:byte;
sr:real;
s,k:real;
begin
s:=0;
k:=0;
for i:=1 to n do
begin
for j:=1 to m do
begin
if a[i,j]<0 then
begin
s:=s+a[i,j]; k:=k+1;
end;
end;
if k<>0 then
sr:=s/k;
SrArOtr:=sr;
end;

@programax · 23.04.2014, 17:25

Один из вариантов:

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
var
  a, b: array [0..14, 0..19] of integer;
  l, n: integer;
 
procedure arrproc;// заполнение и вывод матриц
var
  i, j: 0..19;
begin
  for i := 0 to 14 do
  begin
    for j := 0 to 19 do
    begin
      a[i, j] := random(-90, 50);//случайные числа в интервале от -90 до 50 
      b[i, j] := random(-90, 50);
      write(a[i, j]:4);
    end;
    writeln;
  end;
  for i := 1 to 80 do
    write('-');
  writeln;
  for i := 0 to 14 do
  begin
    for j := 0 to 19 do
    begin
      write(b[i, j]:4);
    end;
    writeln;
  end;
end;
 
procedure average;// нахождение среднего арифметического
var
  i, j: 0..19;
  m, o: integer;
begin
  for i := 0 to 14 do
  begin
    for j := 0 to 19 do
    begin
      if a[i, j] < 0 then
      begin
        l := l + a[i, j];
        m := m + 1
      end
      else if
      b[i, j] < 0 then
        n := n + b[i, j];
      o := o + 1;
    end;
  end;
  writeln;
  writeln('Сумма и кол-во отрицательных элементов 1-ой матрицы: ', l:5, '|', m:4);
  writeln('Сумма и кол-во отрицательных элементов 2-ой матрицы: ', n:5, '|', o:4);
  l := round(l / m);
  writeln('Среднее арифметическое отр. чисел 1-ой матрицы = ', l);
  n := round(n / o);
  writeln('Среднее арифметическое отр. чисел 2-ой матрицы = ', n);
  writeln;
end;
 
procedure change;// замена первого и последнего столбцов и вывод матриц
var
  i, j: 0..19;
begin
  for i := 0 to 14 do
  begin
    a[i, 0] := l;
    a[i, 19] := l;
    b[i, 0] := n;
    b[i, 19] := n;
  end;
  for i := 0 to 14 do
  begin
    for j := 0 to 19 do
    begin
      write(a[i, j]:4);
    end;
    writeln;
  end;
  for i := 1 to 80 do
    write('-');
  writeln;
  for i := 0 to 14 do
  begin
    for j := 0 to 19 do
    begin
      write(b[i, j]:4);
    end;
    writeln;
  end;
  
end;
 
begin
  arrproc;
  average;
  change;
end.

Добавлено через 8 минут
Установите вот это:
http://www.softportal.com/get-... bcnet.html

@Kernait · 23.04.2014, 20:09 **[ТС]**

А можно вариант который просто в pascalABC делается? спасибо.

Добавлено через 13 минут
+интересует ручной ввод пожалуйста.

@programax · 24.04.2014, 14:57

Вот на PascalABC:

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
var
  a, b: array [0..2, 0..2] of integer;
  l, n, m, o: integer;
 
procedure arrfill;// заполняем матрицу
var
  i, j: 0..2;
 
begin
  writeln('Введите элементы первого массива');
  for i := 0 to 2 do
  begin
    for j := 0 to 2 do
      readln(a[i, j]);
  end;
  writeln('Введите элементы второго массива');
  for i := 0 to 2 do
  begin
    for j := 0 to 2 do
      readln(b[i, j]);
  end;
end;
 
procedure arrwrite;// Печатаем исходный вид
var
  i, j: 0..2;
  k: byte;
 
begin
  for i := 0 to 2 do
  begin
    writeln;
    for j := 0 to 2 do
      write(a[i, j]:4);
  end;
  writeln;
  for k := 0 to 11 do
    write('-');
  for i := 0 to 2 do
  begin
    writeln;
    for j := 0 to 2 do
      write(b[i, j]:4);
  end;
end;
 
procedure average;// нахождение среднего арифметического
var
  i, j: 0..2;
begin
  for i := 0 to 2 do
  begin
    for j := 0 to 2 do
    begin
      if a[i, j] < 0 then
      begin
        l := l + a[i, j];
        m := m + 1;
      end;
      if b[i, j] < 0 then
      begin
        n := n + b[i, j];
        o := o + 1;
      end;
    end;
  end;
  writeln;
  writeln('Сумма и кол-во отрицательных элементов 1-ой матрицы: ', l:5, '|', m:4);
  writeln('Сумма и кол-во отрицательных элементов 2-ой матрицы: ', n:5, '|', o:4);
  l := round(l / m);
  writeln('Среднее арифметическое отр. чисел 1-ой матрицы = ', l);
  n := round(n / o);
  writeln('Среднее арифметическое отр. чисел 2-ой матрицы = ', n);
  writeln;
end;
 
procedure change;// замена первого и последнего столбца и вывод матриц
var
  i, j: 0..2;
  k: byte;
begin
  for i := 0 to 2 do
  begin
    a[i, 0] := l;
    a[i, 2] := l;
    b[i, 0] := n;
    b[i, 2] := n;
  end;
  for i := 0 to 2 do
  begin
    for j := 0 to 2 do
    begin
      write(a[i, j]:4);
    end;
    writeln;
  end;
  for k := 0 to 11 do
    write('-');
  writeln;
  for i := 0 to 2 do
  begin
    for j := 0 to 2 do
    begin
      write(b[i, j]:4);
    end;
    writeln;
  end;
 
end;
 
begin
  arrfill;
  arrwrite;
  average;
  change;
end.

@Kernait · 24.04.2014, 16:38 **[ТС]**

спасибо большое, и ещё вопросик, как будет выглядеть при полном самостоятельном создании матрицы.(т.е. сначала указываю количество строк, затем столбцов, затем элементы матрицы, затем вывод матрицы, затем нахождение среднего арифметического+его вывод, а затем уже преобразованную матрицу.)

@programax · 24.04.2014, 17:29

В смысле? Написать как эта программа будет выглядеть без использования подпрограмм?

@Kernait · 24.04.2014, 18:42 **[ТС]**

интересует только полностью ручной ввод, наподобие как я пытался сделать, а дальше все как у тебя, такой гибрид возможен?

@programax · 24.04.2014, 21:12

Можно вот так:

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
var
  a, b: array [0..14, 0..19] of integer;
  l, n, m, o, st,cs: integer;
 
procedure arrfill;
var
  i, j: 0..19;
 
begin
  writeln('Ââåäèòå êîë-âî ñòðîê è ñòîëáöîâ ìàòðèöû');
  readln(st);
  readln(cs);
  writeln('Ââåäèòå ýëåìåíòû ïåðâîãî ìàññèâà');
  for i := 0 to st do
  begin
    for j := 0 to cs do
      readln(a[i, j]);
  end;
  writeln('Ââåäèòå ýëåìåíòû âòîðîãî ìàññèâà');
  for i := 0 to st do
  begin
    for j := 0 to cs do
      readln(b[i, j]);
  end;
end;
 
procedure arrwrite;
var
  i, j: 0..19;
  k: byte;
 
begin
  for i := 0 to st do
  begin
    writeln;
    for j := 0 to cs do
      write(a[i, j]:4);
  end;
  writeln;
  for k := 0 to 11 do
    write('-');
  for i := 0 to st do
  begin
    writeln;
    for j := 0 to cs do
      write(b[i, j]:4);
  end;
end;
 
procedure average;
var
  i, j: 0..2;
begin
  for i := 0 to st do
  begin
    for j := 0 to cs do
    begin
      if a[i, j] < 0 then
      begin
        l := l + a[i, j];
        m := m + 1;
      end;
      if b[i, j] < 0 then
      begin
        n := n + b[i, j];
        o := o + 1;
      end;
    end;
  end;
  writeln;
  writeln('Ñóììà è êîë-âî îòðèöàòåëüíûõ ýëåìåíòîâ 1-îé ìàòðèöû: ', l:5, '|', m:4);
  writeln('Ñóììà è êîë-âî îòðèöàòåëüíûõ ýëåìåíòîâ 2-îé ìàòðèöû: ', n:5, '|', o:4);
  l := round(l / m);
  writeln('Ñðåäíåå àðèôìåòè÷åñêîå îòð. ÷èñåë 1-îé ìàòðèöû = ', l);
  n := round(n / o);
  writeln('Ñðåäíåå àðèôìåòè÷åñêîå îòð. ÷èñåë 2-îé ìàòðèöû = ', n);
  writeln;
end;
 
procedure change;
var
  i, j: 0..2;
  k: byte;
begin
  for i := 0 to st do
  begin
    a[i, 0] := l;
    a[i, 2] := l;
    b[i, 0] := n;
    b[i, 2] := n;
  end;
  for i := 0 to st do
  begin
    for j := 0 to cs do
    begin
      write(a[i, j]:4);
    end;
    writeln;
  end;
  for k := 0 to 11 do
    write('-');
  writeln;
  for i := 0 to st do
  begin
    for j := 0 to cs do
    begin
      write(b[i, j]:4);
    end;
    writeln;
  end;
 
end;
 
begin
  arrfill;
  arrwrite;
  average;
  change;
end.

Но тогда часть массива будет пустовать.

@Kernait · 25.04.2014, 07:56 **[ТС]**

не, не вышло, программу работает адекватно только при матрице 3 на 3.

Добавлено через 26 минут
Вот, кажется получилось:

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
var
a, b: array [1..999, 1..999] of integer;
l, n, m, o, st,cs: integer;
procedure arrfill;
var
i, j: 1..19;
begin
write('Количество строк=');
readln(st);
write('Количество столбцов=');
readln(cs);
writeln('Введите элементы первого массива');
for i := 1 to st do
for j := 1 to cs do
readln(a[i, j]);
begin
end;
writeln('Введите элементы второго массива');
for i := 1 to st do
for j := 1 to cs do
readln(b[i, j]);
begin
end;
end;
procedure arrwrite;
var
i, j: 0..19;
k: byte;
begin
for i := 1 to st do
begin
writeln;
for j := 1 to cs do
write(a[i, j]:4);
end;
writeln;
for k := 1 to 11 do
write('-');
for i := 1 to st do
begin
writeln;
for j := 1 to cs do
write(b[i, j]:4);
end;
end;
procedure average;
var
i, j: 0..999;
begin
for i := 1 to st do
begin
for j := 1 to cs do
begin
if a[i, j] < 0 then
begin
l := l + a[i, j];
m := m + 1;
end;
if b[i, j] < 0 then
begin
n := n + b[i, j];
o := o + 1;
end;
end;
end;
writeln;
writeln('Сумма и кол-во отрицательных элементов 1-ой матрицы: ', l:5, '|', m:4);
writeln('Сумма и кол-во отрицательных элементов 2-ой матрицы: ', n:5, '|', o:4);
l := round(l / m);
writeln('Среднее арифметическое отр. чисел 1-ой матрицы = ', l);
n := round(n / o);
writeln('Среднее арифметическое отр. чисел 2-ой матрицы = ', n);
writeln;
end;
procedure change;
var
i, j: 0..999;
k: byte;
begin
for i := 1 to st do
begin
a[i, 1] := l;
a[i, st] := l;
b[i, 1] := n;
b[i, st] := n;
end;
for i := 1 to st do
begin
for j := 1 to cs do
begin
write(a[i, j]:4);
end;
writeln;
end;
for k := 1 to 11 do
write('-');
writeln;
for i := 1 to st do
begin
for j := 1 to cs do
begin
write(b[i, j]:4);
end;
writeln;
end;
end;
begin
arrfill;
arrwrite;
average;
change;
end.

@Puporev · 25.04.2014, 08:19

Pascal
1
array [1..999, 1..999] of integer;

А руки не отнимутся вводить с клавы?

@Kernait · 25.04.2014, 11:04 **[ТС]**

Pascal
1
2
3
4
5
6
7
8
write('Количество строк=');
readln(st);
write('Количество столбцов=');
readln(cs);
writeln('Введите элементы первого массива');
for i := 1 to st do
for j := 1 to cs do
readln(a[i, j]);

тут же ввожу размерность матрицы, к примеру 2х2.

Добавлено через 2 минуты
ну а если вообще я с утра повозился, и все таки разобрался с данной темой.
Считаю, что вот эта версия решения наилучшая:

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
Program Name;
Const
N1=15;
M1=20;
Type
Matrix=array[1..M1,1..N1]of integer;
var
A,B:Matrix;
Na,Ma,Nb,Mb:byte;
saA,saB:integer;
procedure Vvod(var X:Matrix; Var N,M:byte; ch:char);
var
i,j:byte;
Begin
write('Vvod razm',ch);
write('Kol-vo strok=');
read(N);
write('Kol-vo stolb.=');
read(M);
writeLn('Element matr',ch);
for i:=1 to N do
for j:=1 to M do
begin
write(ch,'[',i,',',j,']=');
read(X[i,j]);
end;
end; {Vvod}
procedure Vyvod(Const X:matrix; N,M:byte; ch:char);
var
i,j:byte;
begin
writeln('Matrix',ch);
for i:=1 to N do
begin
for j:=1 to M do
write (X[i,j]:4);
writeLn;
end;
end;{Vyvod}
function sa(Const X:matrix; N,M:byte):integer;
var
i, j,k :byte;
l:integer;
begin
l:=0;
k:=0;
for i := 1 to N do
for j := 1 to M do
if X[i, j] < 0 then
begin
l := l + X[i, j];
k := k + 1;
end;
writeln;
l := round(l / k);
writeln('Среднее арифметическое отр. чисел n-ой матрицы = ', l);
sa:=l
end;
procedure Preobr(Var X:matrix; N,M:byte; l:integer);
var
i,j:byte;
begin
for i:=1 to N do
begin
X[i, 1]:= l;
X[i, M]:= l;
end;
end;
begin
Vvod(A,Na,Ma,'A');
Vvod(B,Nb,Mb,'B');
Vyvod(A,Na,Ma,'A');
Vyvod(B,Nb,Mb,'B');
saA:=sa(A,Na,Ma);
saB:=sa(B,Nb,Mb);
Preobr(A,Na,Ma,saA);
Preobr(B,Nb,Mb,saB);
Vyvod(A,Na,Ma,'A');
Vyvod(B,Nb,Mb,'B');
end.

Новые блоги и статьи Все статьи Все блоги /
Модель микоризы: классовый агентный подход anaschu 02.01.2026 Раньше это было два гриба и бактерия. Теперь три гриба, растение. И на уровне агентов добавится между грибами или бактериями взаимодействий. До того я пробовал подход через многомерные массивы,. . .	Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Programma_Boinc 01.01.2026 Учёным и волонтёрам проекта «Einstein@home» удалось обнаружить четыре гамма-лучевых пульсара в джете Млечного Пути Сочетание глобально распределённой вычислительной мощности и инновационных. . .	Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Programma_Boinc 28.12.2025 Советы по крайней бережливости. Внимание, это ОЧЕНЬ длинный пост. Налог на собак: https:/ / ********/ gallery/ V06K53e Финансовый отчет в Excel: https:/ / ********/ gallery/ bKBkQFf Пост отсюда. . .	Кто-нибудь знает, где можно бесплатно получить настольный компьютер или ноутбук? США. Programma_Boinc 26.12.2025 Нашел на реддите интересную статью под названием Anyone know where to get a free Desktop or Laptop? Ниже её машинный перевод. После долгих разбирательств я наконец-то вернула себе. . .	Thinkpad X220 Tablet — это лучший бюджетный ноутбук для учёбы, точка. Programma_Boinc 23.12.2025 Рецензия / Мнение/ Перевод Нашел на реддите интересную статью под названием The Thinkpad X220 Tablet is the best budget school laptop period . Ниже её машинный перевод. Thinkpad X220 Tablet —. . .
PhpStorm 2025.3: WSL Terminal всегда стартует в ~ and_y87 14.12.2025 PhpStorm 2025. 3: WSL Terminal всегда стартует в ~ (home), игнорируя директорию проекта Симптом: После обновления до PhpStorm 2025. 3 встроенный терминал WSL открывается в домашней директории. . .	Как объединить две одинаковые БД Access с разными данными VikBal 11.12.2025 Помогите пожалуйста !! Как объединить 2 одинаковые БД Access с разными данными.	Новый ноутбук volvo 07.12.2025 Всем привет. По скидке в "черную пятницу" взял себе новый ноутбук Lenovo ThinkBook 16 G7 на Амазоне: Ryzen 5 7533HS 64 Gb DDR5 1Tb NVMe 16" Full HD Display Win11 Pro	Музыка, написанная Искусственным Интеллектом volvo 04.12.2025 Всем привет. Некоторое время назад меня заинтересовало, что уже умеет ИИ в плане написания музыки для песен, и, собственно, исполнения этих самых песен. Стихов у нас много, уже вышли 4 книги, еще 3. . .	От async/await к виртуальным потокам в Python IndentationError 23.11.2025 Армин Ронахер поставил под сомнение async/ await. Создатель Flask заявляет: цветные функции - провал, виртуальные потоки - решение. Не threading-динозавры, а новое поколение лёгких потоков. Откат?. . .

@Kernait 1 / 1 / 2 Регистрация: 27.11.2013 Сообщений: 39
	23.04.2014, 20:09 [ТС]
	А можно вариант который просто в pascalABC делается? спасибо. Добавлено через 13 минут +интересует ручной ввод пожалуйста. 0

@Kernait 1 / 1 / 2 Регистрация: 27.11.2013 Сообщений: 39
	24.04.2014, 16:38 [ТС]
	спасибо большое, и ещё вопросик, как будет выглядеть при полном самостоятельном создании матрицы.(т.е. сначала указываю количество строк, затем столбцов, затем элементы матрицы, затем вывод матрицы, затем нахождение среднего арифметического+его вывод, а затем уже преобразованную матрицу.) 0

@programax 5 / 5 / 6 Регистрация: 18.03.2014 Сообщений: 23
	24.04.2014, 17:29
	В смысле? Написать как эта программа будет выглядеть без использования подпрограмм? 0

@Kernait 1 / 1 / 2 Регистрация: 27.11.2013 Сообщений: 39
	24.04.2014, 18:42 [ТС]
	интересует только полностью ручной ввод, наподобие как я пытался сделать, а дальше все как у тебя, такой гибрид возможен? 0

Определить значение среднего арифметического отрицательных элементов

Решение