Текущий архив: 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)); меняется на case
lpow := 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.06 c