Алгоритм частичной сортировки

[mehanizator]

А вот задачка вдогонку к предыдущей проблеме. Там нужно отсортировать массив для того, чтобы потом усреднить первую и вторую половины. Понятно, что полностью сортировать массив для этого - лишнее. Нужно только поделить его на две равные части, где в первой части все элементы больше (либо равны) элементов второй. Какой можно придумать алгоритм для такого разделения? Размер массива порядка 1000.

 

[kaprizka]

Боюсь, что твоя задача окажется по сложности ничуть не проще, чем сама сортировка. А сортировка - это
что-то вроде подпрограммы

{sortirovka massiva nomerov zajavok po ubyvaniju ocenki}
PROCEDURE qsort(psmnz: pai; imin, imax; poc: pai);
  var i,itest,nzt: integer;
  begin
    if (imin>=imax) then quit;
    itest:=imax;
    for i:=imin to itest do
    begin
      if (poc^[psmnz^[i]]<poc^[psmnz^[itest]])
      or ((poc^[psmnz^[i]]=poc^[psmnz^[itest]])
        and (tg^[psmnz^[i]]>tg^[psmnz^[itest]])) then
      begin nzt:=psmnz^[i]; psmnz^[i]:=psmnz^[itest]; psmnz^[itest]:=nzt;
        dec(itest);
      end;
    end;
    qsort(psnmz, imin, itest-1, poc);
    qsort(psnmz, itest+1, imax, poc);
  end;

 

[kaprizka]

(убрал подпрограмму, потомучто она какая-то не такая)

 

[kaprizka]

{ А вот задачка вдогонку к предыдущей проблеме. Там нужно отсортировать массив
 для того, чтобы потом усреднить первую и вторую половины. Понятно, что
 полностью сортировать массив для этого - лишнее. Нужно только поделить его
 на две равные части, где в первой части все элементы больше (либо равны)
 элементов второй. Какой можно придумать алгоритм для такого разделения?
 Размер массива порядка 1000.
v0.01
- ne poluchilosj, sortirovka nevernaja
v0.02 (12/02/2011)
* меняю программу полностью
}
{$N+}
USES crt;
CONST dlina=18;
TYPE ardod = array[1..dlina] of double;
 fundd = FUNCTION(x:double):double;
VAR m: ardod; {сортируемый массив}
  i,j: integer; {индексы для проверок}
  m1,m2: double; {для проверки: минимум больших и максимум маленьких}
{функция, по значению которой пойдёт сортировка}
FUNCTION fu(x:double):double; far;
begin
  fu:=x; {вырожденный случай: f(x)=x}
end;
{функция частичной сортировки, ради которой сыр-бор}
PROCEDURE partsort(var m:ardod; f: fundd; imin,imax,ihalf: integer);
var ig,i: integer; {индекс границы, индекс цикла}
  elsr: double; {элемент сравнения, тип как у функции f}
  t: double; {промежуточная переменная, тип как у элемента массива}
  cv: integer; {цвет для отладки}
begin
  {всё большое сдвигаем влево за границу ig, маленькое оставляем}
  ig:=imin; elsr:=f(m[imin]);
  for i:=imin+1 to imax do
  begin
    if (f(m[i])>f(m[ig])) then
    begin
      t:=m[i]; m[i]:=m[ig]; m[ig]:=t; inc(ig);
    end;
  end;

  {отладочный фрагмент: вывод массива на экран}
  for j:=1 to dlina do
  begin
    if (j>=imin) and (j<=imax) then cv:=4 else cv:=6;
    if (j<=ihalf) then inc(cv); textcolor(cv);
    write(m[j]:4:1);
  end;
  textcolor(7); writeln;
  {конец отладочного фрагмента}

  {рекурсия, в принципе можно заменить циклом}
  if (ig>ihalf) then partsort(m,f,imin,ig,ihalf) else
  if (ig<ihalf) then partsort(m,f,ig+1,imax,ihalf);
  {а если ig=ihalf, то частичная сортировка окончена}
end;
BEGIN
  {заполним массив случайными значениями}
  for i:=1 to dlina do m[i]:=random*10;

  {алгоритм частичной сортировки}
  partsort(m,fu,1,dlina, dlina div 2);

  {проверка минимума первой половины и максимума второй}
  m1:=m[1];
  for i:=2 to (dlina div 2) do
    if (m[i]<m1) then m1:=m[i];
  m2:=m[(dlina div 2)+1];
  for i:=(dlina div 2)+2 to dlina do
    if (m[i]>m2) then m2:=m[i];
  writeln('минимум больших =',m1:1:8,'; максимум маленьких =',m2:1:8);

END.

Скриншот результата работы программы с массивом размера сначала 18 (не 1000, чтоб на экран вывод влез) и чуть-чуть экранного мусора - остаток от предыдущих значений (20 и больше):

PS. Замечу, что полная сортировка выполняется медленнее, но имеет более короткий текст подпрограммы. Экономия достигается за счёт отсутствия необходимости отслеживать именно половину массива: всё равно потом всё в рекурсии отсортируется.