Показать сообщение отдельно
Старый 09.12.2013, 23:02   #1 (permalink)
Cassan
Member
 
Регистрация: 09.12.2013
Сообщений: 18
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 10
Exclamation Сортировка Turbo Pascal

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

Код:
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(kol,l,r: integer);
  var
    i,j,x,y,k: integer;
begin
k:= Kol div 2;
for i:=1 to k-1 do
  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;
  end; {sort}

  procedure sort2(kol,l, r : Integer);
  Var
    i, j, x, y, k: Integer;
begin
k:= Kol div 2;
for i:=1 to k-1 do
  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;
  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.
Cassan вне форума   Ответить с цитированием
Ads

Яндекс

Member
 
Регистрация: 31.10.2006
Сообщений: 40200
Записей в дневнике: 0
Сказал(а) спасибо: 0
Поблагодарили 0 раз(а) в 0 сообщениях
Репутация: 55070