Sphenic numbers: Difference between revisions
Content added Content deleted
m (→{{header|Phix}}: minor tidy) |
(→{{header|Phix}}: prepend Freepascal) |
||
Line 263: | Line 263: | ||
</syntaxhighlight> |
</syntaxhighlight> |
||
=={{header|Pascal}}== |
|||
==={{header|Free Pascal}}=== |
|||
{{trans|Wren}} Output Format {{trans|AppleScript}} |
|||
Most of the time, ~ 75% in this case, is spent with sort. |
|||
<syntaxhighlight lang=pascal> |
|||
program sphenic; |
|||
const |
|||
Limit= 1000*1000; |
|||
LimitPrime = Limit div (2*3); |
|||
primeCount = 15224; |
|||
var |
|||
primes : array of Uint32; |
|||
sphenics : array of Uint32; |
|||
procedure GetPrimes; |
|||
//trial division |
|||
var |
|||
p,p2,i,maxIdx,maxSqrtPrimeIdx : Uint32; |
|||
begin |
|||
setlength(Primes,primeCount); |
|||
primes[0] := 2; |
|||
maxIdx := 0; |
|||
maxSqrtPrimeIdx := 0; |
|||
p2:= sqr(primes[maxSqrtPrimeIdx]); |
|||
For p := 3 to LimitPrime do |
|||
begin |
|||
if p2 <=p then |
|||
begin |
|||
inc(maxSqrtPrimeIdx); |
|||
p2 := sqr(primes[maxSqrtPrimeIdx]); |
|||
end; |
|||
i := 0; |
|||
repeat |
|||
if p mod primes[i] = 0 then |
|||
BREAK; |
|||
inc(i); |
|||
until i >= maxSqrtPrimeIdx; |
|||
if i >= maxSqrtPrimeIdx then |
|||
begin |
|||
inc(maxIdx); |
|||
primes[maxIdx] := p; |
|||
end; |
|||
end; |
|||
setlength(primes,maxidx+1); |
|||
end; |
|||
procedure QuickSort(var A: array of Uint32); |
|||
procedure QSort(L, R: Int32); |
|||
var |
|||
I, J: Int32; |
|||
Tmp, Pivot: Uint32; |
|||
begin |
|||
if R - L < 1 then exit; |
|||
I := L; J := R; |
|||
{$push}{$q-}{$r-}Pivot := A[(L + R) shr 1];{$pop} |
|||
repeat |
|||
while A[I] < Pivot do Inc(I); |
|||
while A[J] > Pivot do Dec(J); |
|||
if I <= J then begin |
|||
Tmp := A[I]; |
|||
A[I] := A[J]; |
|||
A[J] := Tmp; |
|||
Inc(I); Dec(J); |
|||
end; |
|||
until I > J; |
|||
QSort(L, J); |
|||
QSort(I, R); |
|||
end; |
|||
begin |
|||
QSort(0, High(A)); |
|||
end; |
|||
function binary_search(value: Uint32): Int32; |
|||
var |
|||
p : Uint32; |
|||
l, m, h: UInt32; |
|||
begin |
|||
l := Low(primes); |
|||
h := High(primes); |
|||
while l <= h do |
|||
begin |
|||
m := (l + h) div 2; |
|||
p := primes[m]; |
|||
if p > value then |
|||
begin |
|||
h := m - 1; |
|||
end |
|||
else |
|||
begin |
|||
if p < value then |
|||
begin |
|||
l := m + 1; |
|||
end |
|||
else |
|||
exit(m); |
|||
end; |
|||
end; |
|||
binary_search:=m; |
|||
end; |
|||
procedure CreateSphenics; |
|||
var |
|||
i1,i2,i3, |
|||
idx1,idx2,idx3, |
|||
p1,p2,p,i : Uint32; |
|||
begin |
|||
i := 0; |
|||
idx1 := trunc(exp(1/3*ln(Limit))); |
|||
idx1 := binary_search(idx1)-1; |
|||
idx3 := idx1+2; |
|||
For i1 := 0 to idx1 do |
|||
begin |
|||
p1 := primes[i1]; |
|||
idx2 := trunc(sqrt(Limit DIV p1)); |
|||
idx2:= binary_search(idx2)+1; |
|||
For i2 := i1+1 to idx2 do |
|||
begin |
|||
p2:= p1*primes[i2]; |
|||
For i3 := i2+1 to High(primes) do |
|||
begin |
|||
p := p2*Primes[i3]; |
|||
if p > Limit then |
|||
break; |
|||
sphenics[i] := p; |
|||
inc(i); |
|||
end; |
|||
end; |
|||
end; |
|||
setlength(sphenics,i); |
|||
QuickSort(sphenics); |
|||
end; |
|||
procedure OutTriplet(i:Uint32); |
|||
begin |
|||
write('{',sphenics[i],',',sphenics[i+1],',',sphenics[i+2],'}'); |
|||
end; |
|||
function CheckTriplets(i:Uint32):boolean; |
|||
begin |
|||
CheckTriplets:= (sphenics[i]+1=sphenics[i+1]) AND |
|||
(sphenics[i+1]+1=sphenics[i+2]); |
|||
end; |
|||
var |
|||
i,j,t5000 : Uint32; |
|||
begin |
|||
GetPrimes; |
|||
setlength(sphenics,21*Limit div 100+100);//203,834,084 for Limit 1E9 |
|||
CreateSphenics; |
|||
writeln('Sphenic numbers < 1,000:'); |
|||
i := 1; |
|||
repeat |
|||
if sphenics[i] > 1000 then |
|||
break; |
|||
write(sphenics[i]:4); |
|||
if i Mod 15 = 0 then |
|||
writeln; |
|||
inc(i); |
|||
until i>= High(sphenics); |
|||
writeln; |
|||
writeln('Sphenic triplets < 10,000:'); |
|||
i := 0; |
|||
j := 0; |
|||
repeat |
|||
if CheckTriplets(i) then |
|||
Begin |
|||
OutTriplet(i); |
|||
inc(j); |
|||
if j < 3 then |
|||
write(',') |
|||
else |
|||
begin |
|||
writeln; |
|||
j := 0; |
|||
end; |
|||
end; |
|||
inc(i); |
|||
until sphenics[i+2]>10000; |
|||
writeln; |
|||
i := 0; |
|||
j := 0; |
|||
writeln('There are ',length(sphenics),' sphenic numbers < ',limit); |
|||
repeat |
|||
if CheckTriplets(i) then |
|||
Begin |
|||
inc(j); |
|||
if j = 5000 then |
|||
t5000 := i; |
|||
end; |
|||
inc(i); |
|||
until i+2 >high(sphenics); |
|||
writeln('There are ',j,' sphenic triplets numbers < ',limit); |
|||
writeln('The 200,000th sphenic number is ',sphenics[200000]); |
|||
write('The 5,000th sphenic triplet is ');OutTriplet(T5000); |
|||
end. |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
Sphenic numbers < 1,000: |
|||
30 42 66 70 78 102 105 110 114 130 138 154 165 170 174 |
|||
182 186 190 195 222 230 231 238 246 255 258 266 273 282 285 |
|||
286 290 310 318 322 345 354 357 366 370 374 385 399 402 406 |
|||
410 418 426 429 430 434 435 438 442 455 465 470 474 483 494 |
|||
498 506 518 530 534 555 561 574 582 590 595 598 602 606 609 |
|||
610 615 618 627 638 642 645 646 651 654 658 663 665 670 678 |
|||
682 705 710 715 730 741 742 754 759 762 777 782 786 790 795 |
|||
805 806 814 822 826 830 834 854 861 874 885 890 894 897 902 |
|||
903 906 915 935 938 942 946 957 962 969 970 978 986 987 994 |
|||
Sphenic triplets < 10,000: |
|||
{1309,1310,1311},{1885,1886,1887},{2013,2014,2015} |
|||
{2665,2666,2667},{3729,3730,3731},{5133,5134,5135} |
|||
{6061,6062,6063},{6213,6214,6215},{6305,6306,6307} |
|||
{6477,6478,6479},{6853,6854,6855},{6985,6986,6987} |
|||
{7257,7258,7259},{7953,7954,7955},{8393,8394,8395} |
|||
{8533,8534,8535},{8785,8786,8787},{9213,9214,9215} |
|||
{9453,9454,9455},{9821,9822,9823},{9877,9878,9879} |
|||
There are 206964 sphenic numbers < 1000000 |
|||
There are 5457 sphenic triplets numbers < 1000000 |
|||
The 200,000th sphenic number is 966467 |
|||
The 5,000th sphenic triplet is {918005,918006,918007} |
|||
</pre> |
|||
=={{header|Phix}}== |
=={{header|Phix}}== |
||
{{trans|Wren}} |
{{trans|Wren}} |