Rosetta Code

Numbers which are the cube roots of the product of their proper divisors: Difference between revisions

Page Discussion

Numbers which are the cube roots of the product of their proper divisors (view source)

Revision as of 08:22, 7 April 2024

24,688 bytes added ,  2 months ago
m
Minor update to Forth code
(Added AppleScript.)
m (Minor update to Forth code)
 
(24 intermediate revisions by 18 users not shown)
Line 1:
{{draft task}}
 
;Example
Line 99:
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
500th: 2526
5000th: 23118
50000th: 223735
</pre>
 
=={{header|ALGOL W}}==
{{Trans|ALGOL 68}}
<syntaxhighlight lang="algolw">
begin % find some numbers which are the cube roots of the product of their %
% proper divisors %
% the Online Encyclopedia of Integer Sequences states that these %
% numbers are 1 and those with eight divisors %
% NB: numbers with 8 divisors have 7 proper divisors %
 
integer MAX_NUMBER; % maximum number we will consider %
MAX_NUMBER := 500000;
 
begin
% form a table of proper divisor counts - pretend the pdc of 1 is 7 %
integer array pdc ( 1 :: MAX_NUMBER );
integer nextToShow, cCount;
for i := 1 until MAX_NUMBER do pdc( i ) := 1;
pdc( 1 ) := 7;
for i := 2 until MAX_NUMBER do begin
for j := i + i step i until MAX_NUMBER do pdc( j ) := pdc( j ) + 1
end;
% show the numbers which are the cube root of their proper divisor %
% product - equivalent to finding the numbers with a proper divisor %
% count of 7 ( we have "cheated" and set the pdc of 1 to 7 ) %
nextToShow := 500;
cCount := 0;
for n := 1 until MAX_NUMBER do begin
if pdc( n ) = 7 then begin
% found a suitable number %
cCount := cCount + 1;
if cCount <= 50 then begin
writeon( i_w := 3, s_w := 0, " ", n );
if cCount rem 10 = 0 then write()
end
else if cCount = nextToShow then begin
write( i_w := 9, s_w := 0, cCount, "th: ", i_w := 1, n );
nextToShow := nextToShow * 10
end if_various_cCount_values
end if_pdc_n_eq_7
end for_m
end
end.
</syntaxhighlight>
{{out}}
<pre>
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
 
500th: 2526
5000th: 23118
Line 105 ⟶ 161:
 
=={{header|AppleScript}}==
ThisLike tooother doessolutions thehere, this checks for numbers having "seven proper divisors" test rather than doing the multiplications, which saves time and avoids products that are too large for AppleScript numbers.
<syntaxhighlight lang="applescript">on properDivisors(n)
set output to {}
Line 137 ⟶ 193:
 
on task()
set output to {"First 50 numbers whose cubes are the products of their proper divisors:"}, ¬
"(and of course whose fourth powers are the products of ALL their positive divisors):"}
set pad to " "
set n to 1
set foundfirst50 to {" 1"}
repeat 49 times
set subgroup to {text -5 thru -1 of (" " & n)}
repeat
set n to n + 1
ifrepeat until ((count properDivisors(n)) = 7) then
set foundn to foundn + 1
end if (found > 5000) thenrepeat
set end of first50 to text -5 thru if-1 of (foundpad =& 50000n) then
end repeat
set end of output to "50,000th: " & text -6 thru -1 of (" " & n)
repeat with i from 1 to 41 by exit repeat10
set end of output to join(first50's items i endthru (i + 9), if"")
end repeat
else if (found > 500) then
set |count| to 50
if (found = 5000) then set end of output to " 5,000th: " & text -6 thru -1 of (" " & n)
repeat with target in {500, 5000, 50000}
else if (found > 50) then
repeat with |count| from (|count| + 1) to target
if (found = 500) then set end of output to " 500th: " & text -6 thru -1 of (" " & n)
elseset n to n + 1
repeat until ((count set end of subgroup to text -5 thru -1 of properDivisors("n)) = " & n7)
ifset (foundn modto 10n =+ 0) then1
set end of output to join(subgroup, "")repeat
end set subgroup to {}repeat
set end of output to text -6 thru -1 of (pad & |count|) & "th: " & text -6 thru -1 of (pad & n)
end if
end if
end if
end repeat
Line 170 ⟶ 225:
 
{{output}}
<syntaxhighlight lang="applescript">"First 50 numbers whose cubes are the products of their proper divisors:
(and of course whose fourth powers are the products of ALL their positive divisors):
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
Line 177 ⟶ 233:
255 258 266 273 282 285 286 290 296 297
500th: 2526
5,000th 5000th: 23118
50,000th 50000th: 223735"</syntaxhighlight>
 
=={{header|Arturo}}==
 
<syntaxhighlight lang="arturo">prints "First 50 numbers which are the cube root of the product of their proper divisors:"
 
[i n]: [0 0]
while -> i < 50000 [
if or? 1=n 8=size factors n [
if i < 50 [
if zero? i % 10 -> prints "\n"
prints pad ~"|n|" 4
]
if 50=i -> print "\n"
if in? i [499 4999 49999] -> print [pad ~"|i+1|th:" 8 n]
'i+1
]
'n+1
]</syntaxhighlight>
 
{{out}}
 
<pre>First 50 numbers which are the cube root of the product of their proper divisors:
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
 
500th: 2526
5000th: 23118
50000th: 223735</pre>
 
=={{header|BASIC}}==
Line 215 ⟶ 302:
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
==={{header|Chipmunk Basic}}===
{{works with|Chipmunk Basic|3.6.4}}
<syntaxhighlight lang="qbasic">100 limite = 500000
110 dim pdc(limite)
120 for i = 1 to ubound(pdc)
130 pdc(i) = 1
140 next i
150 pdc(1) = 7
160 for i = 2 to ubound(pdc)
170 for j = i+i to ubound(pdc) step i
180 pdc(j) = pdc(j)+1
190 next j
200 next i
210 n5 = 500
220 cnt = 0
230 print "First 50 numbers which are the cube roots"
240 print "of the products of their proper divisors:"
250 for i = 1 to ubound(pdc)
260 if pdc(i) = 7 then
270 cnt = cnt+1
280 if cnt <= 50 then
290 print using "####";i;
300 if cnt mod 10 = 0 then print
310 else
320 if cnt = n5 then
321 print
330 print using "#########";cnt;
335 print "th: "; i;
340 n5 = n5*10
350 endif
360 endif
370 endif
380 next i
385 print
390 end</syntaxhighlight>
{{out}}
<pre>Similar to FreeBASIC entry.</pre>
 
==={{header|True BASIC}}===
Line 334 ⟶ 459:
{{out}}
<pre>Same as FreeBASIC entry.</pre>
 
=={{header|C}}==
{{trans|Wren}}
The faster version.
<syntaxhighlight lang="c">#include <stdio.h>
#include <locale.h>
 
int divisorCount(int n) {
int i, j, count = 0, k = !(n%2) ? 1 : 2;
for (i = 1; i*i <= n; i += k) {
if (!(n%i)) {
++count;
j = n/i;
if (j != i) ++count;
}
}
return count;
}
 
int main() {
int i, numbers50[50], count = 0, n = 1, dc;
printf("First 50 numbers which are the cube roots of the products of their proper divisors:\n");
setlocale(LC_NUMERIC, "");
while (1) {
dc = divisorCount(n);
if (n == 1|| dc == 8) {
++count;
if (count <= 50) {
numbers50[count-1] = n;
if (count == 50) {
for (i = 0; i < 50; ++i) {
printf("%3d ", numbers50[i]);
if (!((i+1) % 10)) printf("\n");
}
}
} else if (count == 500) {
printf("\n500th : %'d\n", n);
} else if (count == 5000) {
printf("5,000th : %'d\n", n);
} else if (count == 50000) {
printf("50,000th: %'d\n", n);
break;
}
}
++n;
}
return 0;
}</syntaxhighlight>
 
{{out}}
<pre>
First 50 numbers which are the cube roots of the products of their proper divisors:
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
 
500th : 2,526
5,000th : 23,118
50,000th: 223,735
</pre>
 
=={{header|C#|CSharp}}==
Inspired by the C++ version, optimized the divisor count function a bit, as stretch was extended to five million.
<syntaxhighlight lang="csharp">using System;
class Program {
 
static bool dc8(uint n) {
uint res = 1, count, p, d;
for ( ; (n & 1) == 0; n >>= 1) res++;
for (count = 1; n % 3 == 0; n /= 3) count++;
for (p = 5, d = 4; p * p <= n; p += d = 6 - d)
for (res *= count, count = 1; n % p == 0; n /= p) count++;
return n > 1 ? res * count == 4 : res * count == 8;
}
 
static void Main(string[] args) {
Console.WriteLine("First 50 numbers which are the cube roots of the products of "
+ "their proper divisors:");
for (uint n = 1, count = 0, lmt = 500; count < 5e6; ++n) if (n == 1 || dc8(n))
if (++count <= 50) Console.Write("{0,3}{1}",n, count % 10 == 0 ? '\n' : ' ');
else if (count == lmt) Console.Write("{0,16:n0}th: {1:n0}\n", count, n, lmt *= 10);
}
}</syntaxhighlight>
 
{{out}}
<pre>First 50 numbers which are the cube roots of the products of their proper divisors:
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
500th: 2,526
5,000th: 23,118
50,000th: 223,735
500,000th: 2,229,229
5,000,000th: 22,553,794</pre>
 
=={{header|C++}}==
Line 382 ⟶ 605:
50,000th: 223,735
</pre>
 
=={{header|Delphi}}==
{{works with|Delphi|6.0}}
{{libheader|SysUtils,StdCtrls}}
 
 
<syntaxhighlight lang="Delphi">
function GetAllProperDivisors(N: Integer;var IA: TIntegerDynArray): integer;
{Make a list of all the "proper dividers" for N}
{Proper dividers are the of numbers the divide evenly into N}
var I: integer;
begin
SetLength(IA,0);
for I:=1 to N-1 do
if (N mod I)=0 then
begin
SetLength(IA,Length(IA)+1);
IA[High(IA)]:=I;
end;
end;
 
function CubeTest(N: int64): boolean;
{Test is N^3 = product of proper dividers}
var IA: TIntegerDynArray;
var P: int64;
var I: integer;
begin
GetAllProperDivisors(N,IA);
P:=1;
for I:=0 to High(IA) do P:=P * IA[I];
Result:=P=(N*N*N);
end;
 
 
procedure ShowCubeEqualsProper(Memo: TMemo);
{Show set the of N^3 = product of proper dividers}
var I,Cnt: integer;
var S: string;
begin
{Show the first 50}
Cnt:=0;
for I:=1 to High(Integer) do
if CubeTest(I) then
begin
Inc(Cnt);
S:=S+Format('%8D',[I]);
If (Cnt mod 5)=0 then S:=S+#$0D#$0A;
if Cnt>=50 then break;
end;
Memo.Lines.Add(S);
{Show 500th, 5,000th and 50,000th}
Cnt:=0;
for I:=1 to High(Integer) do
if CubeTest(I) then
begin
Inc(Cnt);
 
if Cnt=500 then Memo.Lines.Add('500th = '+IntToStr(I));
if Cnt=5000 then Memo.Lines.Add('5,000th = '+IntToStr(I));
if Cnt=50000 then
begin
Memo.Lines.Add('50,000th = '+IntToStr(I));
break;
end;
end;
end;
 
 
</syntaxhighlight>
{{out}}
<pre>
1 24 30 40 42
54 56 66 70 78
88 102 104 105 110
114 128 130 135 136
138 152 154 165 170
174 182 184 186 189
190 195 222 230 231
232 238 246 248 250
255 258 266 273 282
285 286 290 296 297
 
500th = 2526
5,000th = 23118
50,000th = 223735
Elapsed Time: 01:34.624 min
</pre>
 
 
=={{header|EasyLang}}==
{{trans|Lua}}
<syntaxhighlight lang=easylang>
func has8divs n .
if n = 1
return 1
.
cnt = 2
sqr = sqrt n
for d = 2 to sqr
if n mod d = 0
cnt += 1
if d <> sqr
cnt += 1
.
if cnt > 8
return 0
.
.
.
if cnt = 8
return 1
.
return 0
.
while count < 50
x += 1
if has8divs x = 1
write x & " "
count += 1
.
.
while count < 50000
x += 1
if has8divs x = 1
count += 1
if count = 500 or count = 5000 or count = 50000
print count & "th: " & x
.
.
.
</syntaxhighlight>
 
=={{header|Factor}}==
Line 454 ⟶ 808:
{{trans|FreeBASIC}}
<syntaxhighlight lang="forth"h>500000 constant limit
variablecreate pdc limit cells allot
 
: main
Line 569 ⟶ 923:
50,000th: 223,735
</pre>
 
=={{header|Haskell}}==
<syntaxhighlight lang=Haskell>import Data.List (group, intercalate, transpose)
import Data.List.Split (chunksOf)
import Data.Numbers.Primes ( primeFactors )
import Text.Printf (printf)
 
 
----------------------- OEIS A111398 ---------------------
 
oeisA111398 :: [Integer]
oeisA111398 = 1 : [n | n <- [1..], 8 == length (divisors n)]
 
 
divisors :: Integer -> [Integer]
divisors =
foldr
(flip ((<*>) . fmap (*)) . scanl (*) 1)
[1]
. group
. primeFactors
 
--------------------------- TEST -------------------------
 
main :: IO ()
main = do
putStrLn $ table " " $ chunksOf 10 $
take 50 (show <$> oeisA111398)
mapM_ print $
(,) <*> ((oeisA111398 !!) . pred) <$> [500, 5000, 50000]
------------------------- DISPLAY ------------------------
 
table :: String -> [[String]] -> String
table gap rows =
let ws = maximum . fmap length <$> transpose rows
pw = printf . flip intercalate ["%", "s"] . show
in unlines $ intercalate gap . zipWith pw ws <$> rows</syntaxhighlight>
{{Out}}
<pre> 1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
 
(500,2526)
(5000,23118)
(50000,223735)</pre>
 
=={{header|J}}==
Line 588 ⟶ 992:
49999{N
223735</syntaxhighlight>
 
=={{header|Java}}==
<syntaxhighlight lang="java">
public final class NumbersCubeRootProductProperDivisors {
 
public static void main(String[] aArgs) {
System.out.println("The first 50 numbers which are the cube roots"
+ " of the products of their proper divisors:");
for ( int n = 1, count = 0; count < 50_000; n++ ) {
if ( n == 1 || divisorCount(n) == 8 ) {
count += 1;
if ( count <= 50 ) {
System.out.print(String.format("%4d%s", n, ( count % 10 == 0 ? "\n" : "") ));
} else if ( count == 500 || count == 5_000 || count == 50_000 ) {
System.out.println(String.format("%6d%s%d", count, "th: ", n));
}
}
}
}
private static int divisorCount(int aN) {
int result = 1;
while ( ( aN & 1 ) == 0 ) {
result += 1;
aN >>= 1;
}
for ( int p = 3; p * p <= aN; p += 2 ) {
int count = 1;
while ( aN % p == 0 ) {
count += 1;
aN /= p;
}
result *= count;
}
if ( aN > 1 ) {
result *= 2;
}
return result;
}
 
}
</syntaxhighlight>
{{ out }}
<pre>
The first 50 numbers which are the cube roots of the products of their proper divisors:
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
500th: 2526
5000th: 23118
50000th: 223735
</pre>
 
=={{header|Julia}}==
 
<syntaxhighlight lang="julia">
using Printf
 
function proper_divisors(n::Integer)
uptosqr = 1:isqrt(n)
divs = Iterators.filter(uptosqr) do m
n % m == 0
end
pd_pairs = Iterators.map(divs) do d1
d2 = div(n, d1)
(d1 == d2 || d1 == 1) ? (d1,) : (d1, d2)
end
return Iterators.flatten(pd_pairs)
end
 
function show_divisors_print(n::Integer, found::Integer)
if found <= 50
@printf "%5i" n
if found % 10 == 0
println()
end
elseif found in (500, 5_000, 50_000)
th = "$(found)th: "
@printf "%10s%i\n" th n
end
end
 
function show_divisors()
found = 0
n = 1
while found <= 50_000
pds = proper_divisors(n)
if n^3 == prod(pds)
found += 1
show_divisors_print(n, found)
end
n += 1
end
end
 
show_divisors()
</syntaxhighlight>
 
{{Output}}
<pre>
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
500th: 2526
5000th: 23118
50000th: 223735
</pre>
 
=={{header|jq}}==
Line 651 ⟶ 1,168:
5000th: 23118
50000th: 223735
</pre>
 
=={{header|Lua}}==
The OEIS page gives a formula of "1 together with numbers with 8 divisors", so that's what we test.
<syntaxhighlight lang="lua">function is_1_or_has_eight_divisors (n)
if n == 1 then return true end
local divCount, sqr = 2, math.sqrt(n)
for d = 2, sqr do
if n % d == 0 then
divCount = d == sqr and divCount + 1 or divCount + 2
end
if divCount > 8 then return false end
end
return divCount == 8
end
 
-- First 50
local count, x = 0, 0
while count < 50 do
x = x + 1
if is_1_or_has_eight_divisors(x) then
io.write(x .. " ")
count = count + 1
end
end
 
-- 500th, 5,000th and 50,000th
while count < 50000 do
x = x + 1
if is_1_or_has_eight_divisors(x) then
count = count + 1
if count == 500 then print("\n\n500th: " .. x) end
if count == 5000 then print("5,000th: " .. x) end
end
end
print("50,000th: " .. x)</syntaxhighlight>
{{out}}
<pre>1 24 30 40 42 54 56 66 70 78 88 102 104 105 110 114 128 130 135 136 138 152 154 165 170 174 182 184 186 189 190 195 222 230 231 232 238 246 248 250 255 258 266 273 282 285 286 290 296 297
 
500th: 2526
5,000th: 23118
50,000th: 223735</pre>
 
=={{header|Maxima}}==
<syntaxhighlight lang="maxima">
croot_prod_prop_divisors(n):=block([i:1,count:0,result:[]],
while count<n do (if apply("*",rest(listify(divisors(i)),-1))=i^3 then (result:endcons(i,result),count:count+1),i:i+1),
result)$
 
/* Test cases */
croot_prod_prop_divisors(50);
 
last(croot_prod_prop_divisors(500));
 
last(croot_prod_prop_divisors(5000));
</syntaxhighlight>
{{out}}
<pre>
[1,24,30,40,42,54,56,66,70,78,88,102,104,105,110,114,128,130,135,136,138,152,154,165,170,174,182,184,186,189,190,195,222,230,231,232,238,246,248,250,255,258,266,273,282,285,286,290,296,297]
 
2526
 
23118
</pre>
 
=={{header|Nim}}==
We use an iterator rather than storing the divisors in a sequence. This prevent to optimize by checking the number of divisors, but the program is actually more efficient this way as there is no allocations. It runs in about 400 ms on an Intel Core i5-8250U CPU @ 1.60GHz × 4.
<syntaxhighlight lang="Nim">import std/strformat
 
iterator properDivisors(n: Positive): Positive =
## Yield the proper divisors, except 1.
var d = 2
while d * d <= n:
if n mod d == 0:
yield d
let q = n div d
if q != d: yield q
inc d
 
iterator a111398(): (int, int) =
## Yield the successive elements of the OEIS A111398 sequence.
yield (1, 1)
var idx = 1
var n = 1
while true:
inc n
var p = 1
block Check:
let n3 = n * n * n
for d in properDivisors(n):
p *= d
if p > n3: break Check # Two large: try next value.
if n3 == p:
inc idx
yield (idx, n)
 
echo "First 50 numbers which are the cube roots of the products of their proper divisors:"
for (i, n) in a111398():
if i <= 50:
stdout.write &"{n:>3}"
stdout.write if i mod 10 == 0: '\n' else: ' '
stdout.flushFile
elif i in [500, 5000, 50000]:
echo &"{i:>5}th: {n:>6}"
if i == 50000: break
</syntaxhighlight>
 
{{out}}
<pre>First 50 numbers which are the cube roots of the products of their proper divisors:
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
500th: 2526
5000th: 23118
50000th: 223735
</pre>
 
=={{header|Pascal}}==
==={{header|Free Pascal}}===
As stated, the result are the numbers with 8 = 2^3 divisors.Therefor only numbers with prime decomposition of the form:<br>
8 = 2^3 ( all powers+1 must be a power of 2 )<br>
a^7 , a^3*b ( a <> b) and a*b*c (a>b>c ( oBdA ) ), of cause all prime<br>
Avoid sorting by using an array of limit size for only marking those numbers.
<syntaxhighlight lang="pascal">
program Root3rd_divs_n.pas;
{$IFDEF FPC}
{$MODE DELPHI} {$OPTIMIZATION ON,ALL} {$COPERATORS ON}
{$ENDIF}
{$IFDEF WINDOWS}
{$APPTYPE CONSOLE}
{$ENDIF}
uses
sysutils
{$IFDEF WINDOWS},Windows{$ENDIF}
;
const
limit = 110*1000 *1000;
var
sol : array [0..limit] of byte;
primes : array of Uint32;
gblCount: Uint64;
 
procedure SievePrimes(lmt:Uint32);
var
sieve : array of byte;
p,i,delta : NativeInt;
Begin
setlength(sieve,lmt DIV 2);
//estimate count of prime
i := trunc(lmt/(ln(lmt)-1.1));
setlength(primes,i);
p := 1;
repeat
delta := 2*p+1;
// ((2*p+1)^2 ) -1)/ 2 = ((4*p*p+4*p+1) -1)/2 = 2*p*(p+1)
i := 2*p*(p+1);
if i>High(sieve) then
BREAK;
while i <= High(sieve) do
begin
sieve[i] := 1;
i += delta;
end;
repeat
inc(p);
until sieve[p] = 0;
until false;
 
primes[0] := 2;
i := 1;
For p := 1 to High(sieve) do
if sieve[p] = 0 then
begin
primes[i] := 2*p+1;
inc(i);
end;
setlength(primes,i);
end;
 
procedure Get_a7;
var
q3,n : UInt64;
i : nativeInt;
begin
sol[1] := 1;
gblCount +=1;
For i := 0 to High(primes) do
begin
q3 := primes[i];
n := sqr(sqr(sqr(q3))) DIV q3;
if n > limit then
break;
sol[n] := 1;
gblCount +=1;
end;
end;
 
procedure Get_a3_b;
var
i,j,q3,n : nativeInt;
begin
For i := 0 to High(primes) do
begin
q3 := primes[i];
q3 := q3*q3*q3;
if q3 > limit then
BREAK;
For j := 0 to High(primes) do
begin
if j = i then
continue;
n := Primes[j]*q3;
if n > limit then
BREAK;
sol[n] := 1;
gblCount +=1;
end;
end;
end;
 
procedure Get_a_b_c;
var
i,j,k,q1,q2,n : nativeInt;
begin
For i := 0 to High(primes)-2 do
begin
q1 := primes[i];
For j := i+1 to High(primes)-1 do
Begin
q2:= q1*Primes[j];
if q2 > limit then
BREAK;
For k := j+1 to High(primes) do
Begin
n:= q2*Primes[k];
if n > limit then
BREAK;
sol[n] := 1;
gblCount +=1;
end;
end;
end;
end;
 
var
i,cnt,lmt : Int32;
begin
SievePrimes(limit DIV 6);// 2*3*c * (c> 3 prime)
 
gblCount := 0;
Get_a7;
Get_a3_b;
Get_a_b_c;
 
Writeln('First 50 numbers which are the cube roots of the products of their proper divisors:');
cnt := 0;
i := 1;
 
while cnt < 50 do
begin
if sol[i] <> 0 then
begin
write(i:5);
cnt +=1;
if cnt mod 10 = 0 then writeln;
end;
inc(i);
end;
dec(i);
lmt := 500;
repeat
while cnt < lmt do
begin
inc(i);
if sol[i] <> 0 then
cnt +=1;
if i > limit then
break;
end;
if i > limit then
break;
writeln(lmt:8,'.th:',i:12);
lmt *= 10;
until lmt> limit;
writeln('Total found: ', gblCount, ' til ',limit);
end.</syntaxhighlight>
{{out|@TIO.RUN}}
<pre>
First 50 numbers which are the cube roots of the products of their proper divisors:
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
500.th: 2526
5000.th: 23118
50000.th: 223735
Total found: 243069 til 1100000
 
Real time: 0.144 s CPU share: 99.00 %
..
500000.th: 2229229
5000000.th: 22553794
Total found: 24073906 til 110000000
 
Real time: 1.452 s CPU share: 99.05 %
</pre>
 
Line 1,091 ⟶ 1,916:
 
Fifty thousandth: 223,735</pre>
=={{header|RPL}}==
<code>PRODIV</code> is defined at [[Product of divisors#RPL|Product of divisors]]
{{works with|Halcyon Calc|4.2.7}}
≪ DUP <span style="color:blue">PRODIV</span> OVER / SWAP DUP DUP * * == ≫ '<span style="color:blue">OK?</span>' STO
 
≪ { } 0 '''WHILE''' OVER SIZE 50 < '''REPEAT''' 1 + '''IF''' DUP <span style="color:blue">OK?</span> '''THEN''' SWAP OVER + SWAP '''END END''' ≫ EVAL
≪ 0 0 '''WHILE''' OVER 4 PICK < '''REPEAT''' 1 + '''IF''' DUP <span style="color:blue">OK?</span> '''THEN''' SWAP 1 + SWAP '''END END''' ≫ '<span style="color:blue">TASK</span>' STO
500 <span style="color:blue">TASK</span>
5000 <span style="color:blue">TASK</span>
{{out}}
<pre>
3: { 1 24 30 40 42 54 56 66 70 78 88 102 104 105 110 114 128 130 135 136 138 152 154 165 170 174 182 184 186 189 190 195 222 230 231 232 238 246 248 250 255 258 266 273 282 285 286 290 296 297 }
2: 2526
1: 23118
</pre>
 
=={{header|Ruby}}==
<syntaxhighlight lang="ruby" line>require 'prime'
 
def tau(n) = n.prime_division.inject(1){|res, (d, exp)| res *= exp+1}
a111398 = [1].chain (1..).lazy.select{|n| tau(n) == 8}
 
puts "The first 50 numbers which are the cube roots of the products of their proper divisors:"
p a111398.first(50)
[500, 5000, 50000].each{|n| puts "#{n}th: #{a111398.drop(n-1).next}" }
</syntaxhighlight>
{{out}}
<pre>The first 50 numbers which are the cube roots of the products of their proper divisors:
[1, 24, 30, 40, 42, 54, 56, 66, 70, 78, 88, 102, 104, 105, 110, 114, 128, 130, 135, 136, 138, 152, 154, 165, 170, 174, 182, 184, 186, 189, 190, 195, 222, 230, 231, 232, 238, 246, 248, 250, 255, 258, 266, 273, 282, 285, 286, 290, 296, 297]
500th: 2526
5000th: 23118
50000th: 223735
</pre>
 
=={{header|Sidef}}==
<syntaxhighlight lang="ruby" line>say ("First 50 terms: ", 50.by { .proper_divisors.prod == .cube }.join(' '))
 
for n in (5e2, 5e3, 5e4) {
say "#{'%6s'%n.commify}th term: #{n.th{ .proper_divisors.prod == .cube }}"
}</syntaxhighlight>
{{out}}
<pre>
First 50 terms: 1 24 30 40 42 54 56 66 70 78 88 102 104 105 110 114 128 130 135 136 138 152 154 165 170 174 182 184 186 189 190 195 222 230 231 232 238 246 248 250 255 258 266 273 282 285 286 290 296 297
500th term: 2526
5,000th term: 23118
50,000th term: 223735
</pre>
 
=={{header|Visual Basic .NET}}==
{{trans|C#}}
<syntaxhighlight lang="vbnet">Imports System
 
Module Module1
Function dc8(ByVal n As Integer) As Boolean
Dim count, p, d As Integer, res As Integer = 1
While (n And 1) = 0 : n >>= 1 : res += 1 : End While
count = 1 : While n Mod 3 = 0 : n \= 3 : count += 1 : End While
p = 5 : d = 4 : While p * p <= n
res *= count : count = 1
While n Mod p = 0 : n \= p : count += 1 : End While
d = 6 - d : p += d
End While
If n > 1 Then Return res * count = 4
Return res * count = 8
End Function
 
Sub Main(ByVal args As String())
Console.WriteLine("First 50 numbers which are the cube roots of the products of " _
& "their proper divisors:")
Dim n As Integer = 1, count As Integer = 0, lmt As Integer = 500
While count < 5e6
If n = 1 OrElse dc8(n) Then
count += 1 : If count <= 50 Then
Console.Write("{0,3}{1}", n, If(count Mod 10 = 0, vbLf, " "))
ElseIf count = lmt Then
Console.Write("{0,16:n0}th: {1:n0}" & vbLf, count, n) : lmt *= 10
End If
End If
n += 1
End While
End Sub
End Module</syntaxhighlight>
{{out}}
Same as C#.
 
=={{header|Wren}}==
Line 1,096 ⟶ 2,005:
{{libheader|Wren-long}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./math" for Int, Nums
import "./long" for ULong, ULongs
import "./fmt" for Fmt
Line 1,140 ⟶ 2,049:
</pre>
Alternatively and a bit quicker, inspired by the C++ entry and the OEIS comment that (apart from 1) n must have exactly 8 divisors:
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Fmt
 
var divisorCount = Fn.new { |n|
Simonjsaunders
1,777

edits

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