Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
379
Task/Humble-numbers/Pascal/humble-numbers.pas
Normal file
379
Task/Humble-numbers/Pascal/humble-numbers.pas
Normal file
|
|
@ -0,0 +1,379 @@
|
|||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$OPTIMIZATION ON,ALL}
|
||||
{$CODEALIGN proc=32,loop=1}
|
||||
{$ALIGN 16}
|
||||
{$ELSE}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
uses
|
||||
sysutils;
|
||||
const
|
||||
//PlInit(4); <= maxPrimFakCnt+1
|
||||
maxPrimFakCnt = 3;//3,7,11 to keep data 8-Byte aligned
|
||||
minElemCnt = 10;
|
||||
type
|
||||
tPrimList = array of NativeUint;
|
||||
tnumber = extended;
|
||||
tpNumber= ^tnumber;
|
||||
tElem = record
|
||||
n : tnumber;//ln(prime[0]^Pots[0]*...
|
||||
dummy: array[0..5] of byte;//extend extended to 16 byte
|
||||
Pots: array[0..maxPrimFakCnt] of word;
|
||||
end;
|
||||
tpElem = ^tElem;
|
||||
tElems = array of tElem;
|
||||
tElemArr = array [0..0] of tElem;
|
||||
tpElemArr = ^tElemArr;
|
||||
|
||||
tpFaktorRec = ^tFaktorRec;
|
||||
tFaktorRec = record
|
||||
frElems : tElems;
|
||||
frInsElems: tElems;
|
||||
frAktIdx : NativeUint;
|
||||
frMaxIdx : NativeUint;
|
||||
frPotNo : NativeUint;
|
||||
frActPot : NativeUint;
|
||||
frNextFr : tpFaktorRec;
|
||||
frActNumb: tElem;
|
||||
frLnPrime: tnumber;
|
||||
end;
|
||||
tArrFR = array of tFaktorRec;
|
||||
|
||||
//LoE == List of Elements
|
||||
function LoEGetNextElement(pFR :tpFaktorRec):tElem;forward;
|
||||
|
||||
var
|
||||
Pl : tPrimList;
|
||||
ActIndex : NativeUint;
|
||||
ArrInsert : tElems;
|
||||
|
||||
procedure PlInit(n: integer);
|
||||
const
|
||||
cPl : array[0..11] of byte=(2,3,5,7,11,13,17,19,23,29,31,37);
|
||||
var
|
||||
i : integer;
|
||||
Begin
|
||||
IF n>High(cPl)+1 then
|
||||
n := High(cPl)
|
||||
else
|
||||
IF n < 0 then
|
||||
n := 1;
|
||||
IF maxPrimFakCnt+1 < n then
|
||||
Begin
|
||||
writeln(' Need to compile with bigger maxPrimFakCnt ');
|
||||
Halt(0);
|
||||
end;
|
||||
setlength(Pl,n);
|
||||
dec(n);
|
||||
For i := 0 to n do
|
||||
Pl[i] := cPl[i];
|
||||
end;
|
||||
|
||||
procedure AusgabeElem(pElem: tElem;ShowPot:Boolean=false);
|
||||
var
|
||||
i : integer;
|
||||
Begin
|
||||
with pElem do
|
||||
Begin
|
||||
IF n < 23 then
|
||||
write(round(exp(n)),' ')
|
||||
else
|
||||
write('ln ',n:13:7);
|
||||
IF ShowPot then
|
||||
Begin
|
||||
For i := 0 to maxPrimFakCnt do
|
||||
write(' ',PL[i]:2,'^',Pots[i]);
|
||||
writeln
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoECreate(const Pl: tPrimList;var FA:tArrFR);
|
||||
var
|
||||
i : integer;
|
||||
Begin
|
||||
setlength(ArrInsert,100);
|
||||
setlength(FA,Length(PL));
|
||||
For i := 0 to High(PL) do
|
||||
with FA[i] do
|
||||
Begin
|
||||
//automatic zeroing
|
||||
IF i < High(PL) then
|
||||
Begin
|
||||
setlength(frElems,minElemCnt);
|
||||
setlength(frInsElems,minElemCnt);
|
||||
frNextFr := @FA[i+1]
|
||||
end
|
||||
else
|
||||
Begin
|
||||
setlength(frElems,2);
|
||||
setlength(frInsElems,0);
|
||||
frNextFr := NIL;
|
||||
end;
|
||||
frPotNo := i;
|
||||
frLnPrime:= ln(PL[i]);
|
||||
frMaxIdx := 0;
|
||||
frAktIdx := 0;
|
||||
frActPot := 1;
|
||||
With frElems[0] do
|
||||
Begin
|
||||
n := frLnPrime;
|
||||
Pots[i]:= 1;
|
||||
end;
|
||||
frActNumb := frElems[0];
|
||||
end;
|
||||
ActIndex := 0;
|
||||
end;
|
||||
|
||||
|
||||
procedure LoEFree(var FA:tArrFR);
|
||||
var
|
||||
i : integer;
|
||||
Begin
|
||||
For i := High(FA) downto Low(FA) do
|
||||
setlength(FA[i].frElems,0);
|
||||
setLength(FA,0);
|
||||
end;
|
||||
|
||||
function LoEGetActElem(pFr:tpFaktorRec):tElem;inline;
|
||||
Begin
|
||||
with pFr^ do
|
||||
result := frElems[frAktIdx];
|
||||
end;
|
||||
|
||||
function LoEGetActLstNumber(pFr:tpFaktorRec):tpNumber;inline;
|
||||
Begin
|
||||
with pFr^ do
|
||||
result := @frElems[frAktIdx].n;
|
||||
end;
|
||||
|
||||
procedure LoEIncInsArr(var a:tElems);
|
||||
Begin
|
||||
setlength(a,Length(a)*8 div 5);
|
||||
end;
|
||||
|
||||
procedure LoEIncreaseElems(pFr:tpFaktorRec;minCnt:NativeUint);
|
||||
var
|
||||
newLen: NativeUint;
|
||||
Begin
|
||||
with pFR^ do
|
||||
begin
|
||||
newLen := Length(frElems);
|
||||
minCnt := minCnt+frMaxIdx;
|
||||
repeat
|
||||
newLen := newLen*8 div 5 +1;
|
||||
until newLen > minCnt;
|
||||
setlength(frElems,newLen);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoEInsertNext(pFr:tpFaktorRec;Limit:tnumber);
|
||||
var
|
||||
pNum : tpNumber;
|
||||
pElems : tpElemArr;
|
||||
cnt,i,u : NativeInt;
|
||||
begin
|
||||
with pFr^ do
|
||||
Begin
|
||||
//collect numbers of heigher primes
|
||||
cnt := 0;
|
||||
pNum := LoEGetActLstNumber(frNextFr);
|
||||
while Limit > pNum^ do
|
||||
Begin
|
||||
frInsElems[cnt] := LoEGetNextElement(frNextFr);
|
||||
inc(cnt);
|
||||
IF cnt > High(frInsElems) then
|
||||
LoEIncInsArr(frInsElems);
|
||||
pNum := LoEGetActLstNumber(frNextFr);
|
||||
end;
|
||||
|
||||
if cnt = 0 then
|
||||
EXIT;
|
||||
|
||||
i := frMaxIdx;
|
||||
u := frMaxIdx+cnt+1;
|
||||
|
||||
IF u > High(frElems) then
|
||||
LoEIncreaseElems(pFr,cnt);
|
||||
|
||||
IF frPotNo = 0 then
|
||||
inc(ActIndex,u);
|
||||
//Merge
|
||||
pElems := @frElems[0];
|
||||
dec(cnt);
|
||||
dec(u);
|
||||
frMaxIdx:= u;
|
||||
repeat
|
||||
IF pElems^[i].n < frInsElems[cnt].n then
|
||||
Begin
|
||||
pElems^[u] := frInsElems[cnt];
|
||||
dec(cnt);
|
||||
end
|
||||
else
|
||||
Begin
|
||||
pElems^[u] := pElems^[i];
|
||||
dec(i);
|
||||
end;
|
||||
dec(u);
|
||||
until (i<0) or (cnt<0);
|
||||
IF i < 0 then
|
||||
For u := cnt downto 0 do
|
||||
pElems^[u] := frInsElems[u];
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoEAppendNext(pFr:tpFaktorRec;Limit:tnumber);
|
||||
var
|
||||
pNum : tpNumber;
|
||||
pElems : tpElemArr;
|
||||
i : NativeInt;
|
||||
begin
|
||||
with pFr^ do
|
||||
Begin
|
||||
i := frMaxIdx+1;
|
||||
pElems := @frElems[0];
|
||||
pNum := LoEGetActLstNumber(frNextFr);
|
||||
while Limit > pNum^ do
|
||||
Begin
|
||||
IF i > High(frElems) then
|
||||
Begin
|
||||
LoEIncreaseElems(pFr,10);
|
||||
pElems := @frElems[0];
|
||||
end;
|
||||
pElems^[i] := LoEGetNextElement(frNextFr);
|
||||
inc(i);
|
||||
pNum := LoEGetActLstNumber(frNextFr);
|
||||
end;
|
||||
inc(ActIndex,i);
|
||||
frMaxIdx:= i-1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoENextList(pFr:tpFaktorRec);
|
||||
var
|
||||
pElems : tpElemArr;
|
||||
j,PotNum : NativeInt;
|
||||
lnPrime : tnumber;
|
||||
begin
|
||||
with pFR^ do
|
||||
Begin
|
||||
//increase all Elements by factor
|
||||
pElems := @frElems[0];
|
||||
LnPrime := frLnPrime;
|
||||
PotNum := frPotNo;
|
||||
for j := frMaxIdx Downto 0 do
|
||||
with pElems^[j] do
|
||||
Begin
|
||||
n := LnPrime+n;
|
||||
inc(Pots[PotNum]);
|
||||
end;
|
||||
//x^j -> x^(j+1)
|
||||
j := frActPot+1;
|
||||
with frActNumb do
|
||||
begin
|
||||
n:= j*LnPrime;
|
||||
Pots[PotNum]:= j;
|
||||
end;
|
||||
frActPot := j;
|
||||
//if something follows
|
||||
IF frNextFr <> NIL then
|
||||
LoEInsertNext(pFR,frActNumb.n);
|
||||
frAktIdx := 0;
|
||||
end;
|
||||
end;
|
||||
|
||||
function LoEGetNextElementPointer(pFR :tpFaktorRec):tpElem;
|
||||
Begin
|
||||
with pFr^ do
|
||||
Begin
|
||||
IF frMaxIdx < frAktIdx then
|
||||
LoENextList(pFr);
|
||||
result := @frElems[frAktIdx];
|
||||
inc(frAktIdx);
|
||||
inc(ActIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
function LoEGetNextElement(pFR :tpFaktorRec):tElem;
|
||||
Begin
|
||||
with pFr^ do
|
||||
Begin
|
||||
result := frElems[frAktIdx];
|
||||
inc(frAktIdx);
|
||||
IF frMaxIdx < frAktIdx then
|
||||
LoENextList(pFr);
|
||||
inc(ActIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
function LoEGetNextNumber(pFR :tpFaktorRec):tNumber;
|
||||
Begin
|
||||
with pFr^ do
|
||||
Begin
|
||||
result := frElems[frAktIdx].n;
|
||||
inc(frAktIdx);
|
||||
IF frMaxIdx < frAktIdx then
|
||||
LoENextList(pFr);
|
||||
inc(ActIndex);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure LoEGetNumber(pFR :tpFaktorRec;no:NativeUint);
|
||||
Begin
|
||||
dec(no);
|
||||
while ActIndex < no do
|
||||
LoENextList(pFR);
|
||||
with pFr^ do
|
||||
frAktIdx := (no-(ActIndex-frMaxIdx)-1);
|
||||
end;
|
||||
|
||||
procedure first50;
|
||||
var
|
||||
FA: tArrFR;
|
||||
i : integer;
|
||||
Begin
|
||||
LoECreate(Pl,FA);
|
||||
write(1,' ');
|
||||
For i := 1 to 49 do
|
||||
AusgabeElem(LoEGetNextElement(@FA[0]));
|
||||
writeln;
|
||||
LoEFree(FA);
|
||||
end;
|
||||
|
||||
procedure GetDigitCounts(MaxDigit:Uint32);
|
||||
var
|
||||
T1,T0 : TDateTime;
|
||||
FA: tArrFR;
|
||||
i,j,LastCnt : NativeUint;
|
||||
Begin
|
||||
T0 := now;
|
||||
inc(MaxDigit);
|
||||
LoECreate(Pl,FA);
|
||||
i := 1;
|
||||
j := 0;
|
||||
writeln('Digits count total count ');
|
||||
repeat
|
||||
LastCnt := j;
|
||||
repeat
|
||||
inc(j);
|
||||
with LoEGetNextElementPointer(@FA[0])^ do
|
||||
IF (Pots[2]= i) AND (Pots[0]= i) then
|
||||
break;
|
||||
until false;
|
||||
writeln(i:4,j-LastCnt:12,j:15,(now-T0)*86.6e3:10:3,' s');
|
||||
LastCnt := j;
|
||||
inc(i);
|
||||
until i = MaxDigit;
|
||||
LoEFree(FA);
|
||||
T1 := now;
|
||||
writeln('Total number of humble numbers found: ',j);
|
||||
writeln('Running time: ',(T1-T0)*86.6e6:0:0,' ms');
|
||||
end;
|
||||
|
||||
Begin
|
||||
//check if PlInit(4); <= maxPrimFakCnt+1
|
||||
PlInit(4);// 3 -> 2,3,5/ 4 -> 2,3,5,7
|
||||
first50;
|
||||
GetDigitCounts(100);
|
||||
End.
|
||||
Loading…
Add table
Add a link
Reference in a new issue