Воспринял статью как неструктурированный поток сознания, который зациклил мои логические вентили и отправил мозг в reboot, в этот момент меня проняло.
Отличный арт. для пятницы.
По поводу написанного: Мы пришли в эту игру, чтоб преодолевать физические и ментальные ограничения. Убери из системы карму как набор причинно-следственных связей, у играющего потеряется интерес к процессу. God-mode режим приведёт систему к коллапсу. Идеален медленный итерационный процесс развития сознания путём проб и ошибок.
Система подавления не так уж и ущербна, она оберегает человечество от опасных флуктуаций отдельных индивидов с раздутым самомнением о своей божественной природе. Но с развитием трансцендентной личности перестаёт оказывать сильное значение на индивида.
Аналогия: игра в рогалики. Изначально ты умираешь постоянно на каждом шагу, но с опытом игры многие ловушки тебе не опасны, и ты проходишь до финала.
Резюмирую: Это план хардкор’а, слабаки тут не играют.
Пробовал с проходом по 4 бита, падение 30-40%, видимо тут уже кэш не даёт такого преимущества как встроенные инструкции процессора на 1 байтовые вычисления и повторные проходы.
Есть желание опробовать гибрид MSD и LSD для разных проходов, если будут интересные результаты, напишу.
Вариант с отдельной функцией сортировки на последнем шаге, падение меньше около 4-5%, уже приемлемо.
код
//==================================================
procedure RSort2(var m: array of Longword);
//--------------------------------------------------
procedure Sort_step(var source, dest, s_source, s_dest: array of Longword; const num: Byte);
var i,temp : Longword;
k,num1,num2 : Byte;
offset : array[0..3] of byte absolute temp;
begin
num2 := num+1; // устанавливаем байт для проверки на следующем шаге
for i := 1 to 255 do // Пересчёт смещений для текущей корзины
Inc(s_source[i], s_source[i-1]);
FillChar(s_dest, 256 * SizeOf(Longword), 0);
num1 := num*8;
for i := High(source) downto 0 do
begin
temp := source[i];
Inc(s_dest[offset[num2]]);
k := temp SHR num1;
Dec(s_source[k]);
Dest[s_source[k]] := temp;
end;
end;
//--------------------------------------------------
procedure Sort_step_last(var source, dest, s_source : array of Longword);
var i,temp : Longword;
k : Byte;
begin
for i := 1 to 255 do // Пересчёт смещений для текущей корзины
Inc(s_source[i], s_source[i-1]);
for i := High(source) downto 0 do
begin
temp := source[i];
k := temp SHR 24;
Dec(s_source[k]);
Dest[s_source[k]] := temp;
end;
end;
//--------------------------------------------------
var s : array[0..1] of array[0..255] of Longword; // Объявляем массив двух корзин первым, для выравнивания на стеке
i : longword;
k : Byte;
m_temp : array of Longword;
begin
SetLength(m_temp, Length(m)); // Объявляем временный массив
FillChar(s[0], 256 * SizeOf(Longword), 0); // Быстрая очистка первой корзины
for i := 0 to High(m) do // Заполнение первой корзины
begin
k := m[i];
Inc(s[0,k]);
end;
Sort_step(m, m_temp, s[0], s[1], 0); // Вызов сортировки по байтам от младших к старшим
Sort_step(m_temp, m, s[1], s[0], 1);
Sort_step(m, m_temp, s[0], s[1], 2);
Sort_step_last(m_temp, m, s[1]);
SetLength(m_temp, 0); // Высвобождаем память
end;
//==================================================
Падение скорости получилась в среднем на 13% при n>1000, стоит ли это 2Кб памяти, сомнительно.
На меньших длинах есть небольшой выигрыш. Возможно данный код поддаётся улучшению.
Код
//======================================================
procedure RSort2(var m: array of Longword);
//--------------------------------------------------
procedure Sort_step(var source, dest, s_source, s_dest: array of Longword; const num: Byte);
var i,temp : Longword;
k,num1,num2 : Byte;
offset : array[0..3] of byte absolute temp;
begin
if num<3 then // устанавливаем байт для проверки на следующем шаге
num2 := num+1
else
num2:=0;
for i := 1 to 255 do // Пересчёт смещений для текущей корзины
Inc(s_source[i], s_source[i-1]);
FillChar(s_dest, 256 * SizeOf(Longword), 0);
num1 := num*8;
for i := High(source) downto 0 do
begin
temp := source[i];
Inc(s_dest[offset[num2]]);
k := temp SHR num1;
Dec(s_source[k]);
Dest[s_source[k]] := temp;
end;
end;
//------------------------------------------------------------------------------
var s : array[0..1] of array[0..255] of Longword; // Объявляем массив двух корзин первым, для выравнивания на стеке
i : longword;
k : Byte;
m_temp : array of Longword;
begin
SetLength(m_temp, Length(m)); // Объявляем временный массив
FillChar(s[0], 256 * SizeOf(Longword), 0); // Быстрая очистка первой корзины
for i := 0 to High(m) do // Заполнение первой корзины
begin
k := m[i];
Inc(s[0,k]);
end;
Sort_step(m, m_temp, s[0], s[1], 0); // Вызов сортировки по байтам от младших к старшим
Sort_step(m_temp, m, s[1], s[0], 1);
Sort_step(m, m_temp, s[0], s[1], 2);
Sort_step(m_temp, m, s[1], s[0], 3);
SetLength(m_temp, 0); // Высвобождаем память
end;
//======================================================
Если только для следующего разряда, то да, сработает.
Хотя немного собьёт стройность конструкции, ведь что тогда считать на последнем шаге, видимо добавить проверку на не исполнение.
Мысль мне нравиться попробую посмотрю на изменение производительности.
Идея заманчивая, но нет. К моменту сортировки нужно уже знать место вставки элемента. Эта информация и содержится в вычисленном заранее массиве.
Если производить подсчёт в каждом шаге, то придется дополнительно обходить основной массив каждый раз. Это займёт гораздо больше операций, хотя да, мы экономим пару килобайт. На малых массивах это имеет смысл, а на миллионе элементов каждый дополнительный проход очень дорог.
Работаю в компании которая более 20 лет в своей работе использует как средство разработки Delphi 4. Перенести на современную платформу ту тонну кода, не останавливая работу предприятия просто невозможно, (ооо-чень дорого).
Поэтому, просто вносишь правки в систему под текущее законодательство. Переносить современные концепции в старый код та ещё некромантия.
Выше была шутка по веб-браузер на Delphi, так вот, в нашем проекте такое есть, большинство отчётов на html (правда без javascript). Зато всё летает на таком железе что устарело ещё в прошлом десятилетии.
Но это мелочи, у нас есть контрагент ИП, учётная система которого написана на турбопаскале, под dos, с матричной печатью, более 25 лет непрерывной работы.
Мейл.ру ты делаешь все, чтоб я ненавидел отечественный софт!
Во всех проектах в которых поучаствовала данная организация я видел рекламную содомию, донатную доильню в играх и монстро-интерфейсы.
Вы убили QIP и Вконтакте… я скорблю! Игровые проекты с лейблом мейл.ру, после “Аллодной трипонации мозга”, псевдо бесплатные проекты, где для комфортной игры нужно оставлять пол зарплаты, обхожу третей стороной.
И вот, вишенкой на торте, был убит последний достойный для меня проект – почта.
Как я боролся с переходом в почту корпорации апокалипса, но нет, простите.
У меня есть флешка TRANSCEND 15 летней давности на 256 мб, с защитной перемычкой от записи и гарантией 1м циклов перезаписи. Работает идеально, использую как криптоконтейнер и по-мелочи. Жаль сейчас таких устройств больше не делают.
…если делитель известен на этапе компиляции, есть возможность заменить целочисленное деление умножением и логическим сдвигом вправо (а иногда, можно обойтись и без него вовсе — я конечно про реализацию в Языке Программирования)
Если у меня в коде есть выражение X/10, что мне мешает просто заменить его на X*0.1?
Исправил грубую ошибку в ассемблерном коде и немного изменил алгоритм, получил небольшой прирост в скорости (3-9%). Всё сильно зависит от исходных данных. Чем больше повторов в значениях тем быстрее работает относительно прежнего.
Код
// Комбинированная сортировка --------------------------------------------------
procedure qSort_insSort2(var m : Array of LongWord; l,r : LongWord);
procedure ASM_QSort assembler;
ASM
@@START_SORT:
MOV R8,RCX // i:=0; Используется в обоих алгоритмах экономим 3 байта
MOV RAX,RDX
SUB RAX,RCX
CMP RAX,R11
JGE @@Q_Sort // Иначе сортируем быстрой сортировкой со срединным опорным элементом
// Сортировка вставками --------------------------------------------------------
//MOV R8,RCX // i:=0;
@@I_BEGIN:
ADD R8,R12 // i:=i+1;
CMP R8,RDX // while (i<=r) do
JA @@END // i>r
MOV R9,R8 // j:=i;
@@J_BEGIN:
CMP R9,RCX // j<=0
JNA @@I_BEGIN // Оканчиваем итерацию j
@@i_START: // while (o < m[j]) do dec(j);
MOV EAX,DWord[R8]
CMP EAX,R10D
JNL @@j_START // если больше или равно
ADD R8,R12
JMP @@i_START
@@j_START: // while (PLongWord(j)^ > o) do dec(j,4);
MOV EBX,DWord[R9]
CMP EBX,R10D
JNG @@j_STOP // если меньше или равно
SUB R9,R12
JMP @@j_START
@@j_STOP:
CMP R8,R9 // if (i <= j) then
JG @@NO_XCHG // если меньше или равно
MOV EAX,DWord[R8] // temp:=m[i]; m[i]:=m[j]; m[j]:=temp;
MOV EBX,DWord[R9]
MOV DWord[R8],EBX
MOV DWord[R9],EAX
ADD R8,R12 // inc(i); dec(j);
SUB R9,R12
@@NO_XCHG:
CMP R8,R9 // until (i > j);
JNG @@i_START // если меньше или равно
CMP RCX,R9 // if (P1 < j) then
JNB @@SORT1 // Jump, если больше или равно
PUSH R8 // i
PUSH RDX // p2
// Первый аргумент (p1) уже в регистре RCX
MOV RDX,R9 // Устанавливаем второй аргумент (j)
CALL ASM_QSort // вызываем Сортировку первого отрезка (рекурсивно)
POP RDX // p2
POP R8 // i
@@SORT1:
CMP R8,RDX // if (i < P2) then
JNB @@END // Jump, если больше или равно
MOV RCX,R8 // Устанавливаем первый аргумент (i)
// Второй аргумент (p2) уже в регистре RDX
JMP @@START_SORT // вызываем Сортировку второго отрезка (Без рекурсии)
@@END:
END;
begin
ASM
CMP R8,R9 // Если L>=R
JNB @@NO_RUN
CMP R9,RDX // Если R>LENGTH(M)
JA @@NO_RUN
CMP R8,0 // Если L<0
JB @@NO_RUN
CMP RDX,0 // Если LENGTH(M)=0
JE @@NO_RUN
LEA RDX,[RCX+R9*4]
LEA RCX,[RCX+R8*4]
MOV R11,100 // Будем хранить константу сравнения в регистре R11 так экономим 1 байт инструкций на каждом цикле
MOV R12,4
Как вариант оптимизации, предлагаю Вам поиграться с коэффициентом выбора разбиения "<20" возможно на некоторых диапазонах его стоит делать меньше или больше, я выбрал среднее, возможно есть более оптимальные значения.
Вы провели отличную работу. Пришёл к такому же выводу: микроассемблерные вставки не стоят тех усилий что на них затрачиваются, особенно при смене компилятора или платформы. Это был отличный опыт, отрицательный результат не менее ценен. Уверен из алгоритма можно ещё немного выжать, но зачем? Для большинства повседневных задач хватает библиотечных функций.
Я очень извиняюсь, конечно же:
qSort_insSort(m,0,n-1);
По поводу Вашего кода, проверил загвоздка в том, что вы выделяете память на стеке, а нужно только в куче, так как стек и так интенсивно используется в работе процедуры. Так мы используем свободные регистры на адресацию к массиву.
Собрал проект на Lazarus64.
Благодарю за интерес к вопросу.
Собственно, у Вас должно всё нормально выводиться, но учтите, собирать проект нужно только под 64-битной версией компилятора. У Win32 и Win64 разные соглашения о вызовах. Если не разберётесь пишите в личку.
Заголовок спойлера
Procedure test();
const n=16;
var m:Array of LongWord;
i:LongWord;
begin
SetLength(m,n);
Randomize;
for i:=0 to Length(m)-1 do m[i]:=Random(9000)+1000;
for i:=0 to n-1 do WRITE(inttostr(m[i])+' ');
WRITELN('');
qSort_insSort(@m[0],0,n-1);
for i:=0 to n-1 do WRITE(inttostr(m[i])+' ');
WRITELN('');
end;
Отличный арт. для пятницы.
По поводу написанного: Мы пришли в эту игру, чтоб преодолевать физические и ментальные ограничения. Убери из системы карму как набор причинно-следственных связей, у играющего потеряется интерес к процессу. God-mode режим приведёт систему к коллапсу. Идеален медленный итерационный процесс развития сознания путём проб и ошибок.
Система подавления не так уж и ущербна, она оберегает человечество от опасных флуктуаций отдельных индивидов с раздутым самомнением о своей божественной природе. Но с развитием трансцендентной личности перестаёт оказывать сильное значение на индивида.
Аналогия: игра в рогалики. Изначально ты умираешь постоянно на каждом шагу, но с опытом игры многие ловушки тебе не опасны, и ты проходишь до финала.
Резюмирую: Это план хардкор’а, слабаки тут не играют.
Есть желание опробовать гибрид MSD и LSD для разных проходов, если будут интересные результаты, напишу.
Затем, беспилотные автомобили, квадрокоптеры и прочие робо-мулы захватили сферу доставки.
Умные пылесосы и виртуальные ассистенты совместно с сетями глубокого обучения заняли сферу услуг.
Всё что осталось человечеству — это майнить виртуальную криптовалюту, на виртуальных же рудниках.
Апокалипсис оказался ближе, чем мы думали…
….
До производства первого T1000 оставалось менее 15 лет….
На меньших длинах есть небольшой выигрыш. Возможно данный код поддаётся улучшению.
Хотя немного собьёт стройность конструкции, ведь что тогда считать на последнем шаге, видимо добавить проверку на не исполнение.
Мысль мне нравиться попробую посмотрю на изменение производительности.
Если производить подсчёт в каждом шаге, то придется дополнительно обходить основной массив каждый раз. Это займёт гораздо больше операций, хотя да, мы экономим пару килобайт. На малых массивах это имеет смысл, а на миллионе элементов каждый дополнительный проход очень дорог.
Поэтому, просто вносишь правки в систему под текущее законодательство. Переносить современные концепции в старый код та ещё некромантия.
Выше была шутка по веб-браузер на Delphi, так вот, в нашем проекте такое есть, большинство отчётов на html (правда без javascript). Зато всё летает на таком железе что устарело ещё в прошлом десятилетии.
Но это мелочи, у нас есть контрагент ИП, учётная система которого написана на турбопаскале, под dos, с матричной печатью, более 25 лет непрерывной работы.
Иногда тёмными ночами, пользуясь тёмной некромантией, поднимаю Delphi 7 на виртуалке и кодю на нём родимом, ибо адепт тьмы.
Во всех проектах в которых поучаствовала данная организация я видел рекламную содомию, донатную доильню в играх и монстро-интерфейсы.
Вы убили QIP и Вконтакте… я скорблю! Игровые проекты с лейблом мейл.ру, после “Аллодной трипонации мозга”, псевдо бесплатные проекты, где для комфортной игры нужно оставлять пол зарплаты, обхожу третей стороной.
И вот, вишенкой на торте, был убит последний достойный для меня проект – почта.
Как я боролся с переходом в почту корпорации апокалипса, но нет, простите.
Если у меня в коде есть выражение X/10, что мне мешает просто заменить его на X*0.1?
// Комбинированная сортировка --------------------------------------------------
procedure qSort_insSort2(var m : Array of LongWord; l,r : LongWord);
procedure ASM_QSort assembler;
ASM
@@START_SORT:
MOV R8,RCX // i:=0; Используется в обоих алгоритмах экономим 3 байта
MOV RAX,RDX
SUB RAX,RCX
CMP RAX,R11
JGE @@Q_Sort // Иначе сортируем быстрой сортировкой со срединным опорным элементом
// Сортировка вставками --------------------------------------------------------
//MOV R8,RCX // i:=0;
@@I_BEGIN:
ADD R8,R12 // i:=i+1;
CMP R8,RDX // while (i<=r) do
JA @@END // i>r
MOV R9,R8 // j:=i;
@@J_BEGIN:
CMP R9,RCX // j<=0
JNA @@I_BEGIN // Оканчиваем итерацию j
MOV R10,R9 // (j)
SUB R9,R12 // (j-1)
MOV EAX,DWord[R9] // m[j-1]
MOV EBX,DWord[R10] // m[j]
CMP EAX,EBX // m[j-1]<=m[j]
JNA @@I_BEGIN // Оканчиваем итерацию j
MOV DWord[R9],EBX // Меняем местами
MOV DWord[R10],EAX
JMP @@J_BEGIN
// Qsort с рекурсией -----------------------------------------------------------
@@Q_Sort:
//MOV R8,RCX
ADD R8,RDX
SHR R8,3
SHL R8,2
MOV R10D,DWord[R8] // находим срединный элемент
MOV R8,RCX // i:= P1;
MOV R9,RDX // j:= P2;
@@i_START: // while (o < m[j]) do dec(j);
MOV EAX,DWord[R8]
CMP EAX,R10D
JNL @@j_START // если больше или равно
ADD R8,R12
JMP @@i_START
@@j_START: // while (PLongWord(j)^ > o) do dec(j,4);
MOV EBX,DWord[R9]
CMP EBX,R10D
JNG @@j_STOP // если меньше или равно
SUB R9,R12
JMP @@j_START
@@j_STOP:
CMP R8,R9 // if (i <= j) then
JG @@NO_XCHG // если меньше или равно
MOV EAX,DWord[R8] // temp:=m[i]; m[i]:=m[j]; m[j]:=temp;
MOV EBX,DWord[R9]
MOV DWord[R8],EBX
MOV DWord[R9],EAX
ADD R8,R12 // inc(i); dec(j);
SUB R9,R12
@@NO_XCHG:
CMP R8,R9 // until (i > j);
JNG @@i_START // если меньше или равно
CMP RCX,R9 // if (P1 < j) then
JNB @@SORT1 // Jump, если больше или равно
PUSH R8 // i
PUSH RDX // p2
// Первый аргумент (p1) уже в регистре RCX
MOV RDX,R9 // Устанавливаем второй аргумент (j)
CALL ASM_QSort // вызываем Сортировку первого отрезка (рекурсивно)
POP RDX // p2
POP R8 // i
@@SORT1:
CMP R8,RDX // if (i < P2) then
JNB @@END // Jump, если больше или равно
MOV RCX,R8 // Устанавливаем первый аргумент (i)
// Второй аргумент (p2) уже в регистре RDX
JMP @@START_SORT // вызываем Сортировку второго отрезка (Без рекурсии)
@@END:
END;
begin
ASM
CMP R8,R9 // Если L>=R
JNB @@NO_RUN
CMP R9,RDX // Если R>LENGTH(M)
JA @@NO_RUN
CMP R8,0 // Если L<0
JB @@NO_RUN
CMP RDX,0 // Если LENGTH(M)=0
JE @@NO_RUN
LEA RDX,[RCX+R9*4]
LEA RCX,[RCX+R8*4]
MOV R11,100 // Будем хранить константу сравнения в регистре R11 так экономим 1 байт инструкций на каждом цикле
MOV R12,4
CALL ASM_QSort
XOR RAX,RAX
JMP @@END
@@NO_RUN:
MOV RAX,1
@@END:
END;
end;
qSort_insSort(m,0,n-1);
По поводу Вашего кода, проверил загвоздка в том, что вы выделяете память на стеке, а нужно только в куче, так как стек и так интенсивно используется в работе процедуры. Так мы используем свободные регистры на адресацию к массиву.
Собрал проект на Lazarus64.
Собственно, у Вас должно всё нормально выводиться, но учтите, собирать проект нужно только под 64-битной версией компилятора. У Win32 и Win64 разные соглашения о вызовах. Если не разберётесь пишите в личку.
Procedure test();
const n=16;
var m:Array of LongWord;
i:LongWord;
begin
SetLength(m,n);
Randomize;
for i:=0 to Length(m)-1 do m[i]:=Random(9000)+1000;
for i:=0 to n-1 do WRITE(inttostr(m[i])+' ');
WRITELN('');
qSort_insSort(@m[0],0,n-1);
for i:=0 to n-1 do WRITE(inttostr(m[i])+' ');
WRITELN('');
end;