110 lines
2.3 KiB
ObjectPascal
110 lines
2.3 KiB
ObjectPascal
program Primorial;
|
|
{$IFDEF FPC} {$MODE DELPHI} {$ENDIF}
|
|
uses
|
|
sysutils;
|
|
var
|
|
primes : array[0..1000000] of LongInt;
|
|
|
|
procedure InitSieve;
|
|
const
|
|
HiSieve = 15485864;
|
|
var
|
|
sieve: array of boolean;
|
|
i, j: NativeInt;
|
|
Begin
|
|
setlength(sieve,HiSieve);
|
|
fillchar(sieve[0],HiSieve,chr(ord(True)));
|
|
For i := 2 to Trunc(sqrt(HiSieve)) do
|
|
IF sieve[i] then Begin
|
|
j := i*i;repeat sieve[j]:= false;inc(j,i);until j>= HiSieve-1;end;
|
|
i:= 2;j:= 1;
|
|
repeat
|
|
IF sieve[i] then begin primes[j]:= i;inc(j) end;
|
|
inc(i);
|
|
until i > HiSieve;
|
|
primes[0] := 1;setlength(sieve,0);
|
|
end;
|
|
|
|
function getPrimorial(n:NativeInt):Uint64;
|
|
Begin
|
|
result := ORD(n>=0);
|
|
IF (n >= 0) AND (n < 16) then
|
|
repeat result := result*primes[n]; dec(n); until n < 1;
|
|
end;
|
|
|
|
function getPrimorialDecDigits(n:NativeInt):NativeInt;
|
|
var
|
|
res: extended;
|
|
Begin
|
|
result := -1;
|
|
IF (n > 0) AND (n <= 1000*1000) then
|
|
Begin
|
|
res := 0;
|
|
repeat res := res+ln(primes[n]); dec(n); until n < 1;
|
|
result := trunc(res/ln(10))+1;
|
|
end;
|
|
end;
|
|
|
|
function getPrimorialExact(n:NativeInt):NativeInt;
|
|
const
|
|
LongWordDec = 1000000000;
|
|
var
|
|
MulArr : array of LongWord;
|
|
pMul : ^LongWord;
|
|
Mul1,prod,carry : Uint64;
|
|
i,j,ul : NativeInt;
|
|
begin
|
|
i := getPrimorialDecDigits(n) DIV 9 +10;
|
|
Setlength(MulArr,i);
|
|
Ul := 0;
|
|
MulArr[Ul]:= 1;
|
|
i := 1;
|
|
repeat
|
|
Mul1 := 1;
|
|
//Make Mul1 as large as possible
|
|
while (i<= n) AND ((LongWordDec DIV MUL1) >= primes[i]) do
|
|
Begin Mul1 := Mul1*primes[i]; inc(i); end;
|
|
carry := 0;
|
|
pMul := @MulArr[0];
|
|
For j := 0 to UL do
|
|
Begin
|
|
prod := Mul1*pMul^+Carry;
|
|
Carry := prod Div LongWordDec;
|
|
pMul^ := Prod - Carry*LongWordDec;
|
|
inc(pMul);
|
|
end;
|
|
IF Carry <> 0 then Begin inc(Ul);pMul^:= Carry; End;
|
|
until i> n;
|
|
//count digits
|
|
i := Ul*9;
|
|
Carry := MulArr[Ul];
|
|
repeat
|
|
Carry := Carry DIV 10;
|
|
inc(i);
|
|
until Carry = 0;
|
|
result := i;
|
|
end;
|
|
|
|
|
|
var
|
|
i: NativeInt;
|
|
Begin
|
|
InitSieve;
|
|
write('Primorial (0->9) ');
|
|
For i := 0 to 9 do
|
|
write(getPrimorial(i),',');
|
|
writeln(#8#32#13#10);
|
|
i:= 10;
|
|
repeat
|
|
writeln('Primorial (',i,') = digits ',
|
|
getPrimorialDecDigits(i),' digits');
|
|
i := i*10;
|
|
until i> 1000000;
|
|
writeln;
|
|
i:= 10;
|
|
repeat
|
|
writeln('PrimorialExact (',i,') = digits ',
|
|
getPrimorialExact(i),' digits');
|
|
i := i*10;
|
|
until i> 100000;
|
|
end.
|