Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Прочее";
Текущий архив: 2016.05.01;
Скачать: [xml.tar.bz2];

Вниз

Пятничная головоломка   Найти похожие ветки 

 
Sha ©   (2015-08-20 11:58) [0]

Один настоящий программист решил хранить телефоны коллег в переменных типа int64.
Разумеется, в двоичном виде, в расчете на максимальную длину номера 19 знаков.
Т.е. телефон 33-323 хранится просто как число 33323.
Номера телефонов считаются похожими, если отличаются одной цифрой.
Одинаковые номера НЕ похожи.
Требуется написать функцию определяющую похожесть двух номеров.
Побеждает самая быстрая или самая простая (2 номинации).

P.S. Некоторое время назад я уже решал эту задачу,
но сейчас знаю более красивое решение, так что тоже поучаствую в конкурсе )


 
DayGaykin ©   (2015-08-20 12:29) [1]

Тест есть?


 
Dimka Maslov ©   (2015-08-20 12:33) [2]

сегодня пока ещё чеиверг


 
Sha ©   (2015-08-20 12:38) [3]

пока нет


 
Sha ©   (2015-08-20 12:40) [4]

> Dimka Maslov ©   (20.08.15 12:33) [2]

это как с ЧМ - именуется по дате окончания


 
sniknik ©   (2015-08-20 12:47) [5]


var
i, n: integer;
Bcd1: TBcd;
Bcd2: TBcd;
begin
 Bcd1:= VarToBcd(Int64(33323));
 Bcd2:= VarToBcd(Int64(33333));

 n:= 0;
 for i:= 0 to 31 do
   if Bcd1.Fraction[i] <> Bcd2.Fraction[i] then Inc(n);

 case n of
   0: Memo1.Text:= "равны";
   1: Memo1.Text:= "примерно равны";
 else
   Memo1.Text:= "не равны";
 end;
end;


 
DayGaykin ©   (2015-08-20 12:48) [6]


program Project1;
{$APPTYPE CONSOLE}
uses
 System.SysUtils, Math;

function NearDayGaykin(Phone1, Phone2: Int64): Boolean;
var
 Diff: Int64;
 M, M10: Integer;
begin
 Diff := Abs(Phone1 - Phone2);
 if Diff = 0 then Exit(false);
 M10 := 1;
 for M := 1 to Floor(Log10(Diff)) do
   M10 := M10 * 10;
 Exit(Diff mod M10 = 0)
end;

procedure Test(Phone1, Phone2: Int64; R: Boolean);
var
 X: Boolean;
begin
 X := NearDayGaykin(Phone1, Phone2);
 Writeln(Phone1:20);
 Write(Phone2:20, " = ", X, " -- ");
 if X = R then
   Writeln("OK")
 else
   Writeln("Fail");
   Writeln;
end;

begin
 try
   Test(12345, 12385, True);
   Test(13345, 12385, False);
   Test(2345, 12345, True);
   Test(345, 12345, False);
   Test(712345, 212345, True);
   Test(12345, 12345, False);
   Test(12345, 12341, True);
 except
   on E: Exception do
     Writeln(E.ClassName, ": ", E.Message);
 end;
 Readln;
end.



 
DayGaykin ©   (2015-08-20 13:18) [7]

Ошибку нашел. M10, конечно, должна быть Int64.

Вот чуть оптимизировал:

function NearDayGaykin(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[0..19] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000, 10000000000000000000
 );
var
 Diff: Int64;
begin
 Diff := Abs(Phone1 - Phone2);
 if Diff = 0 then Exit(false);
 Exit(Diff mod Pow10[Floor(Log10(Diff))] = 0)
end;


 
SergP ©   (2015-08-20 13:25) [8]


> Один настоящий программист решил хранить телефоны коллег
> в переменных типа int64.
> Разумеется, в двоичном виде, в расчете на максимальную длину
> номера 19 знаков.


Как-то там не совсем получается хранить 19 знаков... Если конечно не рассматривать int64 в беззнаковом варианте (типа как cardinal для integer)


 
Sha ©   (2015-08-20 13:34) [9]

> DayGaykin

переделал под свою D7

function NearDayGaykin(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[0..18] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000//, 10000000000000000000
 );
var
 Diff: Int64;
begin
 Diff := Abs(Phone1 - Phone2);
 if Diff = 0 then Result:=false else Result:=(Diff mod Pow10[Floor(Log10(Diff))] = 0);
end;


фэйлится на NearDayGaykin(10,9)


 
Sha ©   (2015-08-20 13:38) [10]

> SergP ©   (20.08.15 13:25) [8]

Согласен, не получается там хранить всевозможные 19-значные номера, начинающиеся на 9.
Ну, значит, чувак хранит там только такие, какие влезают в знаковое int64.


 
sniknik ©   (2015-08-20 13:41) [11]

да, тоже нашел ошибку... ;(, должно быть так -
var
i, n: integer;
Bcd1, Bcd2: TBcd;
Hex1, Hex2: string;
begin
 Bcd1:= VarToBcd(Int64(33322));
 Bcd2:= VarToBcd(Int64(33333));

 n:= 0;
 for i:= 0 to 31 do
   if Bcd1.Fraction[i] <> Bcd2.Fraction[i] then begin
     Hex1:= IntToHex(Bcd1.Fraction[i], 2);
     Hex2:= IntToHex(Bcd2.Fraction[i], 2);
     if Hex1[1] <> Hex2[1] then Inc(n);
     if Hex1[2] <> Hex2[2] then Inc(n);
   end;

 case n of
   0: Memo1.Text:= "равны";
   1: Memo1.Text:= "похожи";
 else
   Memo1.Text:= "не равны";
 end;
end;


 
DayGaykin ©   (2015-08-20 13:42) [12]

Поправил:

function NearDayGaykin(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[0..19] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000, 10000000000000000000
 );
var
 Diff: Int64;
begin
 Diff := Abs(Phone1 - Phone2);
 if Diff = 0 then
   Result := False
 else
 if Diff < 10 then
   Result := Floor(Log10(Phone1)) = Floor(Log10(Phone2))
 else
   Result := Diff mod Pow10[Floor(Log10(Diff))] = 0;
end;


 
Sha ©   (2015-08-20 13:49) [13]

> DayGaykin ©   (20.08.15 13:42) [12]

не такого числа 10000000000000000000


 
sniknik ©   (2015-08-20 13:53) [14]

> должно быть так -
или так
var
i, n: integer;
Bcd1, Bcd2: TBcd;
begin
 Bcd1:= VarToBcd(Int64(33323));
 Bcd2:= VarToBcd(Int64(33333));

 n:= 0;
 for i:= 0 to 31 do
   if Bcd1.Fraction[i] <> Bcd2.Fraction[i] then begin
     if (Bcd1.Fraction[i] and $F0) <> (Bcd2.Fraction[i] and $F0) then Inc(n);
     if (Bcd1.Fraction[i] and $0F) <> (Bcd2.Fraction[i] and $0F) then Inc(n);
   end;

 case n of
   0: Memo1.Text:= "равны";
   1: Memo1.Text:= "похожи";
 else
   Memo1.Text:= "не равны";
 end;
end;


 
sniknik ©   (2015-08-20 13:54) [15]

> не такого числа 10000000000000000000
вместо Int64 поставь везде UInt64


 
Sha ©   (2015-08-20 13:54) [16]

> sniknik ©   (20.08.15 13:41) [11]

Для единообразия привел к виду NearDayGaykin.

function NearSniknik(Phone1, Phone2: Int64): Boolean;
var
i, n: integer;
Bcd1, Bcd2: TBcd;
Hex1, Hex2: string;
begin
 Bcd1:= VarToBcd(Phone1);
 Bcd2:= VarToBcd(Phone2);
 n:= 0;
 for i:= 0 to 31 do
   if Bcd1.Fraction[i] <> Bcd2.Fraction[i] then begin
     Hex1:= IntToHex(Bcd1.Fraction[i], 2);
     Hex2:= IntToHex(Bcd2.Fraction[i], 2);
     if Hex1[1] <> Hex2[1] then Inc(n);
     if Hex1[2] <> Hex2[2] then Inc(n);
   end;
 Result:=(n=1);
end;

Начал писать тест.


 
Sha ©   (2015-08-20 13:55) [17]

> sniknik ©   (20.08.15 13:54) [15]
> вместо Int64 поставь везде UInt64

Все тесты на D7


 
sniknik ©   (2015-08-20 13:58) [18]

на D7 глюк с константами... надо еще и число 10000000000000000000 из десятичного в hex поменять так -
$DE0B6B3A7640000


 
SergP ©   (2015-08-20 13:59) [19]

Это типа мой (наверное предварительный) вариант

function ComparePhoneSergP(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[0..18] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000
 );
var
 Diff,k: Int64;
 a,b,c:integer;
begin
 Diff := Abs(Phone1 - Phone2);
 result:=false;
 if Diff = 0 then  Exit;
 a:=0; b:=19;
 while b-a > 1 do
 begin
   c:=(a+b+1) shr 1;
   k:=Diff mod pow10[c];
   if k=Diff then b:=c else if k=0 then a:=c else exit;
 end;
 result:=true;
end;


 
sniknik ©   (2015-08-20 14:00) [20]

> Для единообразия привел к виду NearDayGaykin.
возьми более новый вариант без строк. раз тест на скорость ;)


 
DayGaykin ©   (2015-08-20 14:13) [21]


> Sha ©   (20.08.15 13:49) [13]

Поправил:


function NearDayGaykin(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[0..18] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000
 );
var
 Diff: Int64;
begin
 Diff := Abs(Phone1 - Phone2);
 if Diff = 0 then
   Result := False
 else
 if Diff < 10 then
   Result := Floor(Log10(Phone1)) = Floor(Log10(Phone2))
 else
   Result := Diff mod Pow10[Floor(Log10(Diff))] = 0;
end;


 
SergP ©   (2015-08-20 14:16) [22]

в [19] +1 вроде как лишнее

function NearDaySergP(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[0..18] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000
 );
var
 Diff,k: Int64;
 a,b,c:integer;
begin
 Diff := Abs(Phone1 - Phone2);
 result:=false;
 if Diff = 0 then  Exit;
 a:=0; b:=19;
 while b-a > 1 do
 begin
   c:=(a+b) shr 1;
   k:=Diff mod pow10[c];
   if k=Diff then b:=c else if k=0 then a:=c else exit;
 end;
 result:=true;
end;


 
Sha ©   (2015-08-20 14:19) [23]

> sniknik ©   (20.08.15 14:00) [20]
> возьми более новый вариант без строк. раз тест на скорость ;)

взял [16] - оно?


 
Sha ©   (2015-08-20 14:23) [24]

> SergP ©   (20.08.15 14:16) [22]

по идее, твоя функция должна называться NearSergP


 
sniknik ©   (2015-08-20 14:25) [25]

> взял [16] - оно?
нет, отсюда
sniknik ©   (20.08.15 13:53) [14]

+
кстати константой в hex можно UInt64 задать, а вот преобразование через вариант не пройдет, в вариантах без знаковый тип попросту не дописан ;(. как и в модуле Bcd
т.е. описать можно, работать нельзя.


 
sniknik ©   (2015-08-20 14:30) [26]

единственное со строки есть преобразование (если нужны телефоны 19 и более цифр, чего не будет по условию, что они в Int64)

но если вдруг, то -
function NearSniknik(const Phone1, Phone2: string): Boolean;
var
 i, n: integer;
 Bcd1, Bcd2: TBcd;
begin
 Bcd1:= StrToBcd(Phone1);
 Bcd2:= StrToBcd(Phone2);
 n:= 0;
 for i:= 0 to 31 do
   if Bcd1.Fraction[i] <> Bcd2.Fraction[i] then begin
     if (Bcd1.Fraction[i] and $F0) <> (Bcd2.Fraction[i] and $F0) then Inc(n);
     if (Bcd1.Fraction[i] and $0F) <> (Bcd2.Fraction[i] and $0F) then Inc(n);
   end;
result:= (n=1);
end;


 
SergP ©   (2015-08-20 14:31) [27]


> Sha ©   (20.08.15 14:23) [24]
>
> > SergP ©   (20.08.15 14:16) [22]
>
> по идее, твоя функция должна называться NearSergP


а. ну да... ошибся


 
DayGaykin ©   (2015-08-20 14:42) [28]


> sniknik ©   (20.08.15 14:30) [26]

Мой тест не проходит:

               2345
              12345 = FALSE -- Fail

                345
              12345 = FALSE -- OK

             712345
             212345 = TRUE -- OK

              12345
              12345 = FALSE -- OK

              12345
              12341 = TRUE -- OK

                 10
                  9 = TRUE -- Fail

                 10
                  3 = TRUE -- Fail

              10000
                  3 = TRUE -- Fail


 
SergP ©   (2015-08-20 14:49) [29]

Есть ли смысл менять типы переменных a,b,c на byte ?
Типа так:
function NearSergP(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[0..18] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000
 );
var
 Diff,k: Int64;
 a,b,c:byte;
begin
 Diff := Abs(Phone1 - Phone2);
 result:=false;
 if Diff = 0 then  Exit;
 a:=0; b:=19;
 while b-a > 1 do
 begin
   c:=(a+b) shr 1;
   k:=Diff mod pow10[c];
   if k=Diff then b:=c else if k=0 then a:=c else exit;
 end;
 result:=true;
end;


или лучше оставить integer ?


 
Sha ©   (2015-08-20 14:52) [30]

SergP ©   (20.08.15 14:49) [29]

Обычно integer лучше.


 
SergP ©   (2015-08-20 14:56) [31]

DayGaykin ©   (20.08.15 14:42) [28]

У нас общая ошибка тут:
Diff := Abs(Phone1 - Phone2);

)))


 
SergP ©   (2015-08-20 15:09) [32]

ладно, в таком случае мы пойдем другим путем.


 
Inovet ©   (2015-08-20 15:16) [33]

Может
xor
и посмотреть расстояние между выставленными в 1 разрядами?


 
SergP ©   (2015-08-20 15:21) [34]


> Inovet ©   (20.08.15 15:16) [33]
>
> Может
> xor
> и посмотреть расстояние между выставленными в 1 разрядами?
>


Вариант с xor детально не рассматривал, но мне кажется что он не пройдет.
все-таки ищем десятичные цифры в двоичном коде


 
Sha ©   (2015-08-20 15:22) [35]

> Inovet ©   (20.08.15 15:16) [33]

код давай )


 
DayGaykin ©   (2015-08-20 15:30) [36]


> SergP ©

Тоже не проходит:


              12345
              12385 = TRUE -- OK

              13345
              12385 = FALSE -- OK

               2345
              12345 = TRUE -- OK

                345
              12345 = FALSE -- OK

             712345
             212345 = TRUE -- OK

              12345
              12345 = FALSE -- OK

              12345
              12341 = TRUE -- OK

                 10
                  9 = TRUE -- Fail

                 10
                  3 = TRUE -- Fail

              10000
                  3 = FALSE -- OK



 
SergP ©   (2015-08-20 15:35) [37]


> DayGaykin ©   (20.08.15 15:30) [36]
>
>
> > SergP ©
>
> Тоже не проходит:


Угу... Я ж и пишу в [31], что у нас с тобой общая ошибка


 
DayGaykin ©   (2015-08-20 15:36) [38]


> SergP ©   (20.08.15 15:35) [37]

Так я у себя поправил уже.


 
sniknik ©   (2015-08-20 15:43) [39]

> Мой тест не проходит:
да, как-то коряво из строки преобразовывает... ;(
смотри только c Int64 на входе.

> все-таки ищем десятичные цифры в двоичном коде
bsd это оно и есть, десятичные цифры (до 9) в полубайте. т.е. - $9999999999... и т.д. до 64х девяток.


 
sniknik ©   (2015-08-20 15:53) [40]

> как-то коряво из строки преобразовывает...
понял, оно его "наоборот" вставляет, не как число, а как хз знает что.
1234  и 12345 похожи, а 2345 и 12345 нет.

странно, может в этом и есть логика, но выглядит как подстава.


 
SergP ©   (2015-08-20 15:56) [41]

Ладно. Тогда вот мой новый вариант:

function NearSergP_2(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[1..19] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000
 );
var
 Diff,k: Int64;
 a,b,c,d:byte;
begin
 a:=0; c:=20;
 while c-a>1 do
 begin
   b:=(a+c) shr 1;
   if (phone1 mod Pow10[b]) = (phone2 mod Pow10[b]) then a:=b else c:=b;
 end;
 a:=0; b:=20;
 while b-a>1 do
 begin
   d:=(a+b) shr 1;
   if (phone1 div Pow10[d]) = (phone2 div Pow10[d]) then b:=d else a:=d;
 end;
 result:=c-a=1;
end;


Можно конечно ввести доп. переменные чтобы одно и то же значение из массива 2 раза не дергать, но не знаю, стоит ли?


 
sniknik ©   (2015-08-20 15:57) [42]

+
TBcd.Precision разные, т.е. "внутри себя" оно это число правильно понимает, а вот как массив байт/полубайт не работает. у Int64 смещения одинаковые для любого значения.


 
SergP ©   (2015-08-20 15:59) [43]


> SergP ©   (20.08.15 15:56) [41]
>
> Ладно. Тогда вот мой новый вариант:


Хотя он вроде и работает, но мне что-то не нравится.  Буду думать еще.


 
DayGaykin ©   (2015-08-20 15:59) [44]


> sniknik ©   (20.08.15 15:43) [39]

В любом случае это будет очень медленно. Преобразование в такой формат подразумевает операцию div и mod для каждого десятичного знака.


 
DayGaykin ©   (2015-08-20 16:00) [45]


> SergP ©   (20.08.15 15:59) [43]

Мне тоже хочется избавиться от "плавающих точек".


 
Sha ©   (2015-08-20 16:03) [46]

> SergP ©   (20.08.15 15:56) [41]
> Ладно. Тогда вот мой новый вариант:

А старый выбывает?



> Можно конечно ввести доп. переменные
> чтобы одно и то же значение из массива 2 раза не дергать,
> но не знаю, стоит ли?

Не стоит. Только хуже будет,
т.к. все равно переменная типа int64 всегда в памяти лежит.


 
DayGaykin ©   (2015-08-20 16:03) [47]


> Хотя он вроде и работает, но мне что-то не нравится.

Добавил в тест телефоны: 110, 103 - теперь не проходит :)


 
DayGaykin ©   (2015-08-20 16:06) [48]

Ладно, я своей работой позанимаюсь:) Удачи вам в поиске решения!


 
SergP ©   (2015-08-20 16:08) [49]


>
> А старый выбывает?


Старый не проходит тест.

> DayGaykin ©   (20.08.15 15:30) [36]


 
SergP ©   (2015-08-20 16:12) [50]


> SergP ©   (20.08.15 15:56) [41]
>
> Ладно. Тогда вот мой новый вариант:


будем считать его предварительным, так как там по меньшей мере уже видна неоптимальность: во втором цикле явно возможны лишние итерации.


 
SergP ©   (2015-08-20 16:15) [51]

Ну и  
Diff,k: Int64;
там тоже убрать нужно


 
DayGaykin ©   (2015-08-20 16:55) [52]

Я, пожалуй, остановлюсь на варианте в лоб:

function NearDayGaykin3(const Phone1, Phone2: Int64): Boolean;
var
 S1, S2: String;
 I, M1, M2: Integer;
 Dif: boolean;
begin
 if Phone1 = Phone2 then
   Result := False
 else
 begin
   S1 := IntToStr(Phone1);
   S2 := IntToStr(Phone2);
   M1 := Length(S1);
   M2 := Length(S2);
   if M1 > M2 then
   begin
     M1 := M1 xor M2;
     M2 := M1 xor M2;
     M1 := M1 xor M2;
   end;
   if M2 - M1 > 1 then
     Result := False
   else
     begin
       Dif := M1 <> M2;
       for I := 0 to M1-1 do
       if S1[M1 - I] <> S2[M2 - I] then
         if Dif then
         begin
           Result := False;
           Exit;
         end
         else
           Dif := True;
       Result := True;
     end;
 end;
end;

За счет необычной реализации функции IntToStr в моем XE5, работает быстрее чем вариант SergP


 
Sha ©   (2015-08-20 17:32) [53]

> DayGaykin ©   (20.08.15 16:55) [52]

Насколько я понял, ты сравниваешь телефоны как строки,
выравнивая их по левому краю.

Наверное, для того, чтобы все решали одну и ту же задачу
и чтобы решение через строки не получало дополнительных преимуществ,
стоит добавить еще одно условие. А именно, будем считать,
что разряды при сравнении выравниваются по правому краю,
или, что то же самое, все телефоны имеют длину 19.


 
DayGaykin ©   (2015-08-20 17:57) [54]


> Sha ©   (20.08.15 17:32) [53]

По правому и сравниваю. Все тесты что я сделал - проходятся.


 
SergP ©   (2015-08-20 18:48) [55]

Вроде чуть оптимизировал:

function NearSergP_2(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[1..19] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000
 );
var
 a,b,c:byte; // хз что лучше byte или integer
begin
 a:=0; c:=20;
 while c-a>1 do
 begin
   b:=(a+c) shr 1;
   if phone1 mod Pow10[b] = phone2 mod Pow10[b] then a:=b else c:=b;
 end;
 result:=(c<20) and  (phone1 div Pow10[c] = phone2 div Pow10[c]);
end;


 
Sha ©   (2015-08-20 18:57) [56]

NearDayGaykin52 failed 0
99
9

NearSergP55 failed 0
9223372036854775807
8223372036854775807


 
SergP ©   (2015-08-20 19:00) [57]

Вобщем в процессе вычисления значения функции происходит от 4 до 5 итераций в цикле... Т.е. mod в итоге максимум используется 10 раз, и еще div используется 2 раза

Пока мыслей нет как сделать лучше.


 
DayGaykin ©   (2015-08-20 19:01) [58]


> Sha ©   (20.08.15 18:57) [56]
> NearDayGaykin52 failed 0
> 99
> 9

9 и 99 отличаются одной цифрой. Ожидаемый ответ True. Ответ функции True. Что не так?


 
SergP ©   (2015-08-20 19:03) [59]


> Sha ©   (20.08.15 18:57) [56]
>
> NearDayGaykin52 failed 0
> 99
> 9
>
> NearSergP55 failed 0
> 9223372036854775807
> 8223372036854775807


хм... да, с 19-разрядными числами, где отличается старший разряд действительно проблемы...


 
Sha ©   (2015-08-20 19:06) [60]

> DayGaykin ©   (20.08.15 19:01) [58]

Возможно, ошибка в валидаторе, будем искать.


 
SergP ©   (2015-08-20 19:15) [61]

function NearSergP_2(Phone1, Phone2: UInt64): Boolean;
const
 Pow10: array[1..19] of UInt64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000
 );
var
 a,b,c:byte;
begin
 a:=0; c:=20;
 while c-a>1 do
 begin
   b:=(a+c) shr 1;
   if phone1 mod Pow10[b] = phone2 mod Pow10[b] then a:=b else c:=b;
 end;
 if c=20 then result:=Phone1<>Phone2
         else result:=(phone1 div Pow10[c] = phone2 div Pow10[c]);
end;


 
Sha ©   (2015-08-20 19:18) [62]

> DayGaykin ©   (20.08.15 19:01) [58]
> 9 и 99 отличаются одной цифрой. Ожидаемый ответ True.
> Ответ функции True. Что не так?

Сфэйлилось не на 9 и 99, а на 99 и 9. Там ваще вылезает за границу строки.


 
Sha ©   (2015-08-20 19:39) [63]

> SergP ©   (20.08.15 19:15) [61]

По условию тип на входе должен быть int64.
Внутри функции можно делать что угодно.

Что будем делать? Изменим условия? Тогда как?
Разрешим 20-значные номера или только 19?
В любом случае в D7 его штатными средствами не вывести на экран,
поэтому, на мой взгляд, лучше не менять условия.


 
Sha ©   (2015-08-20 19:43) [64]

> sniknik ©   (20.08.15 13:53) [14]

NearSniknik14 failed 1
9
9


 
SergP ©   (2015-08-20 20:14) [65]


> Sha ©   (20.08.15 19:39) [63]
>
> > SergP ©   (20.08.15 19:15) [61]
>
> По условию тип на входе должен быть int64.


это я хотел в массив впихнуть 10 000 000 000 000 000 000
но потом, когда вернул все назад, забыл и тип назад поменять.
Прошу прощения, должно быть так:

function NearSergP_2(Phone1, Phone2: Int64): Boolean;
const
 Pow10: array[1..19] of Int64 = (
   1, 10, 100, 1000, 10000, 100000, 1000000, 10000000, 100000000, 1000000000,
   10000000000, 100000000000, 1000000000000, 10000000000000, 100000000000000,
   1000000000000000, 10000000000000000, 100000000000000000,
   1000000000000000000
 );
var
 a,b,c:byte;
begin
 a:=0; c:=20;
 while c-a>1 do
 begin
   b:=(a+c) shr 1;
   if phone1 mod Pow10[b] = phone2 mod Pow10[b] then a:=b else c:=b;
 end;
 if c=20 then result:=Phone1<>Phone2
         else result:=(phone1 div Pow10[c] = phone2 div Pow10[c]);
end;


 
Sha ©   (2015-08-20 20:27) [66]

>Sha ©   (20.08.15 19:43) [64]
>NearSniknik14 failed 1
>9
>9

Сорри. Не то скопировал.

NearSniknik14 failed 0
999999999999999
989999999999999


 
Mystic ©   (2015-08-20 20:39) [67]

Лучше хранить номера телефонов в bcd формате. Тогда просто xor, получить индекс самого левого бита, установленного в единиду, округлить по границе 4, сдвинуть и посмотреть, результат больше 15 или нет.


 
Sha ©   (2015-08-20 20:50) [68]

> Mystic ©   (20.08.15 20:39) [67]

Тогда бы не было задачи)

На самом деле нечто похожее было на практике.
Оптимизировалась похожая функция для целых чисел в интервале 0000..9999.
Правда тогда не удалось найти красивого решения.


 
Mystic ©   (2015-08-20 21:19) [69]

Вроде как была такая ассемблерная команда? AAA или что-то в этом роде.

Хорошо, рассмотрим модуль разности. По сути это число вида d00..00, где d лежит в диапазоне 1-9, а число нулей от нуля до 18. Итого 19*9 вариантов, что уже неплохо.

Далее можно построить FSM, которому скармливать части числа (например по байтам). На выходе будем иметь удолетворяет/не удовлетворяет. Не хочешь строить FSM сам - перевели в base64 и натправи pcre, где просто перечисли все 19*9 альтернатив.

Также можно реализовать некоторую hash-функцию, которая бы для указанных альтернатив выдавала уникальный номер, а потом по таблице проверяли бы, совпало или нет. Например, просится нечто вроде value * magic >> (64-bit_count). Потом просто написать подбор оптимальных magic и count.


 
Sha ©   (2015-08-20 21:47) [70]

> Mystic ©   (20.08.15 21:19) [69]

сегодня так и сделал, самому странно, что раньше ходил вокруг да около:

function NearSha(p1, p2: pint64): boolean;
var
 d: Int64Rec;
begin
 int64(d):=p2^-p1^;
 if d.Hi or d.Lo<>0 then begin;            //d<>0
   if d.Hi and $80000000<>0 then begin;    //d<0
     p2:=p1;                               //p2->max
     int64(d):=-int64(d);                  //d:=abs(d)
     end;
   p1:=@MagicArray[int64(d) mod MagicMod]; //адрес разности в хеш-таблице
   if p1^=int64(d) then begin;             //если нашли круглую разность в таблице
     //берем младшие разряды большего числа или все число, если различие в старшем разряде
     inc(p1); //p1->MagicArray[].Power
     if pInt64Rec(p1).Hi and $80000000=0 then begin;
       int64(d):=p2^ mod p1^;
       p2:=@d;
       end;
     //и сравниваем с круглой разностью
     dec(p1); //p1->MagicArray[].Delta
     if p1^<=p2^ then begin;
       Result:=true;
       exit;
       end;
     end;
   end;
 Result:=false;
 end;


 
Sha ©   (2015-08-20 21:51) [71]

Хеш-таблица заполняется так:
type
 PMagicRecord= ^TMagicRecord;
 TMagicRecord= record
   Delta: int64;
   Power: int64;
   end;

const
 MagicMod= 207;

var
 MagicArray: array[0..MagicMod-1] of TMagicRecord;

procedure FillMagicArray;
var
i, j, n: integer;
Power: int64;
begin;
 for i:=0 to MagicMod-1 do begin;
   MagicArray[i].Delta:=-1;
   MagicArray[i].Power:=-1;
   end;
 Power:=1;
 for i:=1 to 19 do begin;
   for j:=1 to 9 do begin;
     n:=j*Power mod MagicMod;
     MagicArray[n].Delta:=Power*j;
     if i<19 then MagicArray[n].Power:=Power*10
             else MagicArray[n].Power:=-1;
     end;
   Power:=Power*10;
   end;
 end;


 
Sha ©   (2015-08-20 22:07) [72]

> Sha ©   (20.08.15 21:47) [70]

Можно упростить немного.
Проверка в строке 6 лишняя, т.к. нулевой разности нет в таблице.


 
Mystic ©   (2015-08-20 22:23) [73]

А как-то так низя?

uint64_t unique[19*9];

void init_unique()
{
   int i = 0;
   uint64_t f = 1;
   for (int p=0; p<19; ++p) {
       for (uint64_t d=1; d<10; ++d) {
           unique[i++] = d*f;
       }
       f *= 10;
   }
}
void fill_magic(uint64_t mod)
{
   for (int i=0; i<19*9; ++i) {
       uint64_t index = unique[i] % mod;
       magic[index] = unique[i];
   }
}

int is_similar(uint64_t a, uint64_t b)
{
   uint64_t diff = a>b ? a-b : b-a;
   uint64_t magic_value = magic[diff % mod];
   if (magic_value == 0) { // ASM conditional MOV
       diff = 0;
   }
   return diff == magic_value;
}



 
Sha ©   (2015-08-20 22:39) [74]

> Mystic ©   (20.08.15 22:23) [73]

Так не получится, одной этой проверки мало, например, для чисел 19 и 20.
Нужна вторая проверка, поэтому у меня в хеш-таблице 2 значения.


 
Sha ©   (2015-08-21 11:29) [75]

Удалось избавиться от одного деления, стало заметно быстрее:
const
 MagicMod= 207;
 MagicInv= -356458822680377809; //=MagicMod^-1
 MagicShift= 56;
 MagicLen= 1 shl (64-MagicShift);

var
 MagicArray2: array[0..MagicLen-1] of TMagicRecord;


procedure FillMagicArray2;
var
i, j, n: integer;
Power: int64;
begin;
 for i:=0 to MagicLen-1 do begin;
   MagicArray2[i].Delta:=-1;
   MagicArray2[i].Power:=-1;
   end;
 Power:=1;
 for i:=1 to 19 do begin;
   for j:=1 to 9 do begin;
     n:=j*Power*MagicInv shr MagicShift;
     MagicArray2[n].Delta:=Power*j;
     if i<19 then MagicArray2[n].Power:=Power*10
             else MagicArray2[n].Power:=-1;
     end;
   Power:=Power*10;
   end;
 end;

function NearSha2(p1, p2: pint64): boolean;
var
 d: Int64Rec;
begin
 int64(d):=p2^-p1^;
 if d.Hi and $80000000<>0 then begin;    //d<0
   p2:=p1;                               //p2->max
   int64(d):=-int64(d);                  //d:=abs(d)
   end;
 p1:=@MagicArray2[int64(d) * MagicInv shr MagicShift]; //адрес разности в хеш-таблице
 if p1^=int64(d) then begin;                           //если нашли круглую разность в таблице
   //берем младшие разряды большего числа или все число, если различие в старшем разряде
   inc(p1); //p1->MagicArray[].Power
   if pInt64Rec(p1).Hi and $80000000=0 then begin;
     int64(d):=p2^ mod p1^;
     p2:=@d;
     end;
   //и сравниваем с круглой разностью
   dec(p1); //p1->MagicArray[].Delta
   if p1^<=p2^ then begin;
     Result:=true;
     exit;
     end;
   end;
 Result:=false;
 end;


 
SergP ©   (2015-08-21 12:14) [76]


> P.S. Некоторое время назад я уже решал эту задачу,
> но сейчас знаю более красивое решение, так что тоже поучаствую
> в конкурсе )


Интерестно тогда, а этот вариант был какой?


 
Sha ©   (2015-08-21 12:51) [77]

> SergP ©   (21.08.15 12:14) [76]

Первоначально задачу сформулировал один англоговорящий товарищ на форуме EMB.

Т.к. ему требовалось решение для четырехзначных чисел,
то тогда оказалось достаточно какого-то (сейчас точно не помню)
решения примерно из середины этой заметки:
http://guildalfa.ru/alsha/node/16

Заметку я написал уже потом, после спокойного обдумывания задачи.
Выше Mystic ©  (20.08.15 21:19) [69]  совершенно правильно сказал,
что сюда просится хеш. И я его использовал там в последних решениях.

Но есть проблема с подбором множителя. Вместо того, чтобы еще немного
подумать, я тупо запускал перебор. Хотя можно было бы догадаться,
что для уменьшения коллизий и уплотнения таблицы ее надо делать
через деление (или умножение на обратный делителю).

Вот, собственно, вчера, когда писал условие и решил это реализовать.
А пост Мистика застал меня на полпути). В итоге сейчас для 19-значных чисел размерность таблицы такая же, как там в заметке для 10-значных.


 
Mystic ©   (2015-08-21 16:59) [78]

Четыре десятичных знака можно перевести в BCD сравнительно быстро, а дальше просто.
http://homepage.cs.uiowa.edu/~jones/bcd/decimal.html


 
Sha ©   (2015-08-21 18:11) [79]

> Mystic ©   (21.08.15 16:59) [78]

Огромное спасибо ссылку на статью.

Будет повoд вернуться к IntToStr снова,
проверить, не протух ли уже мой старый задел)



Страницы: 1 2 вся ветка

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

Наверх





Память: 0.68 MB
Время: 0.004 c
6-1279796725
Буржуй
2010-07-22 15:05
2016.05.01
Работа с XMLDOCUMENT


2-1411730430
Дмитрий
2014-09-26 15:20
2016.05.01
GridKeyUp и InputBox - застреваю при нажатии Ентера


15-1440192604
Юрий
2015-08-22 00:30
2016.05.01
С днем рождения ! 22 августа 2015 суббота


11-1263886607
magi6162
2010-01-19 10:36
2016.05.01
GPS on wince


15-1439836848
Sha
2015-08-17 21:40
2016.05.01
Загадка-минутка





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский