Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.10.2009, 23:33   #1
Карол
Пользователь
 
Регистрация: 28.10.2008
Сообщений: 25
По умолчанию помогите исправить код

Вообщем рпоблнма следующая: есть задание отсортировать массив методом линейного выбора и методом быстрой сортировки, так вот метод быстрой сортировки работает неправельно, он недоотсортировывает массив до конца, а я не могу разобраться почему, помогите пожалуйста

Код:
program Project_Sort;
 uses Crt;
const
  max=10000;
type
  TMassivInt=array [1..max] of integer;
var
  massiv: TMassivInt;
  massiv2: TMassivInt;
  key: byte;
  x:integer;
  zap,n:integer;
  i,r,l: integer;


Procedure Show(var massiv: TMassivInt; n:integer);
var
  i: integer;
begin
  write ('Prosmotr massiva: ');
  for i := 1 to n do
  begin
  Write (massiv[i],' ');
  end;
  writeln;
end;


Procedure Create(var massiv: TMassivInt; n:integer);
var
  i: integer;
begin
  writeln ('Sozdat massiv');
  write ('Zadat chislo elementov v massive: ');
  readln (n);
  Randomize;
  for i := 1 to n do massiv[i]:=random (100);
  writeln ('OK, massiv sozdan!');
  Show(massiv, n);
end;

procedure printtab(var massiv: TmassivInt; n,i,min:integer);
var  k,j: integer;
begin
     for k:=1 to n do
     begin
          if  k=i then textattr:=red*16+white
          else
               if k=min then textattr:=blue*16+white
                        else textattr:=black*16+white;
                        write (massiv[k]);
                        textattr:=black*16+white;
                        write('  ');
      end;
      writeln;
end;

procedure Sort(var massiv: TMassivInt; n:integer );
var
  i, j, temp, min:integer;
begin
writeln ('Sortirovka massiva');
writeln('VVesti chislo elementov massiva');
readln(n);
  for i:=1 to n-1 do
    begin
        min := i;
        for j:=i+1 to n do
             if massiv[j]<massiv[min] then
             min := j;
             if min<>i then   begin
             printtab(massiv,n,i,min);
             temp := massiv[min];
             massiv[min] :=massiv[i];
             massiv[i] := temp;
             End;
    end;    Show(massiv, n);
 end;

Procedure BSORT(Var massiv:TMassivInt; l,r:integer);
 Var i,j,min:integer; pr:boolean;
  begin
        i:=l; j:=r; pr:=true;
        while (i<j) do
        Begin
             min:=i;
             if (massiv[i]>massiv[j]) then
             Begin
                  min:=j;
                  if min<>i then
                       printtab (massiv,n,i,min);
                  zap:=massiv[i];
                  massiv[i]:=massiv[j];
                  massiv[j]:=zap;
                  pr:=false;
             end;
        if pr then j:=j-1 else i:=i+1;
        End;
   end;


BEGIN

 Writeln ('===================');
 Writeln ('Menu');
 Writeln ('===================');
 Writeln ('1: Sozdat massiv');
 Writeln ('2: Prosmotr massiva');
 Writeln ('3: Sortirovka massiva metodom lineinogo vubora');
 Writeln ('4: bustraya sortirovka massiva');
 Writeln ('0: Exit');
 Writeln ('===================');
 Repeat

 Write('Vibrat kommandu: ');
 Readln (key);

 case key of
    1: Create (massiv, x);
    2: begin
       writeln ('Prosmotr massiva');
       writeln ('Vvesti chislo elementov v massive: ');
       readln (x);
       Show (massiv, x);
       end;

    3: Sort (massiv,x);
    4: begin
    Write('Vvedite kol-vo elementov massiva:  ');
     read(n);
     i:=0; l:=1; r:=n;
     while i<n do
      begin
       if(i-1)>l then begin
       BSORT(massiv,l,i);
       end;

       if(i+1)<r then begin
       BSORT(massiv,i+1,r);
       end;
       i:=i+1;
      end;
      Show(massiv,n);

  end;
  end;
 until key=0;
end.
Карол вне форума Ответить с цитированием
Старый 29.10.2009, 09:09   #2
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Проверил - сортирует нормально.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 29.10.2009, 16:47   #3
Карол
Пользователь
 
Регистрация: 28.10.2008
Сообщений: 25
По умолчанию

процедура Sort правельно сортирует, а вот BSort недосортировывает, особенно если запустить 2 раза подряд
Карол вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите исправить код Screame Microsoft Office Excel 2 12.07.2009 10:56
Помогите исправить код lider24816 Помощь студентам 2 24.05.2009 18:12
Помогите исправить код Grizzzli Помощь студентам 3 14.12.2008 19:26
Помогите исправить код Tanuska___:) БД в Delphi 4 07.08.2008 17:40
Помогите исправить код student_63 Помощь студентам 5 13.12.2007 18:20