Форум программистов, компьютерный форум, киберфорум
Наши страницы

Turbo Pascal

Войти
Регистрация
Восстановить пароль
 
Рейтинг: Рейтинг темы: голосов - 12, средняя оценка - 4.92
Ronnie_
4 / 4 / 0
Регистрация: 10.10.2013
Сообщений: 91
#1

Сортировка пузырьком и улучшенным методом быстрая(хоара) - Turbo Pascal

18.11.2013, 22:14. Просмотров 1739. Ответов 4
Метки нет (Все метки)

Помогите пожалуйста, для меня очень сложная тема.
Необходимо сделать процедуры с двумя видами сортировок массива.
1)пузырьком
2)улучшенная - быстрая(Хоара)

Задание такое:
Дан массив C(N). Преобразовать массив, упорядочив первую его половину элементов по возрастанию, а вторую по убыванию.(Известно, что N-четное).
Как это оформить? Знаю, что должен быть цикл от 0 до n/2(по возрастанию) и n/2+1 до n(по убыванию)
Есть основа, процедура определения размерности, процедуры ввода массива и вывода и должны быть две процедуры сортировок, программа должна выводить исходные массивы и отсортированные, вот только если два вида сортировок, то скорее всего нужно сделать копию процедуры ввода массива, так как последующая сортировка не должна отсортировывать уже отсортированный раннее массив. Или как правильно? И ещё если будет возможность добавить в каждую процедуру сортировки счётчик итераций(нужно для определения временной сложности).

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;
Const       N = 50;
Type        T_Mas = Array [1..N] of Integer;
Var     Mas : T_Mas;
        Kol : Integer;
 
                
Procedure Count (Var Kol:Integer);
{Процедура определения размерности массива}
Var     IOR : Word;
Begin
Write('Введите размерность массива: ');
    Repeat
        {$I-} ReadLn(Kol); {$I+}
        IOR := IOResult;
        If (IOR <> 0) or (Kol>N) Then
            WriteLn('Ошибка. Повторите ввод.')
    Until (Kol<=N) and (IOR=0)
End;
 
 
Procedure Filling (Kol:Integer; Var A: T_Mas);
{Процедура заполнения массива}
Var I : Integer;
Begin
    Randomize;
    For I := 1 To Kol Do A[I] := Random(N)
End;
 
 
Procedure Print (Kol:Integer; A: T_Mas);
{Процедура вывода массива}
Var I : Integer;
Begin
    For I:=1 to Kol do Write (A[I], ' ')
End;
 
 
Procedure Sort_Metod_ (Kol:Integer; Var X: T_Mas);
....
 
Begin
    ClrScr;
    Count(Kol);
    Filling(Kol, Mas);
    WriteLn('Исходный массив'); Print (Kol, Mas);
    Sort_Metod_ (Kol, Mas);
    WriteLn;
    WriteLn('Отсортированный массив'); Print (Kol, Mas);
    Repeat until KeyPressed
End.
0
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
18.11.2013, 22:14
Здравствуйте! Я подобрал для вас темы с ответами на вопрос Сортировка пузырьком и улучшенным методом быстрая(хоара) (Turbo Pascal):

Сортировка методом Хоара - Turbo Pascal
Здравствуйте , прошу помочь разобраться с сортировкой хоара. вот код из книги ( а не из инета с характерными опечатками в коде , из-за ...

Быстрая сортировка Хоара - Pascal
Пом-гите решить, заранее благодарен Билет 4 1 Быстрая сортировка Хоара.

Блок схема.Сортировка «Пузырьком», Сортировка методом «Последовательных перестановок», Сортировка «Вставками» - Pascal
Помогите, нужны блок схемы Сортировка «Вставками» Program Vstavka; uses dos; Type mass=array of integer; Var i,b,n,j,a:...

Сортировка методом Хоара, исправить ошибку (переполнение стека, бесконечный цикл) - Pascal
Сортировка методом Хоара. Нужно первую четверть рассортировать по убыванию, а всё остальное - по возрастанию. Сделал две процедуры...

Сортировка Хоара - Turbo Pascal
Доброго времени суток! Будтьте добра, помогите найти ошибку procedure hoar(l,m:integer); var i,j,r:integer; begin r:=graf; ...

Сортировка Хоара - Turbo Pascal
Uses crt; type mas=array of integer; const n=10; var m:mas; i:integer; procedure quicks(first,last:integer;var...

4
Basill
40 / 40 / 13
Регистрация: 16.02.2013
Сообщений: 197
18.11.2013, 23:08 #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
program mas;
uses crt;
var X:array[1..100] of integer;
    i,j,n,m,t,t1,k:integer;
begin
    clrscr;
    write('vvedite kolichestvo elementov massiva n=');
    readln(n);
    writeln('vvedite elementi massiva');
    for i:=1 to n do
       begin
       write('X[',i,']=');
       readln(X[i]);
       end;
 
    write('vvedite zadannoe chislo m = ');
    readln(m);
 
//==============================================================================
                   //Сортировка по возрастанию
                   for i:=1 to m do
                     for j:=1 to m-i do
                       if X[j]>X[j+1] then
                       begin
                       t:=X[j];
                       X[j]:=X[j+1];
                       X[j+1]:=t;
                       end;
//==============================================================================
                    //Сортировка по убыванию
                   for i:=m+1 to n do
                     for j:=m+1 to n+i do
                     if X[j]<X[j+1] then
                       begin
                       t1:=X[j];
                       X[j]:=X[j+1];
                       X[j+1]:=t1;
                       end;
//==============================================================================
 //Вывод Результирующего массива
  Writeln('Rezultiruyushiy massiv: ');
  for i := 1 to m do
    Write(X[i], ' ');
  for k := m+1 to n do
    Write(X[k], ' ');
readln;
end.
1
Ronnie_
4 / 4 / 0
Регистрация: 10.10.2013
Сообщений: 91
19.11.2013, 19:07  [ТС] #3
Спасибо конечно, но мне нужно процедурами и две, вот уже мучаюсь ничего не получается!

Добавлено через 19 часов 53 минуты
Сложное задание, никто не поможет?
0
Ronnie_
4 / 4 / 0
Регистрация: 10.10.2013
Сообщений: 91
08.12.2013, 18:01  [ТС] #4
Как сделать из программы которую выложили процедуру, подогнать под моё задание и вставить в программу у меня лично проблемы с переменными.

Добавлено через 4 часа 21 минуту
Вот я набросал, это метод выбора, но правда ошибки, как правильно?
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
Uses Crt;
Const       N = 50;
Type        T_Mas = Array [1..N] of Integer;
Var     Mas : T_Mas;
        Kol : Integer;
 
                
Procedure Count (Var Kol:Integer);
{Процедура определения размерности массива}
Var     IOR : Word;
Begin
Write('Введите размерность массива: ');
    Repeat
        {$I-} ReadLn(Kol); {$I+}
        IOR := IOResult;
        If odd(IOR) or (Kol>N) Then
            WriteLn('Ошибка. Повторите ввод.')
    Until (Kol<=N) and (IOR=0)
End;
 
 
Procedure Filling (Kol:Integer; Var A: T_Mas);
{Процедура заполнения массива}
Var I : Integer;
Begin
    Randomize;
    For I := 1 To Kol Do A[I] := Random(N)
End;
 
 
Procedure Print (Kol:Integer; A: T_Mas);
{Процедура вывода массива}
Var I : Integer;
Begin
    For I:=1 to Kol do Write (A[I], ' ')
End;
 
Procedure Vibor (var X:T_Mas);
var k,i,j,x,buf:byte;
k:=X div 2;
{сортировка выбором по возрастанию первой половины}
for i:=1 to k-1 do
  begin
    x:=i;
    for j:=i+1 to k do
    if a[j]<a[x] then x:=j;
    buf:=a[i];
    a[i]:=a[x];
    a[x]:=buf;
  end;
{сортировка выбором по убыванию второй половины}
for i:=k+1 to n-1 do
  begin
    x:=i;
    for j:=i+1 to n do
    if a[j]>a[x] then x:=j;
    buf:=a[i];
    a[i]:=a[x];
    a[x]:=buf;
  end;
 
Begin
    ClrScr;
    Count(Kol);
    Filling(Kol, Mas);
    WriteLn('Исходный массив'); Print (Kol, Mas);
    Vibor (Mas);
    WriteLn;
    WriteLn('Отсортированный массив'); Print (Kol, Mas);
    Repeat until KeyPressed
End.
0
Ronnie_
4 / 4 / 0
Регистрация: 10.10.2013
Сообщений: 91
09.12.2013, 20:46  [ТС] #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
const max=20; { можно и больше... }
type
  list = array[1..max] of integer;
 
procedure quicksort(var a: list; Lo,Hi: integer);
 
  procedure sort(l,r: integer);
  var
    i,j,x,y: integer;
  begin
    i:=l; j:=r; x:=a[random(r-l+1)+l]; { x := a[(r+l) div 2]; - для выбора среднего элемента }
    repeat
      while a[i]<x do i:=i+1; { a[i] > x  - сортировка по убыванию}
      while x<a[j] do j:=j-1; { x > a[j]  - сортировка по убыванию}
      if i<=j then
      begin
        if a[i] > a[j] then {это условие можно убрать} {a[i] < a[j] при сортировке по убыванию}
        begin
          y:=a[i]; a[i]:=a[j]; a[j]:=y;
        end;
        i:=i+1; j:=j-1;
      end;
    until i>=j;
    if l<j then sort(l,j);
    if i<r then sort(i,r);
  end; {sort}
 
begin {quicksort};
  randomize; {нужно только если используется выборка случайного опорного элемента}
  sort(Lo,Hi)
end; {quicksort}
Добавлено через 1 час 17 минут
Может как-то так? Не знаю проверьте...
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
procedure quicks(kol,first,last:integer; var a:T_mas);
var i,j,c,x,n:integer;
begin
k:= Kol div 2;
  i:=first;
  j:=last;
  x:=k;
for i:=1 to k-1 do
begin
  x:=a[(first+last) div 2]; {выбираем серединный эл-нт массива и делим массив пополам}
  repeat
    while a[i]>x do i:=i+1; {считываем всю левую часть до этого элемента}
    while x>a[j] do j:=j-1; {считываем всю правую часть до этого элемента}
    if i<=j then
     begin
       c:=a[i]; {Сортируем элементы массива}
       a[i]:=a[j];
       a[j]:=c;
       i:=i+1;
       j:=i-1;
     end;
   until i>j;
end;
 
for i:=k+1 to Kol-1 do
begin
  x:=a[(first+last) div 2]; {выбираем серединный эл-нт массива и делим массив пополам}
  repeat
    while a[i]<x do i:=i+1; {считываем всю левую часть до этого элемента}
    while x<a[j] do j:=j-1; {считываем всю правую часть до этого элемента}
    if i<=j then
     begin
       c:=a[i]; {Сортируем элементы массива}
       a[i]:=a[j];
       a[j]:=c;
       i:=i+1;
       j:=i-1;
     end;
   until i>j;
end;
   if first<j then quicks(first,j,m);
   if i<last then quicks(i,last,m);
  end;
Добавлено через 17 минут
Вставил в программу, но не работает, в чём проблема? Помогите пожалуйста.
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
Uses Crt;
Const       N = 50;
Type        T_Mas = Array [1..N] of Integer;
Var     Mas : T_Mas;
        Kol : Integer;
 
                
Procedure Count (Var Kol:Integer);
{Процедура определения размерности массива}
Var     IOR : Word;
Begin
Write('Введите размерность массива: ');
    Repeat
        {$I-} ReadLn(Kol); {$I+}
        IOR := IOResult;
        If odd(IOR) or (Kol>N) Then
            WriteLn('Ошибка. Повторите ввод.')
    Until (Kol<=N) and (IOR=0)
End;
 
 
Procedure Filling (Kol:Integer; Var A: T_Mas);
{Процедура заполнения массива}
Var I : Integer;
Begin
    Randomize;
    For I := 1 To Kol Do A[I] := Random(N)
End;
 
 
Procedure Print (Kol:Integer; A: T_Mas);
{Процедура вывода массива}
Var I : Integer;
Begin
    For I:=1 to Kol do Write (A[I], ' ')
End;
 
procedure quicks(kol,first,last:integer; var a:T_mas);
var i,j,c,x,n:integer;
begin
k:= Kol div 2;
 i:=first;
 j:=last;
  x:=k;
for i:=1 to k-1 do
begin
 x:=a[(first+last) div 2]; {выбираем серединный эл-нт массива и делим массив пополам}
 repeat
while a[i]>x do i:=i+1; {считываем всю левую часть до этого элемента}
 while x>a[j] do j:=j-1; {считываем всю правую часть до этого элемента}
if i<=j then
begin
c:=a[i]; {Сортируем элементы массива}
a[i]:=a[j];
a[j]:=c;
i:=i+1;
j:=i-1;
end;
until i>j;
end;
 
for i:=k+1 to Kol-1 do
begin
 x:=a[(first+last) div 2]; {выбираем серединный эл-нт массива и делим массив пополам}
 repeat
 while a[i]<x do i:=i+1; {считываем всю левую часть до этого элемента}
 while x<a[j] do j:=j-1; {считываем всю правую часть до этого элемента}
 if i<=j then
begin
c:=a[i]; {Сортируем элементы массива}
a[i]:=a[j];
a[j]:=c;
i:=i+1;
j:=i-1;
end;
until i>j;
end;
if first<j then quicks(first,j,a);
if i<last then quicks(i,last,a);
end;
 
Begin
    ClrScr;
    Count(Kol);
    Filling(Kol, Mas);
    WriteLn('Исходный массив'); Print (Kol, Mas);
    quicks (Kol,first,last,Mas);
    WriteLn;
    WriteLn('Отсортированный массив'); Print (Kol, Mas);
    Repeat until KeyPressed
End.
Добавлено через 5 минут
Проблема здесь, несоответствие типа, что делать.
Pascal
1
2
if first<j then quicks(first,j,a);
if i<last then quicks(i,last,a);
0
09.12.2013, 20:46
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
09.12.2013, 20:46
Привет! Вот еще темы с ответами:

Отсортировать масив А(10) методом Хоара. - Turbo Pascal
1) Отсортировать масив А(10) методом Хоара. 2) Заполнить квадратную матрицу по спирали...

Сортировка Шелла, Хоара - Pascal
Добрый день отцы программирования! Нужна ваша помощь в следующей задаче. Необходимо написать следующую программу с использованием...

Быстрая сортировка, ситуация, при которой сортировка работает не корректно - Turbo Pascal
Procedure sort(m, l: Integer); Var i, j, x, w: Integer; Begin i := m; j := l; x := ar; Repeat While...

Создать массив и упорядочить его методом Хоара - Turbo Pascal
создать одномерный массив и упорядочить его методом Хоара по возрастанию.


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

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

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