654 / 352 / 113
Регистрация: 11.12.2009
Сообщений: 508
1

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

29.05.2010, 11:10. Показов 194079. Ответов 36

Студворк — интернет-сервис помощи студентам
-------------------------------------------------------------------------------------------
Содержание:
  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
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
29.05.2010, 11:10
Ответы с готовыми решениями:

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

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

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

Стандартные мат. операции с двумерными массивами
Возможно ли вычитание и другие стандартные мат. операции с двумерными массивами как с векторами?...

36
4341 / 1473 / 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
773 / 578 / 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.
19
654 / 352 / 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
Почетный модератор
64291 / 47589 / 32740
Регистрация: 18.05.2008
Сообщений: 115,181
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
654 / 352 / 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
654 / 352 / 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
654 / 352 / 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
Почетный модератор
64291 / 47589 / 32740
Регистрация: 18.05.2008
Сообщений: 115,181
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.
9
нэ
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
Эксперт по компьютерным сетямЭксперт Pascal/Delphi
4188 / 1289 / 237
Регистрация: 27.07.2009
Сообщений: 3,961
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
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
Почетный модератор
64291 / 47589 / 32740
Регистрация: 18.05.2008
Сообщений: 115,181
05.03.2011, 16:03 13
Pascal
1
random(-101, 101)
;
Вроде так не бывает...
обычно random(203)-101;
0
37 / 32 / 9
Регистрация: 04.03.2011
Сообщений: 120
05.03.2011, 16:19 14
В abc.net такая конструкция, допустима Но в этом топике надо писать обобщенно, согласен.

Наверно вечерком закину для двумерного)
0
Почетный модератор
64291 / 47589 / 32740
Регистрация: 18.05.2008
Сообщений: 115,181
05.03.2011, 16:54 15
В abc.net такая конструкция, допустима
Здесь наверное ты один в этом пишешь, придерживайся общих правил Паскаля.
0
S9
Волшебник
656 / 259 / 88
Регистрация: 18.12.2010
Сообщений: 545
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.
Изображения
  
Вложения
Тип файла: rar Solution1.rar (26.2 Кб, 107 просмотров)
Тип файла: rar Solution2.rar (14.1 Кб, 77 просмотров)
6
Incred
22.06.2011, 15:44 17
может кто-нибудь организует все операции в процедуры? как вот здесь:
Сортировки

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

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

да. я новичёк. учусь.
4 / 4 / 1
Регистрация: 23.03.2011
Сообщений: 69
07.07.2011, 23:06 18
Цитата Сообщение от Unrealler Посмотреть сообщение
9) Удаление элемента в одномерном массиве
Пусть нужно удалить все нулевые элементы из введенного пользователем массива.
а как удалить все елементи каторие встречаютса больше 1 гороза?
0
Почетный модератор
64291 / 47589 / 32740
Регистрация: 18.05.2008
Сообщений: 115,181
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
298 / 298 / 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
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
14.07.2011, 20:21
Помогаю со студенческими работами здесь

Класс: Разработать класс для работы с матрицами(операции над матрицами)...
Добрый вечер, хочу попросить о помощи с отловом проблемы. Сама задача: разработать класс для...

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

Работа с массивами и матрицами
1.Реализуйте проект «Массив». Кнопка «Заполнить» формирует массив из десяти случайных целых чисел в...

Как работать с массивами и матрицами?
Как работать с массивами и матрицами?


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

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

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2023, CyberForum.ru