297 lines
6.3 KiB
ObjectPascal
297 lines
6.3 KiB
ObjectPascal
program p196;
|
|
{$IFDEF FPC}
|
|
{$R-}
|
|
{$MODE DELPHI}
|
|
{$Optimization ON}
|
|
{$Else}
|
|
{$APPTYPE console}
|
|
{$Endif}
|
|
{
|
|
nativeUint = LongWord;//Uint64
|
|
nativeInt = LongInt;//Int64
|
|
}
|
|
|
|
uses
|
|
SysUtils,classes;
|
|
|
|
const
|
|
cMAXNUM = 100*1000*1000;//100*1000*1000;
|
|
cMaxCycle = 1500;
|
|
cChkDigit = 10;//first check lychrel found
|
|
MaxLen = 256;//maximal count of digits
|
|
cMaxDigit = MAXLEN-1;
|
|
|
|
type
|
|
TDigit = byte;
|
|
tpDigit =^TDigit;
|
|
tDigitArr = array[0..0] of tDigit;
|
|
tpDigitArr = ^tDigitArr;
|
|
//LSB at position 0
|
|
TNumber = record
|
|
nNum : array [0..cMaxDigit] of TDigit;
|
|
nMaxPos : LongInt;
|
|
end;
|
|
tRelated = array[0..cMAXNUM] of byte;
|
|
|
|
procedure NumberFromString(var Number: TNumber; S: string);
|
|
var
|
|
i,le: integer;
|
|
begin
|
|
le := Length(s);
|
|
IF le > cMaxDigit then
|
|
le := cMaxDigit;
|
|
Number.nMaxPos:= le-1;
|
|
for i:= 0 to le-1 do
|
|
Number.nNum[i]:= Ord(s[le- i]) - Ord('0');
|
|
end;
|
|
|
|
function NumberToString(var Number: TNumber): string;
|
|
var
|
|
i,l: integer;
|
|
begin
|
|
i := Number.nMaxPos;
|
|
If i <= MAXLEN then
|
|
begin
|
|
SetLength(Result, i+1);
|
|
l := i+1;
|
|
i := 0;
|
|
repeat
|
|
Result[l]:= Chr(Ord('0') + Number.nNum[i]);
|
|
inc(i);
|
|
dec(l);
|
|
until l <= 0;
|
|
end
|
|
else
|
|
begin
|
|
SetLength(Result, MAXLEN);
|
|
fillchar(Result[1],MAXLEN,'.');
|
|
For l := 1 to MAXLEN DIV 2-1 do
|
|
Begin
|
|
Result[l] := Chr(Ord('0') + Number.nNum[i-l+1]);
|
|
Result[l+MAXLEN DIV 2+1] := Chr(Ord('0') + Number.nNum[24-l]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure CorrectCarry(var Number : TNumber);
|
|
//correct sum of digit to digit and carry
|
|
//without IF d>10 then...
|
|
var
|
|
d,i,carry: nativeInt;
|
|
p: tpDigitArr;
|
|
begin
|
|
carry := 0;
|
|
i := Number.nMaxPos;
|
|
p := @Number.nNum[i];
|
|
i := -i;
|
|
For i := i to 0 do
|
|
Begin
|
|
d := p^[i]+carry;
|
|
carry := ord(d>=10);//0, 1-> (-10 AND(-carry) = 0 ,-10
|
|
p^[i] := d+(-10 AND(-carry));
|
|
end;
|
|
//correct length
|
|
IF carry >0 then
|
|
begin
|
|
i := Number.nMaxPos+1;
|
|
Number.nNum[i] :=1;
|
|
NUmber.nMaxPos := i;
|
|
end;
|
|
end;
|
|
|
|
procedure NumberAdd(var Number : TNumber);
|
|
// first add than correct carry
|
|
var
|
|
//pointer, for fpc is a little bit slow with dynamic array
|
|
loIdx,hiIdx: integer;
|
|
sum: nativeUint;
|
|
begin
|
|
loIdx := 0;
|
|
hiIdx := Number.nMaxPos;
|
|
while loIdx< hiIdx do
|
|
Begin
|
|
sum := Number.nNum[loIdx]+Number.nNum[hiIdx];
|
|
Number.nNum[loIdx] := sum;
|
|
Number.nNum[hiIdx] := sum;
|
|
inc(loIdx);
|
|
dec(HiIdx);
|
|
end;
|
|
|
|
IF loIdx = hiIdx then
|
|
Number.nNum[loIdx] := 2*Number.nNum[loIdx];
|
|
|
|
CorrectCarry(Number);
|
|
end;
|
|
|
|
function PalinCheck(var A: TNumber): boolean;
|
|
var
|
|
loIdx,hiIdx: integer;
|
|
begin
|
|
loIdx := 0;
|
|
hiIdx := A.nMaxPos;
|
|
repeat
|
|
Result:= A.nNum[loIdx]=A.nNum[hiIdx];
|
|
inc(loIdx);
|
|
dec(hiIdx);
|
|
until Not(Result) OR (hiIdx<loIdx);
|
|
end;
|
|
|
|
procedure ShowPalinLychrel(var Related:tRelated);
|
|
var
|
|
i : NativeInt;
|
|
s : string;
|
|
slRes : TStringList;
|
|
Work: TNumber;
|
|
Begin
|
|
slRes := TStringList.create;
|
|
|
|
For i := 0 to High(Related) do
|
|
begin
|
|
IF Related[i] <> 0 then
|
|
Begin
|
|
s := IntToSTr(i);
|
|
NumberFromString(Work,s);
|
|
If PalinCheck(Work) then
|
|
slRes.Add(s);
|
|
end;
|
|
end;
|
|
|
|
Writeln('number of palindromatic lychrel ',slRes.count:8);
|
|
IF slRes.Count < 10 then
|
|
Begin
|
|
For i := 0 to slRes.count-2 do
|
|
write(slRes[i]:8,',');
|
|
writeln(slRes[slRes.count-1]:8);
|
|
end;
|
|
slRes.free;
|
|
end;
|
|
|
|
var
|
|
Related : tRelated;
|
|
slSeedCache,
|
|
slFirstChkCache : TStringList;
|
|
|
|
Seeds : array of LongInt;
|
|
Work: TNumber;
|
|
num,findpos,InsPos : LongInt;
|
|
relCount : NativeUint;
|
|
s,f: string;
|
|
|
|
procedure FirstCheckCache;
|
|
//Test if Work is already in Cache
|
|
//if not it will be inserted
|
|
//Inspos saves the position
|
|
var
|
|
i : LongInt;
|
|
Begin
|
|
f:= NumberToString(Work);
|
|
IF slFirstChkCache.find(f,i) then
|
|
Begin
|
|
IF slFirstChkCache.Objects[i]<> NIL then
|
|
Begin
|
|
Related[num] := 2;
|
|
inc(RelCount);
|
|
end;
|
|
end
|
|
else
|
|
Begin
|
|
//memorize the number as Object
|
|
InsPos := slFirstChkCache.addObject(f,TObject(num));
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
fillchar(Related[1],Length(Related),#0);
|
|
relCount := 0;
|
|
|
|
slSeedCache := TStringList.create;
|
|
slSeedCache.sorted := true;
|
|
slSeedCache.duplicates := dupIgnore;
|
|
|
|
slFirstChkCache := TStringList.create;
|
|
slFirstChkCache.sorted := true;
|
|
slFirstChkCache.duplicates := dupIgnore;
|
|
|
|
setlength(Seeds,0);
|
|
|
|
num := 1;
|
|
repeat
|
|
s := IntToStr(num);
|
|
NumberFromString(Work, s);
|
|
|
|
findPos := -1;
|
|
InsPos := -1;
|
|
|
|
//early test if already in Cache
|
|
repeat
|
|
NumberAdd(Work);
|
|
IF (Work.nMaxPos = cChkDigit) then
|
|
Begin
|
|
FirstCheckCache;
|
|
BREAK;
|
|
end;
|
|
until PalinCheck(Work);
|
|
|
|
//IF new number of cChkDigit length inserted in Cache
|
|
IF (InsPos >= 0) AND NOT (PalinCheck(Work)) then
|
|
Begin
|
|
//check for lychrel
|
|
while Work.nMaxPos < cMaxDigit do
|
|
Begin
|
|
NumberAdd(Work);
|
|
if PalinCheck(Work) then
|
|
BREAK;
|
|
end;
|
|
|
|
if Work.nMaxPos >= cMaxDigit then
|
|
Begin
|
|
f := NumberToString(Work);
|
|
//new lychrel seed found
|
|
IF NOT(slSeedCache.find(f,findPos)) then
|
|
Begin
|
|
//memorize the number by misusing of Object
|
|
slSeedCache.addObject(f,TObject(num));
|
|
setlength(Seeds,length(Seeds)+1);
|
|
Seeds[High(Seeds)] := num;
|
|
Related[num] := 1;
|
|
end
|
|
else
|
|
Begin
|
|
//a new way to known lycrel seed found, so memorize it
|
|
Related[num] := 2;
|
|
inc(RelCount)
|
|
end
|
|
end
|
|
else
|
|
//mark slFirstChkCache[InsPos] as not_lychrel
|
|
slFirstChkCache.Objects[InsPos] := NIL;
|
|
end;
|
|
inc(num);
|
|
until num > cMAXNUM;
|
|
writeln ('Lychrel from 1 to ',cMAXNUM);
|
|
writeln('number of cached ',cChkDigit,' digit ',slFirstChkCache.Count);
|
|
writeln('number of lychrel seed ',length(Seeds):8);
|
|
IF length(Seeds) < 10 then
|
|
Begin
|
|
For InsPos:= 0 to High(Seeds)-1 do
|
|
write(Seeds[InsPos],',');
|
|
writeln(Seeds[High(seeds)]);
|
|
end;
|
|
writeln('number of lychrel related ',RelCount:8);
|
|
ShowPalinLychrel(Related);
|
|
slFirstChkCache.free;
|
|
slSeedCache.free;
|
|
setlength(Seeds,0);
|
|
end.
|
|
{
|
|
...
|
|
Lychrel from 1 to 100000000
|
|
number of cached 10 digit 7008
|
|
number of lychrel seed 3552
|
|
number of lychrel related 28802508
|
|
number of palindromatic lychrel 5074
|
|
|
|
real 0m48.634s
|
|
user 0m48.579s
|
|
sys 0m0.012s
|
|
}
|