Rosetta Code

Smallest multiple: Difference between revisions

Page Discussion

Smallest multiple (view source)

Revision as of 08:41, 22 October 2021

224 bytes removed ,  2 years ago
m
→‎extended: extended to show count of digits til 2 billion
(julia example)
m (→‎extended: extended to show count of digits til 2 billion)
Line 167:
</pre>
===extended===
Findfascinating find, that the count of digits is nearly a constant x upper rangelimit.<br> The number of factors is the count of primes til limit.See GetFactorList.<br>No need for calculating lcm(lcm(lcm(1,2),3),4..) or prime decomposition and other contortions.<BR>
Using prime sieve.
<lang pascal>{$IFDEF FPC}
{$MODE DELPHI} {$Optimization On}
{$ELSE}
{$APPTAYPE CONSOLE}
Line 180:
{$ENDIF}
sysutils; //format
 
const
UpperLimitMAX_LIMIT = 2*1000*1000;
UpperLimit = MAX_LIMIT+1000;// so to find a prime beyond MAX_LIMIT
MAX_UINT64 = 46;
MAX_UINT64 = 46;// unused.Limit to get an Uint64 output
type
tFactors = array of Uint32;
tprimelist = array of byte;
var
primelistprimeDeltalist : tPrimelist;
factors,
 
saveFactors:tFactors;
saveFactorsIdx,
maxFactorsIdx : Uint32;
procedure Init_Primes;
var
pPrime : pByte;
p ,i,delta,cnt: NativeUInt;
begin
setlength(primelistprimeDeltalist,UpperLimit+3*8+1);
pPrime := @primelistprimeDeltalist[0];
//delete multiples of 2,3
i := 0;
Line 206 ⟶ 209:
inc(i,24);
until i>UpperLimit;
cnt := 2;// 2,3
p := 5;
delta := 1;//5-3
repeat
if pPrime[p] <> 0 then
Line 213 ⟶ 218:
if i > UpperLimit then
break;
inc(cnt);
pPrime[p-2*delta] := delta;
delta := 0;
repeat
pPrime[i] := 0;
Line 219 ⟶ 227:
end;
inc(p,2);
inc(delta);
until p*p>UpperLimit;
setlength(saveFactors,cnt);
pPrime[1] := 0;
//convert to delta
pPrime[2] := 1;
repeat
pPrime[3] := 1;
if pPrime[p]<> 0 then
begin
pPrime[p-2*delta] := delta;
inc(cnt);
delta := 0;
end;
inc(p,2);
inc(delta);
until p > UpperLimit;
setlength(factors,cnt);
factors[0] := 2;
factors[1] := 3;
i := 2;
p := 5;
repeat
factors[i] := p;
p += 2*pPrime[p];
i += 1;
until i >= cnt;
setlength(primeDeltalist,0);
// writeln(length(savefactors)); writeln(length(factors));
end;
 
{$IFDEF USE_GMP}
procedure ConvertToMPZ(const factors:tFactors;dgtCnt:UInt32);
const
c19Digits = QWord(10*1000000)*1000000*1000000;
var
mp,mpdiv : mpz_t;
s : AnsiString;
irest,last : integerUint64;
f : Uint32;
i :int32;
begin
//Init and allocate space
mpz_init(mp);
mpz_init_set_ui(mp,0);
mpz_init(mpdiv);
mpz_ui_pow_ui(mpdiv,10,dgtCnt);
mpz_add(mp,mp,mpdiv);
mpz_add_ui(mp,mp,1);
mpz_set_ui(mp,1);
 
for i := 0 to high(factors) do
i := maxFactorsIdx;
mpz_mul_ui(mp,mp,factors[i]);
irest := mpz_sizeinbase(mp,10)1;
repeat
setlength(s,i+10);
last := rest;
mpz_get_str(@s[1],10,mp);
i f := factors[i+10];
rest *= f;
while not(s[i] in['0'..'9']) do
if rest div f <> last then
begin
mpz_mul_ui(mp,mp,last);
rest := f;
end;
dec(i);
until i < 0;
setlength(s,i+1);
mpz_mul_ui(mp,mp,rest);
if length(s)> 22 then
 
If dgtcnt>40 then
begin
rest := mpz_fdiv_ui(mp,c19Digits);
move(s[i-9],s[13],10);
s[11] := '..';s[12]:= +Format('%.19u',[rest]);
mpz_fdiv_q_ui (mpdiv,mpdiv,c19Digits);
setlength(s,22);
mpz_fdiv_q(mp,mp,mpdiv);
rest := mpz_get_ui(mp);
writeln(rest:19,s);
mpz_clear(mpdiv);
end
else
Begin
setlength(s,dgtCnt+1000);
mpz_get_str(@s[1],10,mp);
writeln(s);
i := length(s);
while not(s[i] in['0'..'9']) do
dec(i);
setlength(s,i+1);
writeln(s);
end;
writeln(s);
mpz_clear(mp);
end;
Line 256 ⟶ 316:
procedure CheckDigits(const factors:tFactors);
var
digCntdgtcnt : extended;
i : integer;
begin
digcntdgtcnt := 0;
for i := 0 to high(factors) do;
repeat
digcnt += ln(factors[i]);
i : dgtcnt += trunc(digcnt/ln(10)+1factors[i]);
inc(i);
writeln(' has ',length(factors):10,' factors and ',i:10,' digits');
until i > maxFactorsIdx;
dgtcnt := trunc(dgtcnt/ln(10))+1;
writeln(' has ',maxFactorsIdx+1:10,' factors and ',dgtcnt:10:0,' digits');
{$IFDEF USE_GMP}
If i <i 10000:= thentrunc(dgtcnt);
if i < 1000*1000 then
ConvertToMPZ(factors);
ConvertToMPZ(factors,i);
{$ENDIF}
end;
Line 274 ⟶ 338:
i : integer;
begin
if length(factors)maxFactorsIdx >15 then
Exit(0);
result := 1;
for i := 0 to high(factors)maxFactorsIdx do
result *= factors[i];
end;
Line 287 ⟶ 351:
begin
result := '';
for i := 0 to high(factors)maxFactorsIdx-1 do
begin
str(factors[i],s);
result += s+'*';
end;
str(factors[High(factors)maxFactorsIdx],s);
result += s;
end;
Line 298 ⟶ 362:
procedure GetFactorList(var factors:tFactors;max:Uint32);
var
pPrimep,f,lf : pByteUint32;
n,f,lf : Uint32;
BEGIN
pPrimep := @primeList[0]2;
n := 2;
lf := 0;
saveFactors[lf] := p;
setlength(factors,lf);
while p*p <= max do
 
while n*n <= max do
Begin
if pPrimesaveFactors[nlf]<>0 then:= p;
beginf := p*p;
while f*p <= max do
setlength(factors,lf+1);
f :*= n*np;
factors[lf] := f;
while f*n <= max do
f*= ninc(lf);
p := factors[lf] := f;
if p= inc(lf)0 then HALT;
end;
inc(n);
end;
if lf>0 then
//the rest are all the primes up to max
saveFactorsIdx := lf-1;
For n := n to max do
repeat
if pPrime[n]<>0 then
Begininc(lf)
until setlength(factors,[lf+1)]>Max;
factors[lf]maxFactorsIdx := nlf-1;
inc(lf);
end;
end;
 
procedure Check(var factors:tFactors;max:Uint32);
var
i: Uint32;
begin
GetFactorList(factors,max);
write(max:10,': ');
if length(factors)maxFactorsIdx>15 then
CheckDigits(factors)
else
writeln(ConvertToUint64(factors):21,' = ',ConvertToStr(factors));
for i := 0 to saveFactorsIdx do
factors[i] := savefactors[i];
end;
 
var
factors:tFactors;
max: Uint32;
BEGIN
Init_Primes;
 
max := 2002;
repeat
check(factors,max);
max *=10;
until max > UpperLimitMAX_LIMIT;
 
For max := MAX_UINT64 downto 2 do
writeln;
For max := 10 to 20 do // < MAX_UINT64
check(factors,max);
{$IFDEF WINDOWS}
READLN;
{$ENDIF}
END.</lang>
</lang>
{{out}}
<pre style="height:300px">
TIO.RUN Real time: 01.203161 s User time: 01.147106 s Sys. time: 0.054049 s CPU share: 9899.8849 %
2002: has 46 factors and 2 90= digits2
20: 232792560 = 16*9*5*7*11*13*17*19
3372935888..0066992000
200: has 46 factors and 90 digits
3372935888329262646..8060677390066992000
2000: has 303 factors and 867 digits
1511177948774443153..3786415805463680000
1511177948..5463680000
20000: has 2262 factors and 8676 digits
4879325627288270518..7411295098112000000
4879325627..8112000000
200000: has 17984 factors and 86871 digits
3942319728529926377..9513860925440000000
2000000: has 148933 factors and 868639 digits
8467191629995920178..6480233472000000000
46: 9419588158802421600 = 32*27*25*7*11*13*17*19*23*29*31*37*41*43
{ at home
45: 9419588158802421600 = 32*27*25*7*11*13*17*19*23*29*31*37*41*43
20000000: has 1270607 factors and 8686151 digits
44: 9419588158802421600 = 32*27*25*7*11*13*17*19*23*29*31*37*41*43
1681437413936981958..6706037760000000000
43: 9419588158802421600 = 32*27*25*7*11*13*17*19*23*29*31*37*41*43
200000000: has 11078937 factors and 86857606 digits
42: 219060189739591200 = 32*27*25*7*11*13*17*19*23*29*31*37*41
2000000000: has 98222287 factors and 868583388 digits
41: 219060189739591200 = 32*27*25*7*11*13*17*19*23*29*31*37*41
}
40: 5342931457063200 = 32*27*25*7*11*13*17*19*23*29*31*37
39: 5342931457063200 = 32*27*25*7*11*13*17*19*23*29*31*37
38: 5342931457063200 = 32*27*25*7*11*13*17*19*23*29*31*37
37: 5342931457063200 = 32*27*25*7*11*13*17*19*23*29*31*37
36: 144403552893600 = 32*27*25*7*11*13*17*19*23*29*31
35: 144403552893600 = 32*27*25*7*11*13*17*19*23*29*31
34: 144403552893600 = 32*27*25*7*11*13*17*19*23*29*31
33: 144403552893600 = 32*27*25*7*11*13*17*19*23*29*31
32: 144403552893600 = 32*27*25*7*11*13*17*19*23*29*31
31: 72201776446800 = 16*27*25*7*11*13*17*19*23*29*31
30: 2329089562800 = 16*27*25*7*11*13*17*19*23*29
29: 2329089562800 = 16*27*25*7*11*13*17*19*23*29
28: 80313433200 = 16*27*25*7*11*13*17*19*23
27: 80313433200 = 16*27*25*7*11*13*17*19*23
26: 26771144400 = 16*9*25*7*11*13*17*19*23
25: 26771144400 = 16*9*25*7*11*13*17*19*23
24: 5354228880 = 16*9*5*7*11*13*17*19*23
23: 5354228880 = 16*9*5*7*11*13*17*19*23
22: 232792560 = 16*9*5*7*11*13*17*19
21: 232792560 = 16*9*5*7*11*13*17*19
20: 232792560 = 16*9*5*7*11*13*17*19
19: 232792560 = 16*9*5*7*11*13*17*19
18: 12252240 = 16*9*5*7*11*13*17
17: 12252240 = 16*9*5*7*11*13*17
16: 720720 = 16*9*5*7*11*13
15: 360360 = 8*9*5*7*11*13
14: 360360 = 8*9*5*7*11*13
13: 360360 = 8*9*5*7*11*13
12: 27720 = 8*9*5*7*11
11: 27720 = 8*9*5*7*11
10: 2520 = 8*9*5*7
911: 252027720 = 8*9*5*7*11
812: 84027720 = 8*39*5*7*11
713: 420360360 = 48*39*5*7*11*13
614: 60360360 = 48*39*5*7*11*13
515: 60360360 = 48*39*5*7*11*13
416: 12720720 = 416*9*5*7*11*313
317: 612252240 = 216*9*5*7*11*13*317
218: 212252240 = 216*9*5*7*11*13*17
19: 232792560 = 16*9*5*7*11*13*17*19
20: 232792560 = 16*9*5*7*11*13*17*19
</pre>
 
Anonymous user
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/316513"