330 lines
6.7 KiB
Plaintext
330 lines
6.7 KiB
Plaintext
program hammNumb;
|
|
{$IFDEF FPC}
|
|
{$MODE DELPHI}
|
|
{$OPTIMIZATION ON,ASMCSE,CSE,PEEPHOLE}
|
|
{$ALIGN 16}
|
|
{$ELSE}
|
|
{$APPTYPE CONSOLE}
|
|
{$ENDIF}
|
|
uses
|
|
sysutils;
|
|
const
|
|
maxPrimFakCnt = 3;//3 or 3+8 if tNumber= double, else -1 for extended to keep data aligned
|
|
minElemCnt = 10;
|
|
type
|
|
tPrimList = array of NativeUint;
|
|
tnumber = double;
|
|
tpNumber= ^tnumber;
|
|
tElem = record
|
|
n : tnumber;//ln(prime[0]^Pots[0]*...
|
|
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;
|
|
|
|
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;
|
|
setlength(Pl,n);
|
|
dec(n);
|
|
For i := 0 to n do
|
|
Pl[i] := cPl[i];
|
|
end;
|
|
|
|
procedure AusgabeElem(pElem: tElem);
|
|
var
|
|
i : integer;
|
|
Begin
|
|
with pElem do
|
|
Begin
|
|
IF n < 23 then
|
|
write(round(exp(n)):16)
|
|
else
|
|
write('ln ',n:13:7);
|
|
For i := 0 to maxPrimFakCnt do
|
|
write(' ',PL[i]:2,'^',Pots[i]);
|
|
end;
|
|
writeln
|
|
end;
|
|
|
|
//LoE == List of Elements
|
|
function LoEGetNextNumber(pFR :tpFaktorRec):tElem;forward;
|
|
|
|
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;
|
|
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;
|
|
Begin
|
|
with pFr^ do
|
|
result := frElems[frAktIdx];
|
|
end;
|
|
|
|
function LoEGetActLstNumber(pFr:tpFaktorRec):tpNumber;
|
|
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] := LoEGetNextNumber(frNextFr);
|
|
// writeln( 'Ins ',frInsElems[cnt].n:10:8,' < ',pNum^:10:8);
|
|
|
|
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
|
|
// writeln(i:10,cnt:10,u:10); writeln( pElems^[i].n:10:8,' < ',frInsElems[cnt].n:10:8);
|
|
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] := LoEGetNextNumber(frNextFr);
|
|
inc(i);
|
|
pNum := LoEGetActLstNumber(frNextFr);
|
|
end;
|
|
inc(ActIndex,i);
|
|
frMaxIdx:= i-1;
|
|
end;
|
|
end;
|
|
|
|
procedure LoENextList(pFr:tpFaktorRec);
|
|
var
|
|
pElems : tpElemArr;
|
|
j : NativeUint;
|
|
begin
|
|
with pFR^ do
|
|
Begin
|
|
//increase Elements by factor
|
|
pElems := @frElems[0];
|
|
for j := frMaxIdx Downto 0 do
|
|
with pElems^[j] do
|
|
Begin
|
|
n := n+frLnPrime;
|
|
inc(Pots[frPotNo]);
|
|
end;
|
|
//x^j -> x^(j+1)
|
|
j := frActPot+1;
|
|
with frActNumb do
|
|
begin
|
|
n:= j*frLnPrime;
|
|
Pots[frPotNo]:= j;
|
|
end;
|
|
frActPot := j;
|
|
//if something follows
|
|
IF frNextFr <> NIL then
|
|
LoEInsertNext(pFR,frActNumb.n);
|
|
frAktIdx := 0;
|
|
end;
|
|
end;
|
|
|
|
function LoEGetNextNumber(pFR :tpFaktorRec):tElem;
|
|
Begin
|
|
with pFr^ do
|
|
Begin
|
|
result := frElems[frAktIdx];
|
|
inc(frAktIdx);
|
|
IF frMaxIdx < frAktIdx then
|
|
LoENextList(pFr);
|
|
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;
|
|
|
|
var
|
|
T1,T0: tDateTime;
|
|
FA: tArrFR;
|
|
i : integer;
|
|
Begin
|
|
PlInit(3);// 3 -> 2,3,5
|
|
LoECreate(Pl,FA);
|
|
i := 1;
|
|
i := 1;
|
|
T0 := time;
|
|
|
|
For i := 1 to 20 do
|
|
AusgabeElem(LoEGetNextNumber(@FA[0]));
|
|
|
|
LoEGetNumber(@FA[0],1691);
|
|
AusgabeElem(LoEGetNextNumber(@FA[0]));
|
|
|
|
|
|
LoEGetNumber(@FA[0],1000*1000);
|
|
AusgabeElem(LoEGetNextNumber(@FA[0]));
|
|
LoEGetNumber(@FA[0],100*1000*1000);
|
|
T1 := time;
|
|
AusgabeElem(LoEGetNextNumber(@FA[0]));
|
|
Writeln('Timed 100*1000*1000 in ',FormatDateTime('HH:NN:SS.ZZZ',T1-T0));
|
|
|
|
|
|
Writeln('Actual Index ',ActIndex );
|
|
AusgabeElem(LoEGetNextNumber(@FA[0]));
|
|
For i := 0 to High(FA) do
|
|
writeln(pL[i]:2,
|
|
' elemcount ',FA[i].frMaxIdx+1:7,' out of',length(FA[i].frElems):7);
|
|
LoEFree(FA);
|
|
End.
|