Форум программистов, компьютерный форум, киберфорум
Turbo Pascal
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль) > Turbo Pascal
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.60/5: Рейтинг темы: голосов - 5, средняя оценка - 4.60
0 / 0 / 2
Регистрация: 02.01.2014
Сообщений: 240
1

Сортировка матрицы простым выбором

27.03.2014, 23:22. Показов 971. Ответов 8
Метки нет (Все метки)
Author24 — интернет-сервис помощи студентам
Помогите с сортировкой матрици. Её надо отсортировать простым выбором (поиск мин. и на 1 место). Она не совсем работает так, как она один раз проходит рядок матрици, тоесть 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

program pr1;
uses crt,dos;
const n=10;
var a:array[1..n,1..n] of integer;
    i,j,min,m,p,z:integer;
    f:text;
begin
 
assign(f,'F:\1.txt');
reset(f);
for i:=1 to n do
for j:=1 to n do
read(f,a[i,j]);
close(f);
 
begin
j:=2;
z:=0;
m:=9;
repeat
min:=a[m,j];
for i:=10 downto i-z do
begin
if (a[i,j]<min) then
min:=a[i,j];
p:=a[m,j];
a[m,j]:=a[i,j];
end;
z:=z+1;
m:=m-1;
j:=j+1;
until j=11
end;
 
assign(f,'F:\2.txt');
rewrite(f);
for i:=1 to n do
 for j:=1 to n do
 begin
  write(f,a[i,j]:5);
  end;
  writeln(f,'');
close(f);
 
end.
Миниатюры
Сортировка матрицы простым выбором  
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 27.03.2014, 23:22
Ответы с готовыми решениями:

Сортировка простым выбором
Отсортировать четные элементы массива с помощью простого выбора. ВНИМАНИЕ!!! Входные данные...

Сортировка простым выбором
Сортировка простым выбором собственно. Доработайте пжл. var i,j,k,m,n:integer; a:array of...

Сортировка простым выбором
Помогите по фотографии пожалуйста,там блок схема-в ней сортировка простым выбором:

Сортировка простым выбором
Нужно сделать программу с помощью процедур и с помощью Case(пункты процедуры с параметром-массив). ...

8
0 / 0 / 2
Регистрация: 02.01.2014
Сообщений: 240
27.03.2014, 23:29  [ТС] 2
И вопрос наперёд, можно ли так изменять массив или надо через процедуру? Заранее спасибо.
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
28.03.2014, 09:33 3
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

uses crt;
const n=10;
var a:array[1..n,1..n] of integer;
    i,j,p,q,min,pmn,qmn,x:integer;
begin
clrscr;
randomize;
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=random(50);
    write(a[i,j]:3);
   end;
  writeln;
 end;
i:=1;
j:=n;
repeat
min:=a[i,j];
pmn:=i;
qmn:=j;
p:=i;
q:=j+1;
if (q>n)and(p<n) then
 begin
  p:=i+1;
  q:=n-p+1;
 end;
repeat
 if a[p,q]<min then
  begin
   min:=a[p,q];
   pmn:=p;
   qmn:=q
  end;
 q:=q+1;
 if (q>n)and(p<n) then
  begin
   p:=p+1;
   q:=n-p+1;
  end;
until (p=n)and(q>n);
 x:=a[i,j];
 a[i,j]:=a[pmn,qmn];
 a[pmn,qmn]:=x;
j:=j+1;
if j>n then
 begin
  i:=i+1;
  j:=n-i+1
 end;
until(i=n)and(j=n);
writeln;
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    if j>=n-i+1 then textcolor(12)
    else textcolor(15);
    write(a[i,j]:3);
   end;
  writeln
 end;
readln
end.
0
0 / 0 / 2
Регистрация: 02.01.2014
Сообщений: 240
28.03.2014, 09:44  [ТС] 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
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

program pr1;
uses crt,dos;
const n=10;
type mass=array[1..n,1..n] of integer;
var a:mass;
    i,j,min,m,p,z:integer;
    f:text;
 
procedure vvid(a:mass);
begin
assign(f,'F:\1.txt');
reset(f);
for i:=1 to n do
for j:=1 to n do
read(f,a[i,j]);
close(f);
end;
 
procedure obr(var a:mass);
var j,z,m:integer;
begin
j:=2;
z:=10;
m:=9;
repeat
 begin
  min:=a[m,j];
   begin
    repeat
     for i:=z to 10 do
      begin
       if (a[i,j]<min) then
        begin
         min:=a[i,j];
         p:=a[m,j];
         a[m,j]:=a[i,j];
        end;
      end;
      z:=z+1;
    until z<=10
   end;
 m:=m-1;
 z:=m;
 j:=j+1;
 end;
until j<=10
end;
 
procedure vyvid(a:mass);
begin
assign(f,'F:\2.txt');
rewrite(f);
for i:=1 to n do
 for j:=1 to n do
 begin
  write(f,a[i,j]:5);
  end;
  writeln(f,'');
close(f);
end;
 
begin
vvid(a);
obr(a);
vyvid(a);
end.
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
28.03.2014, 09:57 5
Цитата Сообщение от Mansu Посмотреть сообщение
помогите выправить ошибку.
Вам написали код, вот и смотрите что у вас неправильно в сортировке, а неправильно почти все.

Добавлено через 2 минуты
Сядьте и внимательно разберите перемещение по нужной части матрицы при определении первого элемента, у меня [i,j], и минимального, у меня [p,q].
0
0 / 0 / 2
Регистрация: 02.01.2014
Сообщений: 240
28.03.2014, 10:07  [ТС] 6
Вы написали программу которая, заполнит тот сектор от 0 до 00, а мне нужно чтоб оно расставила элементы рядка по возрастанию
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
28.03.2014, 10:29 7
А нафига Вы приложили эту картинку? Конецно я для этой области и написал программу. Ну а Ваша вообще ничего не сортирует.
Создал файл в программе, вывел результат, то же самое.
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

program pr1;
uses crt;
const n=10;
type mass=array[1..n,1..n] of integer;
 
procedure vvod(var f:text);
var i,j,a:integer;
begin
assign(f,'1.txt');
rewrite(f);
randomize;
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    a:=random(100);
    write(f,a:4);
   end;
  writeln(f,'')
 end;
close(f)
end;
procedure vvid(var f:text;var a:mass);
var i,j:integer;
begin
assign(f,'1.txt');
reset(f);
for i:=1 to n do
for j:=1 to n do
read(f,a[i,j]);
close(f);
end;
 
procedure obr(var a:mass);
var i,j,z,m,p,min:integer;
begin
j:=2;
z:=9;
m:=9;
repeat
begin
min:=a[m,j];
begin
repeat
for i:=z to 10 do
begin
if (a[i,j]<min) then
begin
min:=a[i,j];
p:=a[m,j];
a[m,j]:=a[i,j];
end;
end;
z:=z+1;
until z<=10
end;
m:=m-1;
z:=m;
j:=j+1;
end;
until j<=10
end;
 
procedure vyvid(var f:text;a:mass);
var i,j:integer;
begin
assign(f,'2.txt');
rewrite(f);
for i:=1 to n do
 begin
  for j:=1 to n do
  write(f,a[i,j]:4);
  writeln(f,'')
 end;
close(f);
end;
var a:mass;
i,j,min,m,p,z:integer;
f:text;
begin
vvod(f); //создание исходного файла
vvid(f,a);
obr(a);
vyvid(f,a);
end.
Исходный файл
Код
  12  78  42  64  83  63  26  22   6  41
  46  37  94  71  55  57  85  55  69  24
  76  43  39  85  34  82  69  20  31  52
  83  21  58  65  81  10  42  17  37  98
  65  93  46  23  49  96  98   5  85  44
  51  19  78  40  32  69  66  22  74   8
  32  44  90  59   7  58  26  98  37  70
  42  32  63  11  18  75  42  51   3  98
  96  29  15  16  78  85  83  26  86  15
   6  28  69  98  27  74  98  50  82  29
На выходе
Код
  12  78  42  64  83  63  26  22   6  41
  46  37  94  71  55  57  85  55  69  24
  76  43  39  85  34  82  69  20  31  52
  83  21  58  65  81  10  42  17  37  98
  65  93  46  23  49  96  98   5  85  44
  51  19  78  40  32  69  66  22  74   8
  32  44  90  59   7  58  26  98  37  70
  42  32  63  11  18  75  42  51   3  98
  96  28  15  16  78  85  83  26  86  15
   6  28  69  98  27  74  98  50  82  29
Добавлено через 8 минут
У меня несколько буковок изменить или убрать и будет для всей матрицы
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

uses crt;
const n=10;
var a:array[1..n,1..n] of integer;
    i,j,p,q,min,pmn,qmn,x:integer;
begin
clrscr;
randomize;
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=random(50);
    write(a[i,j]:3);
   end;
  writeln;
 end;
i:=1;
j:=1;
repeat
min:=a[i,j];
pmn:=i;
qmn:=j;
p:=i;
q:=j+1;
if (q>n)and(p<n) then
 begin
  p:=i+1;
  q:=1;
 end;
repeat
 if a[p,q]<min then
  begin
   min:=a[p,q];
   pmn:=p;
   qmn:=q
  end;
 q:=q+1;
 if (q>n)and(p<n) then
  begin
   p:=p+1;
   q:=1;
  end;
until (p=n)and(q>n);
x:=a[i,j];
a[i,j]:=a[pmn,qmn];
a[pmn,qmn]:=x;
j:=j+1;
if j>n then
 begin
  i:=i+1;
  j:=1
 end;
until(i=n)and(j=n);
writeln;
for i:=1 to n do
 begin
  for j:=1 to n do
  write(a[i,j]:3);
  writeln
 end;
readln
end.
0
0 / 0 / 2
Регистрация: 02.01.2014
Сообщений: 240
28.03.2014, 10:44  [ТС] 8
Вы не поняли. Мне всеравно надо подилить матрицу как на картинке.
Допустим матрица:
1 2 3 4 5 6
7 5 6 8 7 6
1 2 6 9 3 7
1 3 8 0 3 5
1 2 8 3 6 2
1 5 6 3 7 3
Программа должна сделать следующее:
1 2 3 4 5 6
7 5 6 8 6 7
1 2 6 3 7 9
1 3 0 3 5 8
1 2 2 3 6 8
1 3 3 5 6 7
0
Почетный модератор
64304 / 47599 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
28.03.2014, 11:06 9
Так моя первая программа это и делает только включает и побочную диагональ, переделай чуть, мне уже надоело.

Добавлено через 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
62
63
64
65
66
67

uses crt;
const n=10;
var a:array[1..n,1..n] of integer;
    i,j,p,q,min,pmn,qmn,x:integer;
begin
clrscr;
randomize;
writeln('Исходная матрица:');
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    a[i,j]:=random(50);
    write(a[i,j]:3);
   end;
  writeln;
 end;
i:=2;
j:=n;
repeat
min:=a[i,j];
pmn:=i;
qmn:=j;
p:=i;
q:=j+1;
if (q>n)and(p<n) then
 begin
  p:=i+1;
  q:=n-p+2;
 end;
repeat
 if a[p,q]<min then
  begin
   min:=a[p,q];
   pmn:=p;
   qmn:=q
  end;
 q:=q+1;
 if (q>n)and(p<n) then
  begin
   p:=p+1;
   q:=n-p+2;
  end;
until (p=n)and(q>n);
 x:=a[i,j];
 a[i,j]:=a[pmn,qmn];
 a[pmn,qmn]:=x;
j:=j+1;
if j>n then
 begin
  i:=i+1;
  j:=n-i+2
 end;
until(i=n)and(j=n);
writeln;
for i:=1 to n do
 begin
  for j:=1 to n do
   begin
    if j>n-i+1 then textcolor(12)
    else textcolor(15);
    write(a[i,j]:3);
   end;
  writeln
 end;
readln
end.
0
28.03.2014, 11:06
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 28.03.2014, 11:06
Помогаю со студенческими работами здесь

Сортировка простым выбором
uses crt; var mas:array of integer; i,b:integer; begin clrscr; randomize; for i:=1 to 20 do ...

Сортировка простым выбором - посчитать число обменов
Здравствуйте. Не могу понять как посчитать количество обменов при сортировке простым выбором:( Я...

Отсортировать массив простым выбором и методом простой перестановки
Отсортировать одномерный массив: 1) простым выбором; 2) методом простой перестановкой;

Внешняя сортировка простым слиянием
Реализовать программу, в которой выполняется алгоритм внешней сортировки простым слиянием: Дан...


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

Или воспользуйтесь поиском по форуму:
9
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru