Форум программистов, компьютерный форум, киберфорум
Наши страницы
Pascal (Паскаль)
Войти
Регистрация
Восстановить пароль
 
 
Рейтинг 4.55/805: Рейтинг темы: голосов - 805, средняя оценка - 4.55
Unrealler
653 / 351 / 113
Регистрация: 11.12.2009
Сообщений: 508
#1

Стандартные операции с массивами (матрицами)

29.05.2010, 11:10. Просмотров 144855. Ответов 35

-------------------------------------------------------------------------------------------
Содержание:
  1. "Переворот" массива
  2. Сдвиг массива на k элементов влево или вправо
  3. Сдвиг массива на k элементов влево или вправо за линейное время
  4. Поиск минимума/максимума и их индексов
  5. Поиск минимума/максимума и их индексов в двумерном массиве (матрице)
  6. Работа с элементами выше/ниже/на главной/побочной диагоналях
  7. Транспонирование матрицы относительно главной и побочной диагоналей
  8. Поворот двумерного массива на 90° по часовой стрелке
  9. Поворот на 90 градусов по часовой стрелке и против без использования дополнительного массива
  10. Удаление элемента в одномерном массиве
  11. Удаление строк и столбцов по условию
  12. Цифровая сортировка (DigidalSort)
  13. Удаление всех строк и столбцов, содержащих хотя бы 1 ноль
  14. Двоичный (бинарный) поиск
  15. Работа с матрицей одним циклом
  16. Заполнение массива случайными неповторяющимися значениями
  17. Заполнение массива змейкой из левого верхнего угла
  18. Заполнение массива змейкой снизу вверх построчно
  19. Удалить все элементы, которые встречаются больше 1 раза
  20. Удаление элементов в одномерном несортированном массиве по условию
  21. Заполнение массива по спирали
  22. Построение синусоиды на двумерном массиве(матрице) из точек(.)
  23. Вставка нового столбца в матрицу со сдвигом исходных элементов
  24. Вставка новой строки в матрицу со сдвигом исходных элементов
  25. Переворот матрицы на 90° по часовой стрелке
  26. Заполнение массива неповторяющимися значениями
-------------------------------------------------------------------------------------------





1) Очень часто на форуме просят "переворот" массива. Например, было
Код
1 2 3 4 5
Стало
Код
5 4 3 2 1
Осуществляется это так:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
var
   a:array[1..100] of integer;
   i,r,n:integer;
begin
 readln(n);  {Г·ГЁГІГ*ГҐГ¬ Г°Г*çìåð Г¬Г*Г±Г±ГЁГўГ*}
 for i:=1 to n do
  read(a[i]);
 for i:=1 to n div 2 do   {Г±Г*Г¬ "ïåðåâîðîò"}
  begin
   r:=a[i];
   a[i]:=a[n-i+1];
   a[n-i+1]:=r;
  end;
 for i:=1 to n do
  write(a[i],' ');
 readln
end.
2) Не менее возникает вопрос о сдвиге массива на k элементов влево или вправо.
Было
Код
1 2 3 4 5
Стало
Код
5 1 2 3 4
Сдвиг влево на k элементов:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
var
   a:array[1..100] of integer;
   i,r,n,k,j:integer;
begin
 read(n,k);  {k îáîçГ*Г*Г·Г*ГҐГІ âåëè÷èГ*Гі ñäâèãГ*}
 for i:=1 to n do
  read(a[i]);
 for i:=1 to k do
  begin
   for j:=1 to n do
    if (j=1) then r:=a[j] else a[j-1]:=a[j];
   a[n]:=r;
  end;
 for i:=1 to n do
  write(a[i],' ');
 readln
end.
Сдвиг на k элементов вправо:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
var
   a:array[1..100] of integer;
   i,r,n,k,j:integer;
begin
 read(n,k);  {k îáîçГ*Г*Г·Г*ГҐГІ âåëè÷èГ*Гі ñäâèãГ*}
 for i:=1 to n do
  read(a[i]);
 for i:=1 to k do
  begin
   for j:=n downto 1 do
    if (j=n) then r:=a[n] else a[j+1]:=a[j];
   a[1]:=r;
  end;
 for i:=1 to n do
  write(a[i],' ');
 readln
end.
38
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
29.05.2010, 11:10
Ответы с готовыми решениями:

Стандартные операции с матрицами
Очень прошу, помогите, кто чем сможет) буду очень благодарна... Написать...

Стандартные операции с массивами
Можете помочь? Завтра сдавать : 1) Вести массив A(N). Найти среднее...

Операции с массивами и матрицами, подсчет кол-ва столбцов содержащих отрицательные элементы.
Нужна помощь с таким заданием: Если в прямоугольной матрице меньше половины...

Стандартные алгоритмы работы с одномерными массивами
1. Ввод массива целых чисел. 2. Вывод массива в строку. 3. Найти минимальный...

Основные операции с матрицами
Определить значение матричного многочлена f(x)=A*A*A+2*A*A-3*A-5*E; ...

35
yanyk1n
4331 / 1462 / 680
Регистрация: 12.03.2009
Сообщений: 5,310
29.05.2010, 13:20 #2
3) Поиск минимума/максимума и их индексов:

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
var a:array[1..100]of integer;
N,i,min,max:integer;
 
begin
 write('N -> ');
 readln(N); {считываем размер массива}
 write('Input array -> ');
 for i:=1 to N do read(a[i]); {считываем сам массив}
 readln;
 min:=1;
 max:=2;
 for i:=1 to N do if a[i] > a[max] then max:=i else if a[i] < a[min] then min := i;
 writeln('MAX = A[',max,'] = ', a[max]);
 writeln('MIN = A[',min,'] = ', a[min]);
 readln;
end.
4) Поиск минимума/максимума и их индексов в двумерном массиве (матрице):

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
var a:array[1..100,1..100]of integer;
N, M, i, j, mini, minj, maxi, maxj :integer;
 
begin
 write('N, M -> ');
 readln(N, M); {считываем размер матрицы}
 write('Input matrix -> ');
 for i:=1 to N do for j:=1 to M do
 begin
  write('A[',i,',',j,'] -> ');
  readln(a[i, j]);
 end; {считываем саму матрицу}
 readln;
 mini:=1;
 minj:=1;
 maxi:=2;
 maxj:=2;
 for i:=1 to N do for j:=1 to M do if a[i,j] > a[maxi, maxj] then
 begin
  maxi := i;
  maxj := j;
 end else if a[i, j] < a[mini, minj] then
 begin
  mini := i;
  minj := j;
 end;
 writeln('MAX = A[',maxi,',',maxj,'] = ', a[maxi, maxj]);
 writeln('MIN = A[',mini,',',minj,'] = ', a[mini, minj]);
 readln;
end.

5) Работа с элементами выше/ниже/на главной/побочной диагоналях
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
var a:array[1..100,1..100]of integer;
N, M, i, j :integer;
 
begin
 write('N, M -> ');
 readln(N, M); {считываем размер матрицы}
 write('Input matrix -> ');
 for i:=1 to N do for j:=1 to M do
 begin
  write('A[',i,',',j,'] -> ');
  readln(a[i, j]);
 end; {считываем саму матрицу}
 readln;
 
 writeln('Главная диагональ');
 for i:=1 to N do
 begin
  write(a[i,i],' '); {вы можете не только просто выводить элементы, но и работать с ними. Достаточно знать индексацию нужных элементов}
 end;
 writeln;
 
 writeln('Побочная диагональ');
 for i:=1 to N do
 begin
  write(a[i,N-i+1],' ');
 end;
 writeln;
 
 writeln('Ниже главной');
 for i:=2 to N do
 for j:=1 to i-1 do
 begin
  write(a[i,j],' ');
 end;
 writeln;
 
 writeln('Выше главной');
 for i:=1 to N-1 do
 for j:=i+1 to N do
 begin
  write(a[i,j],' ');
 end;
 writeln;
 
 writeln('Выше побочной');
 for i:=1 to N-1 do
 for j:=1 to N-i do
 begin
  write(a[i,j],' ');
 end;
 writeln;
 
 writeln('Ниже побочной');
 for i:=2 to N do
 for j:=N-i+2 to N do
 begin
  write(a[i,j],' ');
 end;
 writeln;
 readln;
end.
22
STGE
770 / 575 / 324
Регистрация: 17.06.2009
Сообщений: 1,188
29.05.2010, 23:14 #3
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
 {транспонирование матрицы относительно главной диагонали}
 uses crt;
 const n=100;
 var mas: array[1..n,1..n] of integer;
     i,j,l: byte;  prom: integer;
 begin
 
  randomize;   {процедура инициализации генератора случайных чисел}
  clrscr;
 
  write('введите размер матрицы: ');   {ввод размеров матрицы}
  readln(l);
  writeln;
 
  writeln('исходная матрица: ');    {вывод исходной матрицы на экран}
  for i:=1 to l do
   begin
    for j:=1 to l do
     begin
      mas[i,j]:=random(19);
      mas[i,j]:=mas[i,j]-9;
      write(mas[i,j]:3);
     end;
    writeln;
   end;
  writeln;
 
  for i:=2 to l do   {сам процесс транспонирования}
   for j:=1 to i-1 do
    begin
     prom:=mas[i,j];
     mas[i,j]:=mas[j,i];
     mas[j,i]:=prom;
    end;
 
  writeln('результат транспонирования: ');    {вывод матрицы после преобразований}
  for i:=1 to l do
   begin
    for j:=1 to l do
     write(mas[i,j]:3);
    writeln;
   end;
 
 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
 {транспонирование матрицы относительно побочной диагонали}
 uses crt;
 const n=100;
 var mas: array[1..n,1..n] of integer;
     i,j,l: byte; prom: integer;
 begin
 
  randomize;   {процедура инициализации генератора случайных чисел}
  clrscr;
 
  write('введите размер матрицы: ');   {ввод размеров матрицы}
  readln(l);
  writeln;
 
  writeln('исходная матрица: ');    {вывод исходной матрицы на экран}
  for i:=1 to l do
   begin
    for j:=1 to l do
     begin
      mas[i,j]:=random(19);
      mas[i,j]:=mas[i,j]-9;
      write(mas[i,j]:3);
     end;
    writeln;
   end;
  writeln;
 
  for i:=1 to l-1 do   {сам процесс транспонирования}
   for j:=l-i downto 1 do
    begin
     prom:=mas[i,j];
     mas[i,j]:=mas[l-j+1,l-i+1];
     mas[l-j+1,l-i+1]:=prom;
    end;
 
  writeln('результат транспонирования: ');  {вывод матрицы после преобразований}
  for i:=1 to l do
   begin
    for j:=1 to l do
     write(mas[i,j]:3);
    writeln;
   end;
 
 end.
18
Unrealler
653 / 351 / 113
Регистрация: 11.12.2009
Сообщений: 508
31.05.2010, 08:56  [ТС] #4
7) Это довольно нестандартная операция, но все же может пригодится.
Поворот двумерного массива на 90° по часовой стрелке. Выглядит это так:
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
var
   a,b:array[1..100,1..100] of integer;
   i,j,n,m:integer;
begin
 readln(n,m);    {êîëè÷åñòâî ñòðîê ГЁ ñòîëáöîâ ñîîòâåòñòâåГ*Г*Г®}
 for i:=1 to n do
  for j:=1 to m do
   read(a[i,j]);      {ñ÷èòûâГ*ГҐГ¬ ýëåìåГ*ГІГ»}
 writeln('ÑòГ*ðûé Г¬Г*Г±Г±ГЁГў');
 for i:=1 to n do
  begin
   for j:=1 to m do
    write(a[i,j]:4); {âûâîä ââåäåГ*Г*îãî Г¬Г*Г±Г±ГЁГўГ* Г*Г* ГЅГЄГ°Г*Г*}
   writeln;
  end;
 for j:=1 to n do
  for i:=1 to m do
   b[i,n-j+1]:=a[j,i];  {ïåðåâîðîò Г¬Г*Г±Г±ГЁГўГ* îñóùåñòâëÿåòñÿ ïðè ïîìîùè äðóãîãî Г¬Г*Г±Г±ГЁГўГ*}
 writeln('ÍîâГ*Гї Г°Г*çìåðГ*îñòü');
 writeln(m,' ',n);  {âûâîäèì Г*îâûå Г°Г*çìåðû}
 writeln('Íîâûé Г¬Г*Г±Г±ГЁГў');
 for i:=1 to m do
  begin
   for j:=1 to n do
    write(b[i,j]:4);   {âûâîäèì Г*îâûé Г¬Г*Г±Г±ГЁГў}
   writeln;
  end;
 readln
end.
18
Puporev
Модератор
54221 / 41854 / 28923
Регистрация: 18.05.2008
Сообщений: 98,534
31.05.2010, 11:22 #5
8) Поворот на 90 градусов по часовой стрелке и против без использования дополнительного массива.
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
uses crt;
const n=6;
var a : array[1..n,1..n] of integer;
    i,j,p,x : integer;
begin
clrscr;
writeln('Исходная матрица:');
for i:=1 to n do
  begin
    for j:=1 to n do
      begin
       a[i,j] := 10*i+j;
       write(a[i,j]:4);
      end;
    writeln;
  end;
p := n div 2;
{поворот по часовой стрелке}
for i:=1 to p do
for j:=i to n-i do
  begin
    x := a[i,j];
    a[i,j] := a[n-j+1,i];
    a[n-j+1,i] := a[n-i+1,n-j+1];
    a[n-i+1,n-j+1] := a[j,n-i+1];
    a[j,n-i+1] := x;
  end;
writeln('Поворот на 90 градусов по часовой стрелке:');
for i:=1 to n do
  begin
    for j:=1 to n do
    write(a[i,j]:4);
    writeln;
  end;
{поворот против часовой стрелки}
for i:=1 to p do
for j:=i to n-i do
 begin
  x:=a[i,j];
  a[i,j]:=a[j,n-i+1];
  a[j,n-i+1]:=a[n-i+1,n-j+1];
  a[n-i+1,n-j+1] := a[n-j+1,i];
  a[n-j+1,i]:=x;
 end;
writeln('Поворот на 90 градусов против часовой стрелки:');
for i:=1 to n do
  begin
    for j:=1 to n do
    write(a[i,j]:4);
    writeln;
  end;
readln
end.
23
Unrealler
653 / 351 / 113
Регистрация: 11.12.2009
Сообщений: 508
01.06.2010, 08:54  [ТС] #6
9) Удаление элемента в одномерном массиве
Пусть нужно удалить все нулевые элементы из введенного пользователем массива.
Удаление:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
var
   a:array[1..100] of integer;
   i,m,n:integer;
begin
 readln(n);    {ñ÷èòûâГ*ГҐГ¬ êîëè÷åñòâî ýëåìåГ*òîâ}
 for i:=1 to n do
  read(a[i]);
 writeln('ГЊГ*Г±Г±ГЁГў');
 for i:=1 to n do
  write(a[i],' ');
 writeln;
 writeln('Ïîñëå ГіГ¤Г*ëåГ*ГЁГї');
 m:=0;
 for i:=1 to n do
  if (a[i]=0) then inc(m) else a[i-m]:=a[i]; {ГіГ¤Г*ëÿåì ýëåìåГ*ГІГ»}
 dec(n,m);  {óìåГ*ГјГёГ*ГҐГ¬ êîëè÷åñòâî ýëåìåГ*òîâ Г¬Г*Г±Г±ГЁГўГ* Г*Г* êîëè÷åñòâî Г*óëåâûõ ýëåìåГ*òîâ}
 for i:=1 to n do
  write(a[i],' '); {âûâîä Г*Г* ГЅГЄГ°Г*Г*}
 readln
end.
16
Unrealler
653 / 351 / 113
Регистрация: 11.12.2009
Сообщений: 508
02.06.2010, 12:44  [ТС] #7
10) Вставка элемента в одномерный массив
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
var
   a:array[1..100] of integer;
   i,x,n,nom:integer;
begin
 write('Ââåäèòå êîëè÷åñòâî ýëåìåГ*òîâ=');
 readln(n);
 for i:=1 to n do
  read(a[i]);  {ñ÷èòûâГ*ГҐГ¬ ýëåìåГ*ГІГ»}
 write('Ââåäèòå ÷èñëî, êîòîðîå Г*ГіГ¦Г*Г® ГўГ±ГІГ*ГўГЁГІГј=');
 readln(x);
 write('Ââåäèòå Г*îìåð ÿ÷åéêè, Гў êîòîðóþ ГҐГЈГ® Г*Г*äî ïîìåñòèòü=');
 readln(nom);
 writeln('ГЊГ*Г±Г±ГЁГў');
 for i:=1 to n do
  write(a[i],' ');
 writeln;
 writeln('Ïîñëå ГўГ±ГІГ*ГўГЄГЁ');
 for i:=n+1 downto nom+1 do
  a[i]:=a[i-1]; {ñäâèãГ*ГҐГ¬ ГўГ±ГҐ ýëåìåГ*ГІГ» ГўГЇГ°Г*ГўГ®}
 a[nom]:=x;    {ГўГ±ГІГ*âëÿåì ÷èñëî}
 for i:=1 to n+1 do
  write(a[i],' ');
 readln
end.
12
Unrealler
653 / 351 / 113
Регистрация: 11.12.2009
Сообщений: 508
02.07.2010, 16:24  [ТС] #8
11) Цифровая сортировка (DigidalSort)
Пусть нужно отсортировать массив по возрастанию, а на вход поступают числа в диапазоне [-100;100]. При этом их количество настолько большое, что не поможет даже быстрая сортировка. Выходом служит так называемая цифровая сортировка. Возьмем
Pascal
1
a:array[-100..100] of integer
Предварительно обнулим его.
Pascal
1
2
for i:=-100 to 100 do
 a[i]:=0;
Или
Delphi
1
fillchar(a,sizeof(a),0)
для пишущих на Delphi
Каждая ячейка a[i] будет хранить количество повторений числа i
Получаем:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
var
   a:array[-100..100] of integer;
   i,n,c,j:integer;
begin
 readln(n);
 for i:=1 to n do
  begin
   read(c);
   inc(a[c]);
  end;
 for i:=-100 to 100 do
  for j:=1 to a[i] do
   write(i,' ');
 readln
end.
13
Puporev
Модератор
54221 / 41854 / 28923
Регистрация: 18.05.2008
Сообщений: 98,534
06.11.2010, 09:02 #9
Удаление всех строк и столбцов, содержащих хоть 1 ноль. Также положительные, отрицательные и т.д.
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
uses crt;
var a:array[1..10,1..9] of integer;
    b:array[1..9] of byte;
    m,n,i,j,f,p,k:byte;
begin
clrscr;
randomize;
n:=10;
m:=9;
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to m do
   begin
    a[i,j]:=random(10);
    write(a[i,j]:3);
   end;
  writeln;
 end;
writeln;
{номера столбцов с нолями}
f:=0;
for j:=1 to m do
 begin
  k:=0;
  for i:=1 to n do
  if a[i,j]=0 then
   begin
    k:=1;
    f:=1;
   end;
  b[j]:=k;
 end;
if f=0 then write('В матрице нет нолей!')
else
 begin
  {удаление строк с нолем}
  i:=n;{начнем с конца}
  while(i>=1)and(n>0) do
   begin
    k:=0;
    j:=1;
    while(j<=m)and(k=0) do
    if a[i,j]=0 then k:=1
    else j:=j+1;
    if k=1 then{если есть ноль}
     begin
      f:=f-1;{вычитаем строку}
      if i=n then {если строка на этот момент последняя}
       begin
        n:=n-1;{обрезаем}
        i:=i-1;{верх}
       end
      else {если не последняя}
       begin
        for k:=i to n-1 do{от этой строки до предпоследней}
        for p:=1 to m do{всем элементам строк}
        a[k,p]:=a[k+1,p];{присваиваем значения нижней}
        n:=n-1;{уменьшаем количество}
       end;
     end
    else i:=i-1;{если нет нолей, вверх}
   end;
if n=0 then writeln('Все строки и столбцы удалены!')
else{если остались строки, удаляем столбцы}
 begin
  f:=m;{начнем с конца}
  for i:=m downto 1 do{в обратном порядке читаем массив номеров}
  if b[i]=1 then{если есть ноль}
   begin
    if i=f then{и последний на данный момент, также как строки}
      begin
       m:=m-1;
       f:=f-1;
      end
    else {если не последний, тоже как строки}
     begin
      for k:=i to m-1 do
      for p:=1 to n do
      a[p,k]:=a[p,k+1];
      m:=m-1;
     end;
   end;
  writeln('Матрица после сжатия:');
  for i:=1 to n do
   begin
    for j:=1 to m do
    write(a[i,j]:3);
    writeln;
   end;
 end;
 end;
readln
end.
8
Домолаз
нэ
64 / 64 / 42
Регистрация: 08.04.2010
Сообщений: 166
11.12.2010, 17:48 #10
Двоичный(бинарный) поиск
Ищет номер заданного элемента в упорядоченном по возрастанию массиве.
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
var
   n,v,i,r:integer;
   a:array[1..1000] of integer;
   
procedure binsearch(left,right:integer);
begin
    if left=right then
    begin
       r:=right;
       exit;
    end;
      
   r:=(right+left) div 2;
   if a[r]<v then
   begin
      left:=r+1;
      binsearch(left,right)
   end
   else
   begin
      right:=r;
      binsearch(left,right);
   end;
end;
 
begin
   readln(n);
   for i:=1 to n do
      read(a[i]);
   readln(v);
   binsearch(1,n);
   if a[r]=v then
      writeln(r)
   else
      writeln('Absent');
end.
10
TAVulator
3951 / 1110 / 160
Регистрация: 27.07.2009
Сообщений: 3,457
02.03.2011, 23:49 #11
Все знают как работать с двумерными массивами с помощью двух циклов:
Pascal
1
2
3
For i:=1 to N do
 For j:=1 to M do
  A[i,j] ...
А что если осуществить работу с матрицей в одном цикле? Легко!
Достаточно реализовать цикл от 0 до кол-во элементов -1.
Обращение к элементу осуществляется по формуле:
A[(i div кол-во строк)+1, (i mod кол-во столбцов)+1]

Пример реализации:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
const
 N = 7; {кол-во строк}
 M = 6; {кол-во столбцов}
var
 A: array[1..N,1..M] of byte;
 i: byte;
Begin
 Randomize;
 For i:=0 to N*M-1 do
  Begin
   A[(i div N)+1, (i mod M)+1]:=random(99);
   write(A[(i div N)+1, (i mod M)+1]:4);
   if ((i+1) mod M = 0) then writeln;
  End;
 readln;
End.
4
Cegou
37 / 32 / 9
Регистрация: 04.03.2011
Сообщений: 120
05.03.2011, 15:52 #12
Хотелось бы добавить способ заполнения массива случайными неповторяющимися числами:
  1. для одномерного:
    Pascal
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    
    var
      a: array [1..100] of integer;
      i, j, k, n: integer;
     
    begin
      repeat
        write('Задайте размер массива: ');
        readln(n);
      until n in [1..100];
      writeln('Массив:');
      for i := 1 to n do
      begin
        repeat
          k := 0;
          a[i] := random(-101, 101);
          for j := 1 to i - 1 do
            if a[j] = a[i] then inc(k);
        until k = 0;
        write(a[i], ' ');
      end;
      writeln;
    end.
  2. для двумерного:
1
Puporev
Модератор
54221 / 41854 / 28923
Регистрация: 18.05.2008
Сообщений: 98,534
05.03.2011, 16:03 #13
Pascal
1
random(-101, 101)
;
Вроде так не бывает...
обычно random(203)-101;
0
Cegou
37 / 32 / 9
Регистрация: 04.03.2011
Сообщений: 120
05.03.2011, 16:19 #14
В abc.net такая конструкция, допустима Но в этом топике надо писать обобщенно, согласен.

Наверно вечерком закину для двумерного)
0
Puporev
Модератор
54221 / 41854 / 28923
Регистрация: 18.05.2008
Сообщений: 98,534
05.03.2011, 16:54 #15
В abc.net такая конструкция, допустима
Здесь наверное ты один в этом пишешь, придерживайся общих правил Паскаля.
0
S9
Волшебник
648 / 251 / 87
Регистрация: 18.12.2010
Сообщений: 541
02.06.2011, 08:55 #16
Если кому надо, то вот два варианта заполнения двухмерного массива.
Этот код заполняет как на картинке 1
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
Const
    N = 5;
Var
    A:Array[1..20,1..20] Of Integer;
    k,x,y,Num:integer;
  {проверка диапазона}
  
Procedure Check(Var i,j:Integer);
    Begin
      If i = 0 Then Inc(i)
        Else
          If i > N Then
            Begin
              i:= N;
              j:= j+2;
            End;
    End;
    
Begin
    {начальные значиения}
    x:=1;
    y:=1;
    k:=1;
    {перебираем все номера}
    For Num:=1 To N*N Do
        Begin
            A[x,y]:=Num;
            {следующие координаты}
            x:=x + k;
            y:=y - k;
        {сдедующая строка эквивалентна 
        if (x = 0)Or(y = 0)Or(x > N)Or(y > N) Then k:=-k;}
        k:=k*(1 - 2*Ord((x = 0)Or(y = 0)Or(x > N)Or(y > N)));
        {корректируем координаты}
        If Odd(N) Then
            Begin
                Check(x,y);
                Check(y,x);
            End
                Else
            Begin
                Check(y,x);
                Check(x,y);
            End;
        End;{выводим результат}
    For x:=1 To N Do
        Begin
            For y:=1 To N Do
                Write(a[x,y]:3);
            WriteLn;
        End;
    ReadLn;
End.
А этот, как на картинке 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
Var A:Array[1..100,1..100] Of Integer;
    n,i,j:Integer;
    
Begin
Write('n = ');
ReadLn(n);
If n Mod 2 <> 0 Then {для матриц нечетной размерности}
For i:=1 To n Do
    Begin
        For j:=1 To n Do
        Begin
            If i Mod 2 <> 0 Then {для нечетных строк}
                A[i,j]:=n*(n - i) + j
            Else A[i,j]:=n*(n - i + 1) - j + 1; {для четных строк}
                Write(a[i,j]:3);
        End;
        WriteLn;
    End
Else 
    If n Mod 2 = 0 Then  {для матриц четной размерности}
For i:=1 To n Do
    Begin
    For j:=1 To n Do
        Begin
            If i Mod 2 <> 0 Then  { для нечетных строк } 
                A[i,j]:=n*(n - i + 1) - j + 1
            Else a[i,j]:=n*(n - i) + j;  { для четных строк }
                Write(a[i,j]:3);
        End;
        WriteLn;
    End;
ReadLn;
End.
6
Изображения
  
Вложения
Тип файла: rar Solution1.rar (26.2 Кб, 99 просмотров)
Тип файла: rar Solution2.rar (14.1 Кб, 72 просмотров)
incred
0 / 0 / 0
Регистрация: 08.02.2016
22.06.2011, 15:44 #17
может кто-нибудь организует все операции в процедуры? как вот здесь:
Сортировки

Добавлено через 41 минуту
а как совместить 4 и 5 пункт?

например найти минимум/максимум на главной/побочной или выше/ниже определённой диагонали?

да. я новичёк. учусь.
0
XEHK
4 / 4 / 1
Регистрация: 23.03.2011
Сообщений: 69
07.07.2011, 23:06 #18
Цитата Сообщение от Unrealler Посмотреть сообщение
9) Удаление элемента в одномерном массиве
Пусть нужно удалить все нулевые элементы из введенного пользователем массива.
Удаление:
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
var
   a:array[1..100] of integer;
   i,m,n:integer;
begin
 readln(n);    {ñ÷èòûâГ*ГҐГ¬ êîëè÷åñòâî ýëåìåГ*òîâ}
 for i:=1 to n do
  read(a[i]);
 writeln('ГЊГ*Г±Г±ГЁГў');
 for i:=1 to n do
  write(a[i],' ');
 writeln;
 writeln('Ïîñëå ГіГ¤Г*ëåГ*ГЁГї');
 m:=0;
 for i:=1 to n do
  if (a[i]=0) then inc(m) else a[i-m]:=a[i]; {ГіГ¤Г*ëÿåì ýëåìåГ*ГІГ»}
 dec(n,m);  {óìåГ*ГјГёГ*ГҐГ¬ êîëè÷åñòâî ýëåìåГ*òîâ Г¬Г*Г±Г±ГЁГўГ* Г*Г* êîëè÷åñòâî Г*óëåâûõ ýëåìåГ*òîâ}
 for i:=1 to n do
  write(a[i],' '); {âûâîä Г*Г* ГЅГЄГ°Г*Г*}
 readln
end.
а как удалить все елементи каторие встречаютса больше 1 гороза?
0
Puporev
Модератор
54221 / 41854 / 28923
Регистрация: 18.05.2008
Сообщений: 98,534
08.07.2011, 08:34 #19
как удалить все элементы, которые встречаются больше 1 раза?
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
uses crt;
var a:array[1..100] of integer;
    n,i,j,k,p,x:integer;
    f:boolean;
begin
clrscr;
randomize;
write('n=');readln(n);
writeln('Исходный массив:');
for i:=1 to n do
 begin
  a[i]:=random(10);
  write(a[i],' ');
 end;
writeln;
i:=1;
while i<n do
 begin
  f:=false;
  j:=i+1; //смотрим впереди
  while (j<=n)and not f do
  if a[j]=a[i] then  f:=true//если есть такой же, меняем флаг
  else j:=j+1; //иначе идем дальше
  if f then //если есть повторы
   begin
    x:=a[i];//запомним элемент
    p:=i;//и его текущую позицию
    while p<=n do //идем к концу
    if a[p]=x then //если такой же
     begin
      if p=n then n:=n-1 //если последний, убавляем размер массива
      else //иначе
       begin
        for k:=p to n-1 do //сдвигаем на него конец массива
        a[k]:=a[k+1];
        n:=n-1; //убавляем
       end
     end
    else p:=p+1;//если не такой, дальше
   end
  else i:=i+1;//если не удаляли, дальше
 end;
if n=0 then write('Все элементы более 1 раза, массив пустой')
else
 begin
  writeln('Более 1 раза удалены:');
  for i:=1 to n do
  write(a[i],' ');
 end;
readln
end.
5
lamed
297 / 297 / 150
Регистрация: 07.05.2011
Сообщений: 592
14.07.2011, 20:21 #20
Удаление элементов в одномерном несортированном массиве по условию (без сохранения порядка).
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
{ Сама задача. Алгоритмы. Введение в разработку и анализ. Ананий Левитин
Упражнения 1.4.1. Поясните, как можно реализовать каждую из перечисленных ниже 
операций над массивом так, чтобы время ее выполнения не зависело от
размера массива n. а) Удаление i-го элемента массива 1 <= i <= n). }
{ Усложненная модификация: удалить все элементы, которые делятся нацело на x }
{ PascalABC.NET. lamed, 14.07.2011 }
const
  MaxN = 30;
var
  a: array[1..MaxN] of integer;
  i, n: integer;
  x: integer;
  k: integer;
begin
  // Формирование одномерного массива
  randomize;
  n:=1+random(MaxN);
  for i:= 1 to n do
    a[i]:= random(MaxN+1);
    
  x:= 2+random(n-1);
  
  writeln('До обработки n=', n, '.');
  write('<');
  for i:= 1 to n do
    begin
      if i<>1 then write(',');
      write(a[i]);
    end;
  writeln('>');
 
  i:=1;
  k:= 0;
  while (i<=n) do
    begin
      while (i<=n) and (a[i] mod x=0) do
        begin // Если элемент требуется удалить
          a[i]:= a[n]; // Заменяем его последним использованным элементом массива
          // заменяющий элемент на следующем шаге тоже придется проверить
          dec(n); // уменьшаем счетчик числа используемых элементов
          inc(k); // увеличиваем счетчик удаленных элементов
        end;
      inc(i);
    end;
 
  writeln;
  writeln('n=', n, '. Удалено ', k, ' элементов, которые делятся на ', x, '.');
  write('<');
  for i:= 1 to n do
    begin
      if i<>1 then write(',');
      write(a[i]);
    end;
  writeln('>');
end.
Пример работы
Pascal
1
2
3
4
5
До обработки n=25.
<13,26,2,18,12,8,21,19,17,30,13,29,28,29,27,9,12,29,1,24,28,6,15,13,27>
 
n=23. Удалено 2 элементов, которые делятся на 14.
<13,26,2,18,12,8,21,19,17,30,13,29,27,29,27,9,12,29,1,24,13,6,15>
1
14.07.2011, 20:21
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
14.07.2011, 20:21

Операции с матрицами в Pascal
Здравствуйте!Помогите пожалуйста с написанием программы для следующей задачи:...

Арифметические операции над матрицами
Выполнив действия над матрицами A(n,n) и B(n,n) вычислить матрицу C(n,n) по...

Выполнить операции с квадратными матрицами
2. Выполнить операции (здесь A, B, C, D — квадратные матрицы порядка n)...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru