Недавно, на одном из форумов, студент обратился за помощью для решения одной из тестовых задач - не за кодом, а именно за помощью в части идей ее решения.
Задачка простая:
- есть/создается массив random-целых (integer 32b) чисел;
- требуется отсортировать массив на месте или вывести на консоль по следующим правилам:
-- массив должен быть отсортирован так, чтобы слева от "центра" массива находились бы все четные числа по убыванию от начала к "центру", а справа - все нечетные по возрастанию от "центра" к концу массива.

( в кавычки взят "центр", поскольку центрирование случайных чисел - случайно ).

Пример (тест):
rnd= 19 [40,14,17,46,12,53,3,49,26,56,10,28,59,20,35,42,42,18,24]
sort=19 [56,46,42,42,40,28,26,24,20,18,14,12,10,3,17,35,49,53,59]

Требования: простота, изящность, самодокументируемость кода для понимания студентами.
Реализация планировалась на тех или иных разновидностях Pascal/Delphi/FreePascal/Lazarus.
О студенте быстро забыли и в междусобойчик вступили три программиста: двое предложили решения на Турбо-Паскаль в стиле Си, третий - в стиле ЯСВУ паскалевидного типа с использованием array.sort(cmp).

Предлагается профи решить эту студенческую задачку на любых ЯП, ЯВУ и ЯСВУ, с учетом требований.
Код должен быть приведен в полном объеме и с тестом.
Бонусом - эффективность исполнения (быстродействие).

P.S.
На том форуме было предложено много интересных решений, но все свелось, в конце концов, к array.sort(cmp), где cmp - лямбда функция.

program Project2;

{$APPTYPE CONSOLE}

{$R *.res}

uses
 System.SysUtils, Generics.Collections, System.Generics.Defaults, Math;

var
 a, b: TArray<Integer>;
 I: Integer;
begin
 a := [40,14,17,46,12,53,3,49,26,56,10,28,59,20,35,42,42,18,24];

 TArray.Sort<Integer>(a,
   TComparer<Integer>.Construct(
     function (const Left, Right: Integer): Integer
     begin
       if (Left mod 2 = 0) and (Right mod 2 = 0) then
         Result := CompareValue(Right, Left)
       else if (Left mod 2 = 0) and (Right mod 2 <> 0) then
         Result := -1
       else if (Left mod 2 <> 0) and (Right mod 2 = 0) then
         Result := 1
       else if (Left mod 2 <> 0) and (Right mod 2 <> 0) then
         Result := CompareValue(Left, Right);
     end));

 for I := 0 to High(a) do
   WriteLn(a[i]);

 ReadLn;
end.


То не студенты, то школьники.

что-вроде этого должно сработать:

function cmp(i1, i2: integer): integer;
const
 m=-MaxInt-1;
begin;
 i1:=i1 shr 1 xor i1 shl 31 xor m;
 i2:=i2 shr 1 xor i2 shl 31 xor m;
 if i1 xor i2>=0
 then i1:=i1-i2
 else i1:=i1 or 1;
 Result:=i1;  
end;


идея функции сравнения взята отсюда http://guildalfa.ru/alsha/node/20

Понятно, что школьники бывают уже не студентами, и студенты - еще и не школьники.

ДлиннО, не оптимально по коду, не показательно для стьюдентов.

Прошу, еще :)

Sha ©   (03.04.17 23:00) [2]

Ша, да я от тебя другого и не ожидал :)
Проверять не буду - это ваше дело.

Но! Стьюдентам это пока запредельно для понимания.
P.S.
Я не о тех, кто мировые олимпиады выигрывает, если - что.

Лямбду не увидел, пока.

Дам наводку:
- самый краткий вариант, в одну строку, получился на Питоне, но - в стиле Ша.
- самый краткий и понятный вариант, в две строки, получился на PascalABC.Net.

> Jeer ©   (03.04.17 23:03) [3]
>
> ДлиннО, не оптимально по коду, не показательно для стьюдентов.

Серьезно? Решение задачи с помощью 1 (прописью - одного) вызова функции сортировки с передачей туда функции сравнения - это длинно, не оптимально и не показательно?

> Jeer ©   (03.04.17 23:06) [5]
>
> Лямбду не увидел, пока.

Серьезно? А что же там в [1] такое?

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

Вот на JavaScript решение в одну строку

Kerk ©   (03.04.17 23:31) [7]
>>Серьезно? Решение задачи с помощью 1 (прописью - одного) вызова функции >>сортировки с передачей туда функции сравнения - это длинно, не оптимально >и не показательно?

> Лямбду не увидел, пока.
>>Серьезно? А что же там в [1] такое?

Лямдбу ты еще увидишь :)

>Вот на JavaScript решение в одну строку
>a.sort((a,b) => { /* сюда переписать мою лямбда-функцию с делфи */ });

Так возьми и перепиши, в соответствии с требованиями ТС.

Ладно, пока жду апологетов С, C++, С#, Phyton, Haskel, Ruby и даже Perl.

> Jeer ©   (03.04.17 23:43) [8]
>
> Так возьми и перепиши, в соответствии с требованиями ТС.

Это мне лень. Зачем переписывать то, что и так очевидно?

Если хочется извращений, они есть у меня. Вот другое решение на JS в одну строку (вместе с тестом получается три строки):



>node s.js
[ 56, 46, 42, 42, 40, 28, 26, 24, 20, 18, 14, 12, 10, 17, 3, 35, 49, 53, 59 ]

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

Или вот решение в 2 строки на JavaScript (вместе с тестом - 4). Желающие сэкономить место на экране могут в одну строку записать :)

var a = [40,14,17,46,12,53,3,49,26,56,10,28,59,20,35,42,42,18,24]

var sort_funcs = [(a,b) => {return b-a}, (a,b) => {return -1}, (a,b) => {return 1}, (a,b) => {return a-b}]
var result = a.sort((a,b) => {return sort_funcs[a % 2 * 2 + b % 2](a, b)})

console.log(result)

По сути решение из [1], но чуть иначе записанное и без типизации, деклараций и бегин-ендов.

Все, хватит. Спать пора :)

Волшебная одна строка:




>node s3.js
[ 56, 46, 42, 42, 40, 28, 26, 24, 20, 18, 14, 12, 10, 3, 17, 35, 49, 53, 59 ]

program SortArray32;

{$APPTYPE CONSOLE}

{$R *.res}

uses
 System.SysUtils;

procedure Xchg(const i1, i2: pointer);
asm
 movd mm0, ebx
 movd mm1, ecx

 mov ebx, dword ptr [i1]
 mov ecx, dword ptr [i2]
 mov dword ptr [i2], ebx
 mov dword ptr [i1], ecx

 movd ebx, mm0
 movd ecx, mm1
end;

procedure FirstHigh(const i1, i2: pointer);
asm
 movd mm0, ebx
 movd mm1, ecx

 mov ebx, dword ptr [i1]
 mov ecx, dword ptr [i2]
 cmp ebx, ecx
 jge @@Ex //Если первое выше или равно, то ничего не делаем

 mov dword ptr [i2], ebx
 mov dword ptr [i1], ecx

@@Ex:
 movd ebx, mm0
 movd ecx, mm1
end;

procedure FirstLow(const i1, i2: pointer);
asm
 movd mm0, ebx
 movd mm1, ecx

 mov ebx, dword ptr [i1]
 mov ecx, dword ptr [i2]
 cmp ebx, ecx
 jle @@Ex //Если первое ниже или равно, то ничего не делаем

 mov dword ptr [i2], ebx
 mov dword ptr [i1], ecx

@@Ex:
 movd ebx, mm0
 movd ecx, mm1
end;

var
 a: array of integer;
 i, k: integer;
 OddIndex, EvenIndex: integer;
 LowestValue: integer;

begin
 try
   { TODO -oUser -cConsole Main : Insert code here }

   Randomize;
   SetLength(a, 40);
   for i := Low(a) to High(a) do a[i] := Random(100);

   Write('[');
   for i := Low(a) to High(a) do
   begin
     Write(IntToStr(a[i]));
     if i <> High(a) then Write(',');
   end;
   Write(']');
   Writeln;

   EvenIndex := 0;
   OddIndex := High(a);

   //Этап 1
   //Сортировка по четности
   while (EvenIndex < OddIndex) do
   begin
     //Если число нечетное, то сдвигаем в конец
     if ((a[EvenIndex] and 1) = 1) then
     begin
       Xchg(@a[EvenIndex], @a[OddIndex]);
       Dec(OddIndex);
     end
     else Inc(EvenIndex);
   end;

   //Выясним где граница
   if (a[EvenIndex] and 1) = 1 then Dec(EvenIndex);
   if (a[OddIndex] and 1) = 0 then Inc(OddIndex);

   //Этап 2
   //Сортировка четных со сдвигом к меньшему
   while (EvenIndex >= 0) do
   begin
     for i := 0 to (EvenIndex - 1) do FirstHigh(@a[i], @a[i + 1]);
     Dec(EvenIndex);
   end;

   k := High(a);

   //Этап 3
   //Сортировка нечетных со сдвигом к большему
   while (k <> OddIndex) do
   begin
     for i := (High(a) - 1) downto OddIndex do FirstLow(@a[i], @a[i + 1]);
     Dec(k);
   end;

   Writeln;
   Write('[');
   for i := Low(a) to High(a) do
   begin
     Write(IntToStr(a[i]));
     if i <> High(a) then Write(',');
   end;
   Write(']');
   Writeln;

   SetLength(a, 0);
   a := nil;

   Readln;

   asm
     emms
   end;

 except
   on E: Exception do
     Writeln(E.ClassName, ': ', E.Message);
 end;
end.


Кол-во элементов для сортировки: 100000
Время: 14,265 сек.

>dmk ©   (04.04.17 04:37) [13]
Круто..
До этого там никто не дошел :)

>Kerk ©   (04.04.17 01:51) [12]
Не выполнено основное условие - понятность для начинающего студента.

> Jeer ©   (04.04.17 09:50) [14]
>
> Не выполнено основное условие - понятность для начинающего
> студента.

Это еще в [1] выполнено :)

Ну ладно. Подождем посмотрим чего ж у нас нынче понятно начинающим студентаам :)

> Кол-во элементов для сортировки: 100000
> Время: 14,265 сек.


Чего так долго ?

>Чего так долго ?
С оптимизацией 64 бита - 8 секунд. Подумаю еще над оптимизацией. Попозже.

> dmk ©   (04.04.17 12:07) [18]
>
> >Чего так долго ?
> С оптимизацией 64 бита - 8 секунд. Подумаю еще над оптимизацией.
>  Попозже.

А смысл? Неужто есть надежда сделать быстрее квиксорта?