Быстрая сортировка(Хоара) - Помощь студентам

Karl__ · 09.12.2013, 18:36

Turbo Pascal
Помогите написать процедуру с методом быстрой сортировки(Хоара) массива по условию: Дан массив C(N). Преобразовать массив, упорядочив первую его половину элементов по возрастанию, а вторую по убыванию.(Известно, что N-четное).
В сети нашла примеры, но не могу понять как управиться с моим условием, кто разбирается можете сделать.

Код:

Type
  arrType = Array[1 .. n] Of Integer;

Procedure HoarFirst(Var ar: arrType; n: integer);

  Procedure sort(m, l: Integer);
  Var i, j, x, w: Integer;
  Begin

    i := m; j := l;
    x := ar[(m+l) div 2];
    Repeat

      While ar[i] < x Do Inc(i);
      While ar[j] > x Do Dec(j);
      If i <= j Then Begin
        w := ar[i]; ar[i] := ar[j]; ar[j] := w;
        Inc(i); Dec(j)
      End

    Until i > j;
    If m < j Then Sort(m, j);
    If i < l Then Sort(i, l)

  End;

Begin
  sort(1, n)
End;

Karl__ · 09.12.2013, 18:56

Вот ещё лучше пример, ребята помогите только преобразовать. Как применить это всё?

Код:

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}

Karl__ · 09.12.2013, 20:22

Вот полный вариант моей программы, что-то пытались сделать, но имеются ошибки помогите исправить.

Код:

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,k: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.

Karl__ · 09.12.2013, 21:10

Нужна помощь, здесь кто-нибудь разбирается в сортировке?

GetMax · 09.12.2013, 21:10

А так не подойдет?

Код:

procedure quicksort1(var a: list; Lo,Hi: integer);

  procedure sort1(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 sort1(l,j);
    if i<r then sort1(i,r);
  end; {sort}

  procedure sort2(l, r : Integer);
  Var
    i, j, x,  y : Integer;
  Begin
     i:=l; j:=r; x:=a[random(r-l+1)+l];
    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 sort2(l,j);
    if i<r then sort2(i,r);
  End;

begin {quicksort};
  randomize; {нужно только если используется выборка случайного опорного элемента}
  sort1(Lo,Hi);
  Lo := 11;
  Hi := 20;
  Sort2(Lo, Hi)
end; {quicksort}

Код:

quickSort1(lst, 1, 10)

Karl__ · 09.12.2013, 21:19

Наверное я где-то что-то напутала с переменными, не работает можете проверить?

Код:

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 quicksort1(var a: T_Mas; Lo,Hi: integer);

  procedure sort1(l,r: integer);
  var
    i,j,x,y: integer;
  begin
    i:=l; j:=r; 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 sort1(l,j);
    if i<r then sort1(i,r);
  end; {sort}

  procedure sort2(l, r : Integer);
  Var
    i, j, x,  y : Integer;
  Begin
     i:=l; j:=r; 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 sort2(l,j);
    if i<r then sort2(i,r);
  End;

begin {quicksort};
  sort1(Lo,Hi);
  Lo := 11;
  Hi := 20;
  Sort2(Lo, Hi)
end; {quicksort}

Begin
	ClrScr;
	Count(Kol);
	Filling(Kol, Mas);
	WriteLn('Исходный массив'); Print (Kol, Mas);
	quickSort1(Mas, 1, 10);
	WriteLn;
	WriteLn('Отсортированный массив'); Print (Kol, Mas);
	Repeat until KeyPressed
End.

Всё запускается!

Karl__ · 09.12.2013, 21:21

Я подправила, теперь запускается, но не правильно сортирует выводит

Karl__ · 09.12.2013, 21:39

Мне же нужно чтобы массив изначально делился на две части и первая половина сортировалась по возрастанию, а вторая по убыванию.

GetMax · 10.12.2013, 10:29

Код:

Const
  max = 20;
Type
  List = array[1..max] of Integer;
Var
  lst : List;
  i : Integer;

procedure quicksort1(var a: list; Lo,Hi, Lo1, Hi1: integer);

  procedure sort1(l1, r1, l2, r2: integer);
  var
    i,j,x,y: integer;
  begin
    {сортировка по возрастанию}
    i:=l1; j:=r1; x:=a[random(r1-l1+1)+l1]; 
    repeat
      while a[i]<x do i:=i+1; 
      while x<a[j] do j:=j-1;
      if i<=j then
      begin
        if a[i] > a[j] then
        begin
          y:=a[i]; a[i]:=a[j]; a[j]:=y;
        end;
        i:=i+1; j:=j-1;
      end;
    until i>=j;
    if l1<j then sort1(l1,j, l2, r2);
    if i<r1 then sort1(i,r1, l2, r2);
   
  {сортировка по убыванию}
   i:=l2; j:=r2; x:=a[random(r2-l2+1)+l2];
   repeat
      while a[i]>x do i:=i+1; 
      while x>a[j] do j:=j-1;
      if i<=j then
      begin
        if a[i] < a[j] then 
        begin
          y:=a[i]; a[i]:=a[j]; a[j]:=y;
        end;
        i:=i+1; j:=j-1;
      end;
   until i>=j;
   if l2<j then sort1(l1, r1, l2,j);
   if i<r2 then sort1(l1, r1, i,r2);
  end;

begin {quicksort1};
  randomize;
  sort1(Lo,Hi,Lo1,Hi1);
end; {quicksort1}

begin
  try
    Randomize;
    for I := 1 to max do
    Begin
      lst[i] := Random(20);
      Write(lst[i] : 3)
    End;
    Writeln;
    quickSort1(lst,1,max div 2, max div 2 + 1, max);
    for I := 1 to max do Write(lst[i] : 3);
    Readln
End.

Karl__ · 10.12.2013, 19:45

спасибо вам большое, но понимаете мне нужно, чтобы массив передавался, а не определялся рандомно в самой процедуре, так как мне нужно добавить будет ещё одну процедуру сортировки этого же массива.

09.12.2013, 18:36	#1
Karl__ Пользователь Регистрация: 01.12.2013 Сообщений: 40	Быстрая сортировка(Хоара) Turbo Pascal Помогите написать процедуру с методом быстрой сортировки(Хоара) массива по условию: Дан массив C(N). Преобразовать массив, упорядочив первую его половину элементов по возрастанию, а вторую по убыванию.(Известно, что N-четное). В сети нашла примеры, но не могу понять как управиться с моим условием, кто разбирается можете сделать. Код: `Type arrType = Array[1 .. n] Of Integer; Procedure HoarFirst(Var ar: arrType; n: integer); Procedure sort(m, l: Integer); Var i, j, x, w: Integer; Begin i := m; j := l; x := ar[(m+l) div 2]; Repeat While ar[i] < x Do Inc(i); While ar[j] > x Do Dec(j); If i <= j Then Begin w := ar[i]; ar[i] := ar[j]; ar[j] := w; Inc(i); Dec(j) End Until i > j; If m < j Then Sort(m, j); If i < l Then Sort(i, l) End; Begin sort(1, n) End;`

10.12.2013, 19:45	#10
Karl__ Пользователь Регистрация: 01.12.2013 Сообщений: 40	спасибо вам большое, но понимаете мне нужно, чтобы массив передавался, а не определялся рандомно в самой процедуре, так как мне нужно добавить будет ещё одну процедуру сортировки этого же массива. Последний раз редактировалось Karl__; 10.12.2013 в 20:05.

Похожие темы
Тема	Автор	Раздел	Ответов	Последнее сообщение
Быстрая сортировка(сортировка Хоара). Сортировка фрагмента массива [C++]	druger	Помощь студентам	0	20.04.2012 15:49
Сортировка двумерного массива по столбцам методом быстрой сортировки( Хоара) и пирамидальной.	tworc22	Помощь студентам	3	28.10.2011 23:05
Сортировка Хоара(для объектов класса)	m9yt	Общие вопросы C/C++	0	02.06.2010 18:45
быстрая сортировка настолько быстрая	Serg12	Помощь студентам	8	28.03.2010 21:31
сортировка массива Методом Хоара (быстрой сортировкой)	wild-weight	Паскаль, Turbo Pascal, PascalABC.NET	3	26.09.2009 16:46

09.12.2013, 21:10	#4
Karl__ Пользователь Регистрация: 01.12.2013 Сообщений: 40	Нужна помощь, здесь кто-нибудь разбирается в сортировке?

09.12.2013, 21:39	#8
Karl__ Пользователь Регистрация: 01.12.2013 Сообщений: 40	Мне же нужно чтобы массив изначально делился на две части и первая половина сортировалась по возрастанию, а вторая по убыванию.