Пятничная головоломка

← →
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

Есть ли смысл менять типы переменных 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 ?

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

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

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

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

> 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

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

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

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

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

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

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

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