Текущий архив: 2010.08.27;
Скачать: CL | DM;
Вниз
Работа с текстом(перевёртыш) Найти похожие ветки
← →
Sha © (2010-05-06 23:19) [40]Версия алгоритма [27] для cardinal также работает не всегда верно:
//Неверно работает для radix=1025, num=2149584896(10) 1.1021.5.1021(1025)
function Alg27IsNumberPalindrome(num: cardinal; radix: cardinal= 10): boolean;
var
save, rev: cardinal;
begin;
if num<radix
then Result:=true
else begin;
save:=num;
rev:=0;
repeat;
rev:=rev * radix + num mod radix;
num:=num div radix;
until (num=0);
Result:=(num=rev);
end;
end;
← →
Sha © (2010-05-06 23:43) [41]Дико извиняюсь, не то скопапистил. Версия алгоритма [27] для cardinal выглядит так
//Из-за переполнения может выдавать неверный положительный результат
function Alg27IsNumberPalindrome(num: cardinal; radix: cardinal= 10): boolean;
var
save, rev: cardinal;
begin;
if num<radix
then Result:=true
else begin;
save:=num;
rev:=0;
repeat;
rev:=rev * radix + num mod radix;
num:=num div radix;
until (num=0);
Result:=(rev=save);
end;
end;
и выдает те же неверные результаты, что и [39]
← →
Sha © (2010-05-07 08:44) [42]Версия алгоритма [39] с дополнительной проверкой переполнения работает верно (как и алгоритм [34]):
function CorrectedIsNumberPalindrome(num: cardinal; radix: cardinal= 10): boolean;
const
MaxCardinal= cardinal(-1);
var
save, cpy, rev, prev: cardinal;
begin;
if num<radix
then Result:=true
else begin;
save:=num;
rev:=0;
repeat;
cpy:=num;
num:=num div radix;
prev:=rev;
rev:=(rev-num) * radix + cpy;
until num=0;
Result:=(rev=save) and (prev<=(MaxCardinal-cpy) div radix);
end;
end;
Она требует меньше умножений/делений, чем алгоритмы [27] и [41]
но больше, чем алгоритм [34].
← →
Омлет © (2010-05-07 11:46) [43]Еще вариант без опасности переполнения:
function IsNumberPalindrome_om_v2(num: Cardinal; radix: Cardinal = 10): boolean;
var
lpow, rpow: Cardinal;
len, i: Cardinal;
begin;
Result := True;
if num >= radix then
begin
len := Trunc(LogN(radix, num));
lpow := Trunc(IntPower(radix, len));
rpow := 1;
for i := 0 to (len-1) div 2 do
begin
Dec(num, (num div lpow) * (rpow + lpow));
rpow := rpow * radix;
if (num mod rpow) <> 0 then
begin
Result := False;
Break;
end;
lpow := lpow div radix;
end;
end;
end;
Сложных операций больше, но цикл половинный и на не палиндромах досрочно завершается.
← →
Sha © (2010-05-08 11:07) [44]Тест скорости вычислений на 1024 случайных числах из полного диапазона типа cardinal, radix=10.
Кроме алгоритма [43] в неизменном виде участвуют (с небольшими изменениями) алгоритмы:
- полный переворот подобно [23] и [27],
- полный переворот с уменьшенным количеством делений подобно [39] ,
- 2 версии половинного переворота подобно [34].
Что было изменено в исходниках:
- переход к типу cardinal и произвольному основанию системы счисления,
- добавлена защита от переполнения в алгоритмах полного переворота,
- упрощена последняя итерация в алгоритмах полного переворота.
Измененные версии ниже:
function Alg27IsNumberPalindrome(num: cardinal; radix: cardinal= 10): boolean;
const
MaxCardinal= cardinal(-1);
var
save, rev, prev: cardinal;
begin;
if num<radix
then Result:=true
else begin;
save:=num;
rev:=0;
repeat;
rev:=rev * radix + num mod radix;
num:=num div radix;
until num<radix;
prev:=rev;
rev:=rev * radix + num;
//защита от переполнения
Result:=(rev=save) and (prev<=(MaxCardinal-num) div radix);
end;
end;
function Opt27IsNumberPalindrome(num: cardinal; radix: cardinal= 10): boolean;
const
MaxCardinal= cardinal(-1);
var
save, cpy, rev, prev: cardinal;
begin;
if num<radix
then Result:=true
else begin;
save:=num;
rev:=0;
repeat;
cpy:=num;
num:=num div radix;
rev:=(rev-num) * radix + cpy;
until num<radix;
prev:=rev;
rev:=rev * radix + num;
//защита от переполнения
Result:=(rev=save) and (prev<=(MaxCardinal-num) div radix);
end;
end;
function ShaIsNumberPalindrome(num: cardinal; radix: cardinal= 10): boolean;
var
cpy, rev: cardinal;
begin;
if num<radix
then Result:=true
else begin;
cpy:=num;
num:=num div radix;
rev:=cpy - num * radix;
if rev=0
then Result:=false
else begin;
while (rev<>num) and (rev<cpy) do begin;
cpy:=num;
num:=num div radix;
rev:=radix * (rev-num) + cpy;
end;
Result:=(rev<=cpy);
end;
end;
end;
function ShaIsNumberPalindrome2(num: cardinal; radix: cardinal= 10): boolean;
var
cpy, rev: cardinal;
begin;
if num<radix
then Result:=true
else begin;
cpy:=num;
num:=num div radix;
rev:=cpy - num * radix;
if rev=0
then Result:=false
else begin;
while rev<num do begin;
cpy:=num;
num:=num div radix;
rev:=radix * (rev-num) + cpy;
end;
Result:=(rev=num) or (rev=cpy);
end;
end;
end;
Время работы в msec
2344 IsNumberPalindrome_om_v2
3093 Alg27IsNumberPalindrome
1954 Opt27IsNumberPalindrome
1109 ShaIsNumberPalindrome
1000 ShaIsNumberPalindrome2
← →
Омлет © (2010-05-11 10:06) [45]ShaIsNumberPalindrome2 - эталон :)
← →
Sha © (2010-05-11 11:05) [46]> Омлет © (11.05.10 10:06) [45]
> ShaIsNumberPalindrome2 - эталон :)
Для IsNumberPalindrome_om_v2 все может резко поменяться в лучшую сторону, если система счисления фиксирована, например, только десятичная. В этом случаеlen := Trunc(LogN(radix, num));
меняется на caselpow := Trunc(IntPower(radix, len));
меняется на работу с таблицей
и свехкороткий цикл до первого несовпадения сделает свое дело.
Надо будет проверить.
← →
Омлет © (2010-05-11 11:34) [47]
function IsDecimalNumberPalindrome_om_v2(num: Cardinal): boolean;
const
Pow10: array[0..8] of Cardinal =
(10,100,1000,10000,100000,1000000,10000000,100000000,1000000000);
MaxCardinal = Cardinal(-1);
var
lpow, rpow: Cardinal;
len, i: Cardinal;
begin;
Result := True;
if num >= 10 then
begin
case num of
10..99: len := 0;
100..999: len := 1;
1000..9999: len := 2;
10000..99999: len := 3;
100000..999999: len := 4;
1000000..9999999: len := 5;
10000000..99999999: len := 6;
100000000..999999999: len := 7;
1000000000..MaxCardinal: len := 8;
else exit;
end;
lpow := Pow10[len];
rpow := 1;
for i := 0 to len div 2 do
begin
Dec(num, (num div lpow) * (rpow + lpow));
rpow := rpow * 10;
if (num mod rpow) <> 0 then
begin
Result := False;
Break;
end;
lpow := lpow div 10;
end;
end;
end;
← →
Sha © (2010-05-11 13:04) [48]Результаты на Pentium D
1266 IsDecimalNumberPalindrome_om_v2
6250 IsNumberPalindrome_om_v2
6437 Alg27IsNumberPalindrome
4344 Opt27IsNumberPalindrome
2875 ShaIsNumberPalindrome
2344 ShaIsNumberPalindrome2
← →
Омлет © (2010-05-11 13:46) [49]Athlon XP 1800+, почти также. Миллион итераций с использованием Random:
for I := 1 to 1000000 do func(Random(MaxCardinal));
1015 IsDecimalNumberPalindrome_om_v2
4312 IsNumberPalindrome_om_v2
5172 Alg27IsNumberPalindrome
3000 Opt27IsNumberPalindrome
2047 ShaIsNumberPalindrome
1625 ShaIsNumberPalindrome2
← →
Омлет © (2010-05-11 13:47) [50]Пардон, не миллион, а 10 миллионов )
← →
Sha © (2010-05-11 13:56) [51]Лучше числа заранее вычислить, результат точнее будет.
Примерно так:
procedure TForm1.bSpeedClick(Sender: TObject);
type
TIsPalindrome= function(num: cardinal; radix: cardinal= 10): boolean;
var
funcs: array of TIsPalindrome;
names: array of string;
procedure RegisterFunc(func: TIsPalindrome; const name: string);
var
OldLen: integer;
begin;
OldLen:=Length(funcs);
SetLength(funcs,OldLen+1); funcs[OldLen]:=func;
SetLength(names,OldLen+1); names[OldLen]:=name;
end;
var
func: TIsPalindrome;
nums: array of cardinal;
times: array of cardinal;
i, j, k, num: integer;
begin;
RegisterFunc(IsDecimalNumberPalindrome_om_v2,"IsDecimalNumberPalindrome_om_v2");
RegisterFunc(IsNumberPalindrome_om_v2,"IsNumberPalindrome_om_v2");
RegisterFunc(Alg27IsNumberPalindrome, "Alg27IsNumberPalindrome");
RegisterFunc(Opt27IsNumberPalindrome, "Opt27IsNumberPalindrome");
RegisterFunc(ShaIsNumberPalindrome, "ShaIsNumberPalindrome");
RegisterFunc(ShaIsNumberPalindrome2, "ShaIsNumberPalindrome2");
SetLength(nums,1024);
Randomize;
nums[0]:=RandSeed;
for i:=1 to Length(nums)-1 do nums[i]:=nums[i-1] * $08088405 + 1;
SetLength(times,Length(funcs)+1);
for k:=0 to Length(funcs)-1 do begin;
times[k]:=GetTickCount;
func:=funcs[k];
for i:=0 to Length(nums)-1 do begin;
num:=nums[i];
for j:=1 to 4730{4*1024} do begin;
func(num);
func(num);
func(num);
func(num);
end;
end;
end;
times[Length(times)-1]:=GetTickCount;
Memo1.Lines.Clear;
for k:=0 to Length(funcs)-1 do Memo1.Lines.Add(Format("%d %s",
[times[k+1]-times[k], names[k]]));
end;
← →
Омлет © (2010-05-11 14:05) [52]Кстати, в IsDecimalNumberPalindrome_om_v2
if num >= 10 then
можно убрать.
← →
Sha © (2010-05-11 14:12) [53]Точно.
И еще можно учесть, что равномерно распределенные случайные числа чаще попадают в верхние интервалы, т.к. длины интервалов увеличиваются. Поэтому case может оказатьсе медленнее цепочки if"ов.
← →
Омлет © (2010-05-11 14:14) [54]> [51] с учетом [52]
1625 IsDecimalNumberPalindrome_om_v2
8094 IsNumberPalindrome_om_v2
9812 Alg27IsNumberPalindrome
5266 Opt27IsNumberPalindrome
3375 ShaIsNumberPalindrome
2953 ShaIsNumberPalindrome2
← →
Sha © (2010-05-11 14:20) [55]Так отрыв побольше стал )
← →
Sha © (2010-05-11 16:45) [56]Ничто так не заставляет думать, как чужие успехи :)
var
RadixSaved: cardinal= 0;
RadixPowers: array of cardinal;
PowersCount: cardinal;
const
MaxCardinal= cardinal(-1);
procedure InitRadixPowers(radix: cardinal);
begin;
if radix<=1 then RadixPowers:=nil
else begin;
RadixSaved:=radix;
SetLength(RadixPowers, 32);
RadixPowers[0]:=1;
PowersCount:=1;
repeat;
RadixPowers[PowersCount]:=RadixPowers[PowersCount-1] * radix;
inc(PowersCount);
until RadixPowers[PowersCount-1]>(MaxCardinal div radix);
end;
end;
function ShaIsNumberPalindrome3(num: cardinal; radix: cardinal= 10): boolean;
var
i: integer;
cpy: cardinal;
begin;
if radix<>RadixSaved then InitRadixPowers(radix);
Result:=true;
if num>=radix then begin;
i:=PowersCount-1;
while RadixPowers[i]>num do dec(i);
repeat;
cpy:=num;
num:=num div radix;
num:=num + (num * radix - cpy) * RadixPowers[i-1];
if num>=RadixPowers[i-1] then begin;
Result:=false;
break;
end;
dec(i, 2);
until i<=0;
end;
end;
Здесь при каждом изменении основания системы счисления перестраивается таблица степеней. А так как это обычно происходит нечасто, тормозов быть не должно. Таким образом убиты оба зайца: и основание не фиксировано и таблицей можно пользоваться. Кроме того, заимствована твоя идея сравнивать до первого различия. Правда тут сравнение организовано иначе, благодаря чему в этом алгоритме 2 умножения и одно деление, а не наоборот как в оригинале. Кроме того, используются особенности беззнаковои арифметики.
В результате на Pentium D имеем
1296 IsDecimalNumberPalindrome_om_v2
6563 IsNumberPalindrome_om_v2
6797 Alg27IsNumberPalindrome
4609 Opt27IsNumberPalindrome
3016 ShaIsNumberPalindrome
2453 ShaIsNumberPalindrome2
766 ShaIsNumberPalindrome3
← →
Омлет © (2010-05-12 16:13) [57]Просто блеск! :)
← →
Омлет © (2010-05-14 09:29) [58]Реализовал алгоритм, аналогичный [43], но начиная с другого конца - младший разряд умножается на старшую степень и отнимается от числа.
Получилось чуть быстрее ShaIsNumberPalindrome3, но слишком некрасивая реализация, много всяких проверок понадобилось. И для универсального radix, наверное, будет уже медленнее.
function IsDecimalNumberPalindrome_om_v3(num: cardinal; radix: cardinal = 10): boolean;
const
Pow10: array[1..9] of Cardinal =
(10,100,1000,10000,100000,1000000,10000000,100000000,1000000000);
var
i,j,k,len : integer;
m,check : cardinal;
begin;
if num >= 10 then
begin
Result := false;
m := num mod 10;
if m > 0 then
begin
if num > Pow10[9] then
begin
if m > 4 then exit; // защита от переполнения
len := 9;
end
else begin
len := 8;
while Pow10[len] > num do dec(len);
end;
end
else exit; // кратные основанию сразу исключаем
j := 1;
i := len;
k := len;
check := Pow10[(len shr 1) + 1];
repeat
dec(num, m * (Pow10[i] + 1));
if num >= Pow10[k] then exit;
if num >= check then
begin
dec(k);
inc(j);
dec(i,2);
if num < Pow10[k] then
begin
repeat
dec(k);
inc(j);
dec(i,2);
until num > Pow10[k];
if num mod Pow10[j-1] > 0 then exit;
end;
m := num mod Pow10[j];
end
else begin
Result := (num = 0) or
((len and 1 = 0) and
(num mod Pow10[len shr 1] = 0));
exit;
end;
until false;
end;
Result := true;
end;
Может быть есть более красивое решение этого алгоритма, но пока до него не додумался.
Результаты на моем Атлоне:
9734 Alg27IsNumberPalindrome
5297 Opt27IsNumberPalindrome
8172 IsNumberPalindrome_om_v2
1766 IsDecimalNumberPalindrome_om_v2
968 IsDecimalNumberPalindrome_om_v3
3422 ShaIsNumberPalindrome
2953 ShaIsNumberPalindrome2
1079 ShaIsNumberPalindrome3
← →
Sha © (2010-05-14 11:41) [59]Результат действительно очень хороший. Причем, на пентиуме еще лучше. В первую очередь он достигается тем, что две трети чисел отсекаются на предварительном этапе, и проходят только те из больших чисел, у которых последняя цифра лежит в интервале 1..3. Надо взять на заметку :)
Также сыграло, что в этой версии второе деление ты делаешь после проверки.
Однако, комментарий "защита от переполнения" не совсем верен, т.к. оно произойдет, например, на 1234567893.
Сейчас подправлю свою процедуру и после обеда отпишусь.
← →
Омлет © (2010-05-14 12:08) [60]> Однако, комментарий "защита от переполнения" не совсем верен
Это защита от переполнения, приводящего к ошибке. Ни одно из больших чисел, оканчивающихся на 1..4, не приводит к фатальному переполнению. Т.е. два зайца одним выстрелом - отсечение больших чисел и защита от ошибок ))
← →
Sha © (2010-05-14 14:07) [61]Косметика третьей версии:
function ShaIsNumberPalindrome4(num: cardinal; radix: cardinal= 10): boolean;
var
i: integer;
cpy: cardinal;
begin;
if num>=radix then begin;
if radix<>RadixSaved then InitRadixPowers(radix);
i:=PowersCount;
repeat;
dec(i);
until RadixPowers[i]<=num;
repeat;
cpy:=num;
num:=num div radix;
num:=num + (num * radix - cpy) * RadixPowers[i-1];
if num>=RadixPowers[i-1] then begin;
Result:=false;
exit;
end;
dec(i, 2);
until i<=0;
end;
Result:=true;
end;
2406 IsDecimalNumberPalindrome_om_v3
4922 IsDecimalNumberPalindrome_om_v2
24875 IsNumberPalindrome_om_v2
25593 Alg27IsNumberPalindrome
17313 Opt27IsNumberPalindrome
11328 ShaIsNumberPalindrome
9359 ShaIsNumberPalindrome2
2891 ShaIsNumberPalindrome3
2391 ShaIsNumberPalindrome4
В запасе есть еще идейка насчет таблицы 10х10 конкретно для 10-чной системы :)
← →
Sha © (2010-05-14 14:24) [62]Т.е. 100х100
← →
Омлет © (2010-05-14 15:14) [63]> Sha © (14.05.10 14:07) [61]
Ничего же значительного не поменялось. Чудеса просто ))
Страницы: 1 2 вся ветка
Текущий архив: 2010.08.27;
Скачать: CL | DM;
Память: 0.62 MB
Время: 0.055 c