Текущий архив: 2010.08.27;
Скачать: CL | DM;
Вниз
Работа с текстом(перевёртыш) Найти похожие ветки
← →
SooM © (2010-05-05 21:43) [0]Вводиться число. Совпадает ли оно со своим "перевёртышем"(числом , получающимся при течение данного на оборот).
Заранее спасибо
← →
oldman © (2010-05-05 21:48) [1]Кто на ком стоял?
> при течение данного на оборот
велик могучим русский языка...
← →
Германн © (2010-05-05 21:50) [2]Не совпадает.
← →
oldman © (2010-05-05 21:57) [3]
> Работа с текстом(перевёртыш)
> Вводиться число
И не совпадет.
← →
' (2010-05-05 22:14) [4]Перевертыш зеркальный или перевертыш числовой.
Допустим
1)
123456
654321
2)
11110010
00001101
Первый реализуется циклом с конца строки в строкову переменную.
Второй реализуется заменой на противоположное число при условии.
← →
И. Павел © (2010-05-05 22:17) [5]Такую задачу интереснее решать, если запретить использование строк. Такие числа называются палиндромами. Перевертыши - это что-то из Лукьяненко :)
procedure TForm1.Button1Click(Sender: TObject);
var stroka:string;
ok:boolean;
i:integer;
begin
stroka := Edit1.Text;
ok:=true;
for i := 1 to length(stroka) div 2 do
if stroka[i] <> stroka[length(stroka)-i+1] then
Begin
ok:=false;
break;
end;
if ok then Application.MessageBox("Совпадают", "", 0)
else Application.MessageBox("Не совпадают", "", 0);
end;
← →
' (2010-05-05 22:37) [6]Йоо) ну и кодинг.
function prov(s,s1:string):boolean;
var
i:byte; g:string;
begin
g:="";
result:=false;
for i:=length(s) downto 1 do
g:=g+s[i];
if g=s1 then
result:=true;
end;
использовать так
if prov("stroka1","stroka2") then
showmeessage("sovpali") else showmeessage("net");
← →
И. Павел © (2010-05-05 22:49) [7]
> Йоо) ну и кодинг.
В моем коде нет бесполезных присваиваний (g:=g+s[i]), и цикл только до половины строки. Что не понравилось?
← →
И. Павел © (2010-05-05 22:51) [8]
> stroka := Edit1.Text;
Даже без этого можно обойтись.
← →
Smile (2010-05-05 22:52) [9]> "<> (05.05.10 22:37) [6]
Для чего нужно в функцию передавать s1, если это известный параметр?
:)
← →
DVM © (2010-05-05 22:56) [10]Вы дальтоники что ли, число от строки отличить не можете? Сказано же, вводится число.
← →
Игорь Шевченко © (2010-05-05 22:59) [11]
> Заранее спасибо
За ранее
← →
Smile (2010-05-05 23:04) [12]> DVM © (05.05.10 22:56) [10]
Число ввести невозможно
:)
← →
DVM © (2010-05-05 23:06) [13]
> Smile (05.05.10 23:04) [12]
> Число ввести невозможно
var
a: integer;
begin
writeln("Введите целое число");
read(a);
end;
← →
Smile (2010-05-05 23:06) [14]
> DVM © (05.05.10 22:56) [10]
Если не дальтоник, то читай [0]
Работа с текстом(перевёртыш)
:)
← →
DVM © (2010-05-05 23:12) [15]
> Smile (05.05.10 23:06) [14]
Задание, где на входе число в виде строки неинтересное и простое. А вот для числа уже есть над чем подумать.
← →
Smile (2010-05-05 23:21) [16]> DVM © (05.05.10 23:12) [15]
Трудно возразить
:(
← →
И. Павел © (2010-05-05 23:26) [17]Код можно и оптимизировать, но вроде бы работает:
procedure TForm1.Button1Click(Sender: TObject);
var chislo, c, l, a, b:integer;
ok:boolean;
begin
chislo:=12344321;
c:=chislo;
l:=1;
ok:=true;
repeat
l:=l*10;
c:=c div 10;
until c=0;
l:=l div 10;
repeat
if l=0 then break;
a:=chislo div l;
b:=chislo mod 10;
chislo := (chislo mod l) div 10;
l:=l div 100;
if a<>b then
Begin
ok:=false;
break;
end;
until chislo=0;
if ok then Application.MessageBox("Совпадает", "", 0)
else Application.MessageBox("Не совпадает", "", 0);
end;
← →
Игорь Шевченко © (2010-05-05 23:30) [18]И. Павел © (05.05.10 23:26) [17]
Купи книжку Стива МакКоннелла и учи наизусть.
← →
DVM © (2010-05-05 23:37) [19]у меня вот такой вариант для переворачивания:
function Reverse(x: integer): integer;
var
maxb: integer;
function Rev(a, b: integer): integer;
begin
if a = 0 then
begin
result := 0;
maxb := b div 10;
exit;
end;
result := (a mod 10) * (maxb div b) + Rev((a div 10), b * 10)
end;
begin
result := Rev(x, 1);
end;
← →
Inovet © (2010-05-05 23:47) [20]Эх.
http://delphimaster.net/view/2-1242503429
← →
DVM © (2010-05-05 23:51) [21]
> Inovet ©
что характерно, прошел год ровно.
← →
Игорь Шевченко © (2010-05-05 23:53) [22]DVM © (05.05.10 23:51) [21]
В сети мне как-то попалась методичка, все вопросы из которой задавались на delphimaster (и не только).
← →
' (2010-05-06 00:00) [23]Тогда у меня такой вариант:
var
original_num:longint;function perevernut(chislo:longint):longint;
var temp, copychislo:longint;
begin
copychislo:=chislo;
temp:=0;
while(copychislo<>0) do
begin
temp:=(temp*10)+(copychislo mod 10);
copychislo:=copychislo div 10;
end;
perevernut:=temp;
end;
original_num:=12345;
if perevernut(original_num)=original_num then
showmessage("ravno") else showmessage("net");
← →
Sha © (2010-05-06 01:39) [24]
function IsNumberPalindrome(num: integer): boolean;
var
cpy, pal: integer;
begin;
if (num<0) or (num>2147447412) //MaxInt=2147483647
then Result:=false
else begin;
pal:=0;
repeat;
cpy:=num;
num:=num div 10;
pal:=10*(pal-num) + cpy;
until (pal>=cpy) or (pal=num);
Result:=(pal<=cpy);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
const
Answers: array[boolean] of string= ("нет", "да");
begin;
Edit2.Text:=Answers[IsNumberPalindrome(StrToIntDef(Edit1.Text,-1))];
end;
← →
Германн © (2010-05-06 02:21) [25]
> DVM © (05.05.10 23:51) [21]
>
>
> > Inovet ©
>
> что характерно, прошел год ровно.
>
Ну и опять ученики кулинарного техникума получили задание из той же самой методички.
← →
Anatoly Podgoretsky © (2010-05-06 07:26) [26]> Игорь Шевченко (05.05.2010 23:53:22) [22]
Тебе попалась методичка, все вопросы из который взяты с delphimaster
← →
Омлет © (2010-05-06 12:08) [27]
function IsPalindrome(N: Integer): Boolean;
var
X, Y: Integer;
begin
if N < 10 then
Result := (N >= 0)
else begin
X := 0;
Y := N;
repeat
X := X * 10 + Y mod 10;
Y := Y div 10;
until (Y = 0);
Result := (N = X);
end;
end;
← →
Sha © (2010-05-06 13:07) [28]Алгоритм [24] может выдать неверный положительный результат, если число оканчивается нулем, например, 10.
Алгоритмы, основанные на "перевороте" числа и сравнении с исходным числом
теоретически тоже могут выдать неверный положительный результат
из-за возможного переполнения.
Интересно было бы продемонстрировать это на примере для произвольного основания системы счисления и разрядности чисел.
← →
DVM © (2010-05-06 14:53) [29]
> Sha © (06.05.10 13:07) [28]
> Интересно было бы продемонстрировать это на примере для
> произвольного основания системы счисления и разрядности
> чисел.
Для произвольной разрядности надо знать представление числа в памяти. Универсальный алгоритм вряд ли возможен. Если только для целочисленных типов из Delphi.
← →
Sha © (2010-05-06 14:55) [30]> Если только для целочисленных типов из Delphi.
Именно это я имел в виду.
← →
Sha © (2010-05-06 15:09) [31]Исправленная версия алгоритма [24]
function ShaIsNumberPalindrome(num: integer; radix: integer= 10): boolean;
var
cpy, rev: integer;
begin;
if num<radix
then Result:=(num>=0)
else begin;
cpy:=num;
num:=num div radix;
rev:=cpy - num * radix;
if rev=0
then Result:=false
else begin;
repeat;
cpy:=num;
num:=num div radix;
rev:=radix * (rev-num) + cpy;
until (rev>=cpy) or (rev=num);
Result:=(rev<=cpy);
end;
end;
end;
← →
Омлет © (2010-05-06 15:16) [32]> Sha © (06.05.10 15:09) [31]
ShaIsNumberPalindrome(11) = False
← →
Омлет © (2010-05-06 15:26) [33]И еще - подлянка от Дельфи:
ShaIsNumberPalindrome(3999999993) = False
← →
Sha © (2010-05-06 15:38) [34]> ShaIsNumberPalindrome(11) = False
Да, это ошибка.
Вынес первую итерацию из цикла, а repeat на while заменить забыл.
Хотелось поскорее найти переполнения.
Надеюсь, так будет верно
function ShaIsNumberPalindrome(num: integer; radix: integer= 10): boolean;
var
cpy, rev: integer;
begin;
if num<radix
then Result:=(num>=0)
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;
> ShaIsNumberPalindrome(3999999993) = False
Это не integer, a cardinal, так что все верно.
Если параметр объявить как cardinal, получим правильный ответ для cardinal.
← →
Омлет © (2010-05-06 15:50) [35]Да, так работает.
> Это не integer, a cardinal, так что все верно.
Проблема в том, что компилятор не ругается на выход за пределы диапазона. А на глаз сразу и не скажешь, что это число уже не Integer ))
← →
Омлет © (2010-05-06 15:56) [36]> Если параметр объявить как cardinal, получим правильный
> ответ для cardinal.
И надо не забыть{$Q-}
← →
Омлет © (2010-05-06 16:04) [37]> Омлет © (06.05.10 15:50) [35]
> компилятор не ругается
Вру. Ругается. Просто я варнинг не заметил.
← →
Sha © (2010-05-06 17:42) [38]В работе алгоритма, аналогичного [27], с параметром integer
не удалось обнаружить ошибок, вызванных переполнением,
для всех значений radix в диапазоне 2..13 и нечетных значений 15,17,19...35.
← →
Sha © (2010-05-06 22:36) [39]Обнаружено, что алгоритм
//Из-за переполнения может выдавать неверный положительный результат
function StdIsNumberPalindrome(num: cardinal; radix: cardinal= 10): boolean;
var
save, cpy, rev: 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=0;
Result:=(rev=save);
end;
end;
более чем в 128000 случаях выдает неверный результат для radix=1025, например, для таких чисел
1 1089498130(10) 1.12.0.5(1025)
2 1090549780(10) 1.13.1.5(1025)
3 1091601430(10) 1.14.2.5(1025)
4 1092653080(10) 1.15.3.5(1025)
5 1093704730(10) 1.16.4.5(1025)
6 1094756380(10) 1.17.5.5(1025)
7 1095808030(10) 1.18.6.5(1025)
8 1096859680(10) 1.19.7.5(1025)
9 1097911330(10) 1.20.8.5(1025)
← →
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.66 MB
Время: 0.071 c
