Rosetta Code

Greatest prime dividing the n-th cubefree number: Difference between revisions

Page Discussion

Greatest prime dividing the n-th cubefree number (view source)

Revision as of 06:42, 7 March 2024

67 bytes removed ,  3 months ago
m
→‎{{header|Free Pascal}}: corrected calculation of highest divisor
(→‎{{header|Free Pascal}}: sieving with cube of primes instead of factoring every numbers. 45-fold speed up)
m (→‎{{header|Free Pascal}}: corrected calculation of highest divisor)
Line 188:
program CubeFree2;
{$IFDEF FPC}
{$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$COPERATORS ON}
{$OPTIMIZATION ON,ALL}
//{$CODEALIGN proc=16,loop=8} //TIO.RUN (Intel Xeon 2.3 Ghz) loves it
{$COPERATORS ON}
{$ELSE}
{$APPTYPE CONSOLE}
Line 196 ⟶ 199:
{$IFDEF WINDOWS},Windows{$ENDIF}
;
type
tItem = Uint64;
const
SizeCube235 =24* (2*2*2* 3*3*3 *5*5*5);//2*27000 <= 64kb level I
type
tPrimeIdx = 0..65535;
Line 218 ⟶ 219:
Sieve : tSieve235;
DelCube : tDelCube;
 
function Numb2USA(n:Uint64):Ansistring;
const
//extend s by the count of comma to be inserted
deltaLength : array[0..24] of byte =
(0,0,0,0,1,1,1,2,2,2,3,3,3,4,4,4,5,5,5,6,6,6,7,7,7);
var
pI :pChar;
i,j : NativeInt;
Begin
str(n,result);
i := length(result);
//extend s by the count of comma to be inserted
// j := i+ (i-1) div 3;
j := i+deltaLength[i];
if i<> j then
Begin
setlength(result,j);
pI := @result[1];
dec(pI);
while i > 3 do
Begin
//copy 3 digits
pI[j] := pI[i];
pI[j-1] := pI[i-1];
pI[j-2] := pI[i-2];
// insert comma
pI[j-3] := ',';
dec(i,3);
dec(j,4);
end;
end;
end;
 
function highestDiv(n: uint64):Uint64;
var
pr : Uint64;
i : integer;
begin
i := 0;
result := n;
repeat
pr := Smallprimes[i];
if pr*pr>result then
BREAK;
if result MOD Smallprimes[i] = 0 then
result := result DIV Smallprimes[i];
inc(i);
until i > High(SmallPrimes);
end;
 
procedure OutNum(lmt,n:Uint64);
begin
writeln(Numb2Usa(lmt):18,Numb2Usa(n):19,Numb2Usa(highestDiv(n)):18);
end;
 
procedure InitSmallPrimes;
Line 317 ⟶ 263:
end;
 
functionprocedure Create235Init235(var Sieve235:tSieve235);
var
i,j,k : NativeInt;
begin
fillchar(resultSieve235,SizeOf(resultSieve235),Ord(true));
resultSieve235[0] := false;
for k in [2,3,5] do
Begin
Line 329 ⟶ 275:
while i < SizeCube235 do
begin
resultSieve235[i] := false;
inc(i,j);
end;
Line 349 ⟶ 295:
dlSivNum := r;
dlSivMod := q-r*SizeCube235;
end;
end;
end;
function Numb2USA(n:Uint64):Ansistring;
var
pI :pChar;
i,j : NativeInt;
Begin
str(n,result);
i := length(result);
//extend s by the count of comma to be inserted
j := i+ (i-1) div 3;
if i<> j then
Begin
setlength(result,j);
pI := @result[1];
dec(pI);
while i > 3 do
Begin
//copy 3 digits
pI[j] := pI[i];pI[j-1] := pI[i-1];pI[j-2] := pI[i-2];
// insert comma
pI[j-3] := ',';
dec(i,3);
dec(j,4);
end;
end;
end;
 
function highestDiv(n: uint64):Uint64;
//can test til 821641^2 ~ 6,75E11
var
pr : Uint64;
sieveNr,minIdx,maxIdx : Uint32;
i : integer;
begin
result := n;
i := 0;
repeat
pr := Smallprimes[i];
if pr*pr>result then
BREAK;
while (result > pr) AND (result MOD pr = 0) do
result := result DIV pr;
inc(i);
until i > High(SmallPrimes);
end;
 
procedure OutNum(lmt,n:Uint64);
begin
writeln(Numb2Usa(lmt):18,Numb2Usa(n):19,Numb2Usa(highestDiv(n)):18);
end;
 
 
var
sieveNr,minIdx,maxIdx : Uint32;
procedure SieveOneSieve;
var
Line 400 ⟶ 394:
T0 := GetTickCount64;
InitSmallPrimes;
Init235(Sieve235 := Create235);
InitDelCube(DelCube);
 
Line 425 ⟶ 419:
inc(i);
until cnt = lmt;
Writeln;
 
cnt := 0;
Line 443 ⟶ 438:
inc(sieveNr);
SieveOneSieve;
until lmt > 101*1000*1000*1000;
 
T0 := GetTickCount64-T0;
writeln('runtime ',T0/1000:0:3,' s');
Line 451 ⟶ 447:
<pre>
1 2 3 2 5 3 7 3 5 11
63 13 7 5 17 3 19 10 5 7 11
23 5 13 14 7 29 5 31 11 17 7
63 37 19 13 41 7 43 2211 15 5 23
47 7 5 17 2613 53 11 19 29 59
10 5 61 31 21 7 13 11 67 3417 23 7
71 73 37 5 3819 11 13 79 41 83
14 7 17 43 29 89 15 5 13 4623 31 47
19 97 7 3311 10 5 101 17 103 7 53
107 109 11 37 113 19 23 5829 3913 59
 
1,000 1,199 109
10,000 12,019 101
Line 466 ⟶ 463:
10,000,000 12,020,570 1,202,057
100,000,000 120,205,685 20,743
1,000,000,000 1,202,056,919 215,461 // TIO.RUN 2.4 s
10,000,000,000 12,020,569,022 1,322,977
100,000,000,000 120,205,690,298 145,823
Horst
132

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/361325"