Distribution of 0 digits in factorial series: Difference between revisions

added pascal
No edit summary
(added pascal)
Line 189:
<pre>Permanently below 0.16 at n = 47332
Execution time: (seconds: 190, nanosecond: 215845101)</pre>
=={{header|Pascal}}==
Doing the calculation in Base 1,000,000,000 like in [[Primorial_numbers#alternative]].<BR>
The most time consuming is converting to string and search for zeros.<BR>
Therefor I do not convert to string.I divide the base in sections of 3 digits with counting zeros in a lookup table.
<lang pascal>program Factorial;
{$IFDEF FPC} {$MODE DELPHI} {$Optimization ON,ALL} {$ENDIF}
uses
sysutils;
type
tMul = array of LongWord;
tpMul = pLongWord;
const
LongWordDec = 1000*1000*1000;
LIMIT = 50000;
var
CountOfZero : array[0..999] of byte;
SumOfRatio :array[0..LIMIT] of extended;
CoZ_Fac : array[0..LIMIT] of Uint32;
CoD_Fac : array[0..LIMIT] of Uint32;
 
procedure InitCoZ;
var
i,j : integer;
begin
fillchar(CountOfZero,SizeOf(CountOfZero),#0);
CountOfZero[0] := 3;
For i := 1 to 9 do
Begin
CountOfZero[i] := 2;
CountOfZero[10*i] := 2;
CountOfZero[100*i] := 2;
j := 10;
repeat
CountOfZero[j+i] := 1;
CountOfZero[10*j+i] := 1;
CountOfZero[10*(j+i)] := 1;
inc(j,10)
until j > 100;
end;
end;
 
function getFactorialDecDigits(n:NativeInt):NativeInt;
var
res: extended;
Begin
result := -1;
IF (n > 0) AND (n <= 1000*1000) then
Begin
res := 0;
repeat res := res+ln(n); dec(n); until n < 2;
result := trunc(res/ln(10))+1;
end;
end;
 
procedure OutMul(pMul:tpMul;Lmt :NativeInt);
//for checking purposes
Begin
write(pMul[lmt]);
For lmt := lmt-1 downto 0 do
write(Format('%.9d',[pMul[lmt]]));
writeln;
end;
 
function CheckForZero(pMul:tpMul;Lmt :NativeInt):NativeUint;
// Numbers in base 1,000,000,000 divide in 3 sections
var
s : string[15];
q,r : LongWord;
i : NativeInt;
begin
result := 0;
For i := 0 to Lmt-1 do
Begin
q := pMul[i];
r := q DIV 1000;
result +=CountOfZero[q-1000*r];
q := r;
r := q DIV 1000;
result +=CountOfZero[q-1000*r];
q := r;
r := q DIV 1000;
result +=CountOfZero[q-1000*r];
end;
q := pMul[lmt];
while q >= 1000 do
begin
r := q DIV 1000;
result +=CountOfZero[q-1000*r];
q := r;
end;
if q > 0 then
Begin
str(q,s);
For i := Length(s) downto 1 do
IF s[i] ='0' then
inc(result);
end;
end;
 
function GetCoD(pMul:tpMul;Lmt :NativeInt):NativeUint;
//calculate used digits
var
i : longWord;
begin
result := 9*Lmt;
i := pMul[Lmt];
while i > 1000 do
begin
i := i DIV 1000;
inc(result,3);
end;
while i > 0 do
begin
i := i DIV 10;
inc(result);
end;
end;
 
procedure getFactorialExact(n:NativeInt);
var
MulArr : tMul;
pMul : tpMul;
prod,carry : Uint64;
i,j,ul : NativeInt;
begin
i := getFactorialDecDigits(n) DIV 9 +10;
Setlength(MulArr,i);
pMul := @MulArr[0];
Ul := 0;
pMul[Ul]:= 1;
i := 1;
repeat
carry := 0;
For j := 0 to UL do
Begin
prod := i*pMul[j]+Carry;
Carry := prod Div LongWordDec;
pMul[j] := Prod - Carry*LongWordDec;
end;
 
IF Carry <> 0 then
Begin
inc(Ul);
pMul[UL]:= Carry;
End;
 
CoD_Fac[i] := GetCoD(pMul,UL);
CoZ_Fac[i] := CheckForZero(pMul,UL);
SumOfRatio[i] := SumOfRatio[i-1] + CoZ_Fac[i]/CoD_Fac[i];
inc(i);
until i> n;
end;
 
procedure Out_(i: integer);
begin
if i > LIMIT then
EXIT;
writeln(i:8,SumOfRatio[i]/i:18:15);
end;
var
i : integer;
Begin
InitCoZ;
SumOfRatio[0]:= 0;
CoD_Fac[0]:= 0;
CoZ_Fac[0]:= 0;
getFactorialExact(LIMIT);
Out_(100);
Out_(1000);
Out_(10000);
Out_(50000);
i := limit;
while i >0 do
Begin
if SumOfRatio[i]/i >0.16 then
break;
dec(i);
end;
inc(i);
writeln('First ratio < 0.16 ', i:8,SumOfRatio[i]/i:20:17);
end.</lang>
{{out}}
<pre>TIO.RUN
100 0.246753186167432
1000 0.203544551103165
10000 0.173003848241866
50000 0.159620054602269
First ratio < 0.16 47332 0.15999999579985665
Real time: 5.521 s CPU share: 98.03 % // 2.67s on 2200G freepascal 3.2.2</pre>
 
=={{header|Python}}==
Anonymous user