Just another update
This commit is contained in:
Ingy döt Net
parent
a25938f123
commit
00a190b0a6
6591 changed files with 94363 additions and 23227 deletions
75
Task/Hamming-numbers/Pascal/hamming-numbers-1.pascal
Normal file
75
Task/Hamming-numbers/Pascal/hamming-numbers-1.pascal
Normal file
|
|
@ -0,0 +1,75 @@
|
|||
program HammNumb;
|
||||
{$IFDEF FPC}
|
||||
{$MODE DELPHI}
|
||||
{$OPTIMIZATION ON}
|
||||
{$ELSE}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
{
|
||||
type
|
||||
NativeUInt = longWord;
|
||||
}
|
||||
var
|
||||
pot : array[0..2] of NativeUInt;
|
||||
|
||||
function NextHammNumb(n:NativeUInt):NativeUInt;
|
||||
var
|
||||
q,p,nr : NativeUInt;
|
||||
begin
|
||||
repeat
|
||||
nr := n+1;
|
||||
n := nr;
|
||||
|
||||
p := 0;
|
||||
while NOT(ODD(nr)) do
|
||||
begin
|
||||
inc(p);
|
||||
nr := nr div 2;
|
||||
end;
|
||||
Pot[0]:= p;
|
||||
|
||||
p := 0;
|
||||
q := nr div 3;
|
||||
while q*3=nr do
|
||||
Begin
|
||||
inc(P);
|
||||
nr := q;
|
||||
q := nr div 3;
|
||||
end;
|
||||
Pot[1] := p;
|
||||
|
||||
p := 0;
|
||||
q := nr div 5;
|
||||
while q*5=nr do
|
||||
Begin
|
||||
inc(P);
|
||||
nr := q;
|
||||
q := nr div 5;
|
||||
end;
|
||||
Pot[2] := p;
|
||||
|
||||
until nr = 1;
|
||||
result:= n;
|
||||
end;
|
||||
|
||||
procedure Check;
|
||||
var
|
||||
i,n: NativeUint;
|
||||
begin
|
||||
n := 1;
|
||||
for i := 1 to 20 do
|
||||
begin
|
||||
n := NextHammNumb(n);
|
||||
write(n,' ');
|
||||
end;
|
||||
writeln;
|
||||
writeln;
|
||||
n := 1;
|
||||
for i := 1 to 1690 do
|
||||
n := NextHammNumb(n);
|
||||
writeln('No ',i:4,' | ',n,' = 2^',Pot[0],' 3^',Pot[1],' 5^',Pot[2]);
|
||||
end;
|
||||
|
||||
Begin
|
||||
Check;
|
||||
End.
|
||||
329
Task/Hamming-numbers/Pascal/hamming-numbers-2.pascal
Normal file
329
Task/Hamming-numbers/Pascal/hamming-numbers-2.pascal
Normal file
|
|
@ -0,0 +1,329 @@
|
|||
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.
|
||||
Loading…
Add table
Add a link
Reference in a new issue