Форум: "Начинающим";
Текущий архив: 2010.08.27;
Скачать: [xml.tar.bz2];

Вниз

Работа с текстом(перевёртыш)   Найти похожие ветки 

← →
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)); меняется на 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;
Скачать: [xml.tar.bz2];

Наверх

Память: 0.65 MB
Время: 0.061 c