Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
297
Task/Lychrel-numbers/Pascal/lychrel-numbers.pas
Normal file
297
Task/Lychrel-numbers/Pascal/lychrel-numbers.pas
Normal file
|
|
@ -0,0 +1,297 @@
|
|||
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
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue