Multiplicatively perfect numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added a stretch goal.)
(→‎{{header|Wren}}: Largely rewritten following addition of stretch goal.)
Line 243: Line 243:
{{libheader|Wren-math}}
{{libheader|Wren-math}}
{{libheader|Wren-fmt}}
{{libheader|Wren-fmt}}
These are what are called 'multiplicatively perfect numbers' (see [https://oeis.org/A007422 OEIS-A00742]).

If this is intended to be a draft task, then I think the title should be changed to that.
<syntaxhighlight lang="ecmascript">import "./math" for Int, Nums
<syntaxhighlight lang="ecmascript">import "./math" for Int, Nums
import "./fmt" for Fmt
import "./fmt" for Fmt


var limit = 500
var limit = 500
var count = 0
System.print("Special numbers under %(limit):")
var i = 0
for (i in 1...limit) {
System.print("Multiplicatively perfect numbers under %(limit):")
while (true) {
var pd = Int.properDivisors(i).skip(1)
var pd = Int.properDivisors(i).skip(1)
if (pd.count > 1 && Nums.prod(pd) == i) {
if (pd.count > 1 && Nums.prod(pd) == i) {
var pds = pd.map { |d| Fmt.d(3, d) }.join(" x ")
count = count + 1
Fmt.print("$3d = $s", i, pds)
if (i < 500) {
var pds = pd.map { |d| Fmt.d(3, d) }.join(" x ")
Fmt.write("$3d = $s ", i, pds)
if (count % 4 == 0) System.print()
}
}
}
if (i == 499) System.print("\n")
if (i >= limit - 1) {
var squares = Int.primeSieve((limit - 1).sqrt.floor).count
var cubes = Int.primeSieve((limit - 1).cbrt.floor).count
var count2 = count + squares - cubes
Fmt.print("Counts under $,7d: MPNs = $,7d Semi-primes = $,7d", limit, count, count2)
if (limit == 500000) return
limit = limit * 10
}
i = i + 1
}</syntaxhighlight>
}</syntaxhighlight>


{{out}}
{{out}}
<pre>
<pre>
Special numbers under 500:
Multiplicatively perfect numbers under 500:
6 = 2 x 3
6 = 2 x 3 8 = 2 x 4 10 = 2 x 5 14 = 2 x 7
15 = 3 x 5 21 = 3 x 7 22 = 2 x 11 26 = 2 x 13
8 = 2 x 4
27 = 3 x 9 33 = 3 x 11 34 = 2 x 17 35 = 5 x 7
10 = 2 x 5
38 = 2 x 19 39 = 3 x 13 46 = 2 x 23 51 = 3 x 17
14 = 2 x 7
55 = 5 x 11 57 = 3 x 19 58 = 2 x 29 62 = 2 x 31
15 = 3 x 5
65 = 5 x 13 69 = 3 x 23 74 = 2 x 37 77 = 7 x 11
21 = 3 x 7
82 = 2 x 41 85 = 5 x 17 86 = 2 x 43 87 = 3 x 29
22 = 2 x 11
91 = 7 x 13 93 = 3 x 31 94 = 2 x 47 95 = 5 x 19
26 = 2 x 13
106 = 2 x 53 111 = 3 x 37 115 = 5 x 23 118 = 2 x 59
27 = 3 x 9
119 = 7 x 17 122 = 2 x 61 123 = 3 x 41 125 = 5 x 25
33 = 3 x 11
129 = 3 x 43 133 = 7 x 19 134 = 2 x 67 141 = 3 x 47
34 = 2 x 17
142 = 2 x 71 143 = 11 x 13 145 = 5 x 29 146 = 2 x 73
35 = 5 x 7
155 = 5 x 31 158 = 2 x 79 159 = 3 x 53 161 = 7 x 23
38 = 2 x 19
166 = 2 x 83 177 = 3 x 59 178 = 2 x 89 183 = 3 x 61
39 = 3 x 13
185 = 5 x 37 187 = 11 x 17 194 = 2 x 97 201 = 3 x 67
46 = 2 x 23
202 = 2 x 101 203 = 7 x 29 205 = 5 x 41 206 = 2 x 103
51 = 3 x 17
209 = 11 x 19 213 = 3 x 71 214 = 2 x 107 215 = 5 x 43
55 = 5 x 11
217 = 7 x 31 218 = 2 x 109 219 = 3 x 73 221 = 13 x 17
57 = 3 x 19
226 = 2 x 113 235 = 5 x 47 237 = 3 x 79 247 = 13 x 19
58 = 2 x 29
249 = 3 x 83 253 = 11 x 23 254 = 2 x 127 259 = 7 x 37
62 = 2 x 31
262 = 2 x 131 265 = 5 x 53 267 = 3 x 89 274 = 2 x 137
65 = 5 x 13
278 = 2 x 139 287 = 7 x 41 291 = 3 x 97 295 = 5 x 59
69 = 3 x 23
298 = 2 x 149 299 = 13 x 23 301 = 7 x 43 302 = 2 x 151
74 = 2 x 37
303 = 3 x 101 305 = 5 x 61 309 = 3 x 103 314 = 2 x 157
77 = 7 x 11
319 = 11 x 29 321 = 3 x 107 323 = 17 x 19 326 = 2 x 163
82 = 2 x 41
327 = 3 x 109 329 = 7 x 47 334 = 2 x 167 335 = 5 x 67
85 = 5 x 17
339 = 3 x 113 341 = 11 x 31 343 = 7 x 49 346 = 2 x 173
86 = 2 x 43
355 = 5 x 71 358 = 2 x 179 362 = 2 x 181 365 = 5 x 73
87 = 3 x 29
371 = 7 x 53 377 = 13 x 29 381 = 3 x 127 382 = 2 x 191
91 = 7 x 13
386 = 2 x 193 391 = 17 x 23 393 = 3 x 131 394 = 2 x 197
93 = 3 x 31
395 = 5 x 79 398 = 2 x 199 403 = 13 x 31 407 = 11 x 37
94 = 2 x 47
411 = 3 x 137 413 = 7 x 59 415 = 5 x 83 417 = 3 x 139
95 = 5 x 19
422 = 2 x 211 427 = 7 x 61 437 = 19 x 23 445 = 5 x 89
106 = 2 x 53
446 = 2 x 223 447 = 3 x 149 451 = 11 x 41 453 = 3 x 151
111 = 3 x 37
454 = 2 x 227 458 = 2 x 229 466 = 2 x 233 469 = 7 x 67
115 = 5 x 23
471 = 3 x 157 473 = 11 x 43 478 = 2 x 239 481 = 13 x 37
118 = 2 x 59
482 = 2 x 241 485 = 5 x 97 489 = 3 x 163 493 = 17 x 29
119 = 7 x 17
122 = 2 x 61
497 = 7 x 71

123 = 3 x 41
Counts under 500: MPNs = 149 Semi-primes = 153
125 = 5 x 25
Counts under 5,000: MPNs = 1,353 Semi-primes = 1,365
129 = 3 x 43
Counts under 50,000: MPNs = 12,073 Semi-primes = 12,110
133 = 7 x 19
Counts under 500,000: MPNs = 108,222 Semi-primes = 108,326
134 = 2 x 67
141 = 3 x 47
142 = 2 x 71
143 = 11 x 13
145 = 5 x 29
146 = 2 x 73
155 = 5 x 31
158 = 2 x 79
159 = 3 x 53
161 = 7 x 23
166 = 2 x 83
177 = 3 x 59
178 = 2 x 89
183 = 3 x 61
185 = 5 x 37
187 = 11 x 17
194 = 2 x 97
201 = 3 x 67
202 = 2 x 101
203 = 7 x 29
205 = 5 x 41
206 = 2 x 103
209 = 11 x 19
213 = 3 x 71
214 = 2 x 107
215 = 5 x 43
217 = 7 x 31
218 = 2 x 109
219 = 3 x 73
221 = 13 x 17
226 = 2 x 113
235 = 5 x 47
237 = 3 x 79
247 = 13 x 19
249 = 3 x 83
253 = 11 x 23
254 = 2 x 127
259 = 7 x 37
262 = 2 x 131
265 = 5 x 53
267 = 3 x 89
274 = 2 x 137
278 = 2 x 139
287 = 7 x 41
291 = 3 x 97
295 = 5 x 59
298 = 2 x 149
299 = 13 x 23
301 = 7 x 43
302 = 2 x 151
303 = 3 x 101
305 = 5 x 61
309 = 3 x 103
314 = 2 x 157
319 = 11 x 29
321 = 3 x 107
323 = 17 x 19
326 = 2 x 163
327 = 3 x 109
329 = 7 x 47
334 = 2 x 167
335 = 5 x 67
339 = 3 x 113
341 = 11 x 31
343 = 7 x 49
346 = 2 x 173
355 = 5 x 71
358 = 2 x 179
362 = 2 x 181
365 = 5 x 73
371 = 7 x 53
377 = 13 x 29
381 = 3 x 127
382 = 2 x 191
386 = 2 x 193
391 = 17 x 23
393 = 3 x 131
394 = 2 x 197
395 = 5 x 79
398 = 2 x 199
403 = 13 x 31
407 = 11 x 37
411 = 3 x 137
413 = 7 x 59
415 = 5 x 83
417 = 3 x 139
422 = 2 x 211
427 = 7 x 61
437 = 19 x 23
445 = 5 x 89
446 = 2 x 223
447 = 3 x 149
451 = 11 x 41
453 = 3 x 151
454 = 2 x 227
458 = 2 x 229
466 = 2 x 233
469 = 7 x 67
471 = 3 x 157
473 = 11 x 43
478 = 2 x 239
481 = 13 x 37
482 = 2 x 241
485 = 5 x 97
489 = 3 x 163
493 = 17 x 29
497 = 7 x 71
</pre>
</pre>


Revision as of 09:22, 8 May 2023

Multiplicatively perfect numbers is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

If the product of the divisors of an integer n (including n itself) is equal to n^2, then n is a multiplicatively perfect number. Equivalently: the product of the proper divisors of n (i.e. excluding n) is equal to n.

Task

Find and show on this page the multiplicatively perfect numbers below 500.

Stretch

Find and show the number of multiplicatively perfect numbers under 500, 5,000, 50,000 and 500,000 and for each of these limits deduce (avoid counting separately) and show the number of semi-primes (numbers which are the product of exactly two primes) under that limit.

Related (and near duplicate) task
See also



FreeBASIC

#define ceil(x) (-((-x*2.0-0.5) Shr 1))
Dim As Integer limit = 500
Dim As Integer n, pro, Divisors(), m, c = 0, ub
Print "Special numbers under"; limit; ":"

For n = 1 To limit
    pro = 1
    For m = 2 To ceil(n / 2)
        If n Mod m = 0 Then            
            pro *= m
            Redim Preserve Divisors(c) : Divisors(c) = m
            c += 1
        End If
    Next m
    ub = Ubound(Divisors)
    If n = pro And ub > 1 Then
        Print Using "### = ## x ###"; n; Divisors(ub-1); Divisors(ub)
    End If
Next n

Sleep
Output:
Similar to Ring entry.

Phix

with javascript_semantics
function special_numbers(integer n)
    return product(factors(n))=n
end function
sequence r = filter(tagset(500,2),special_numbers)
printf(1,"%d special numbers under 500: %s\n",
        {length(r),join(shorten(r,"",5,"%d"),",")})
Output:
149 special numbers under 500: 6,8,10,14,15,...,482,485,489,493,497

Ring

see "working..." + nl
see "Special numbers under 500:" + nl
limit = 500
Divisors = []
for n = 1 to limit
    pro = 1
    Divisors = []
    for m = 2 to ceil(n/2)
        if n % m = 0
           pro = pro * m
           add(Divisors,m)
        ok
    next
    str = ""
    if n = pro and len(Divisors) > 1
       for m = 1 to len(Divisors)
           str = str + Divisors[m] + " * "
           if m = len(Divisors)
              str = left(str,len(str)-2) 
           ok
       next
       see "" + n + " = " + str + nl
    ok
next
see "done..." + nl
Output:
working...
Special numbers under 500:
  6  =   2 x   3
  8  =   2 x   4
 10  =   2 x   5
 14  =   2 x   7
 15  =   3 x   5
 21  =   3 x   7
 22  =   2 x  11
 26  =   2 x  13
 27  =   3 x   9
 33  =   3 x  11
 34  =   2 x  17
 35  =   5 x   7
 38  =   2 x  19
 39  =   3 x  13
 46  =   2 x  23
 51  =   3 x  17
 55  =   5 x  11
 57  =   3 x  19
 58  =   2 x  29
 62  =   2 x  31
 65  =   5 x  13
 69  =   3 x  23
 74  =   2 x  37
 77  =   7 x  11
 82  =   2 x  41
 85  =   5 x  17
 86  =   2 x  43
 87  =   3 x  29
 91  =   7 x  13
 93  =   3 x  31
 94  =   2 x  47
 95  =   5 x  19
106  =   2 x  53
111  =   3 x  37
115  =   5 x  23
118  =   2 x  59
119  =   7 x  17
122  =   2 x  61
123  =   3 x  41
125  =   5 x  25
129  =   3 x  43
133  =   7 x  19
134  =   2 x  67
141  =   3 x  47
142  =   2 x  71
143  =  11 x  13
145  =   5 x  29
146  =   2 x  73
155  =   5 x  31
158  =   2 x  79
159  =   3 x  53
161  =   7 x  23
166  =   2 x  83
177  =   3 x  59
178  =   2 x  89
183  =   3 x  61
185  =   5 x  37
187  =  11 x  17
194  =   2 x  97
201  =   3 x  67
202  =   2 x 101
203  =   7 x  29
205  =   5 x  41
206  =   2 x 103
209  =  11 x  19
213  =   3 x  71
214  =   2 x 107
215  =   5 x  43
217  =   7 x  31
218  =   2 x 109
219  =   3 x  73
221  =  13 x  17
226  =   2 x 113
235  =   5 x  47
237  =   3 x  79
247  =  13 x  19
249  =   3 x  83
253  =  11 x  23
254  =   2 x 127
259  =   7 x  37
262  =   2 x 131
265  =   5 x  53
267  =   3 x  89
274  =   2 x 137
278  =   2 x 139
287  =   7 x  41
291  =   3 x  97
295  =   5 x  59
298  =   2 x 149
299  =  13 x  23
301  =   7 x  43
302  =   2 x 151
303  =   3 x 101
305  =   5 x  61
309  =   3 x 103
314  =   2 x 157
319  =  11 x  29
321  =   3 x 107
323  =  17 x  19
326  =   2 x 163
327  =   3 x 109
329  =   7 x  47
334  =   2 x 167
335  =   5 x  67
339  =   3 x 113
341  =  11 x  31
343  =   7 x  49
346  =   2 x 173
355  =   5 x  71
358  =   2 x 179
362  =   2 x 181
365  =   5 x  73
371  =   7 x  53
377  =  13 x  29
381  =   3 x 127
382  =   2 x 191
386  =   2 x 193
391  =  17 x  23
393  =   3 x 131
394  =   2 x 197
395  =   5 x  79
398  =   2 x 199
403  =  13 x  31
407  =  11 x  37
411  =   3 x 137
413  =   7 x  59
415  =   5 x  83
417  =   3 x 139
422  =   2 x 211
427  =   7 x  61
437  =  19 x  23
445  =   5 x  89
446  =   2 x 223
447  =   3 x 149
451  =  11 x  41
453  =   3 x 151
454  =   2 x 227
458  =   2 x 229
466  =   2 x 233
469  =   7 x  67
471  =   3 x 157
473  =  11 x  43
478  =   2 x 239
481  =  13 x  37
482  =   2 x 241
485  =   5 x  97
489  =   3 x 163
493  =  17 x  29
497  =   7 x  71
done...

Wren

Library: Wren-math
Library: Wren-fmt
import "./math" for Int, Nums
import "./fmt" for Fmt

var limit = 500
var count = 0
var i = 0
System.print("Multiplicatively perfect numbers under %(limit):")
while (true) {
    var pd = Int.properDivisors(i).skip(1)
    if (pd.count > 1 && Nums.prod(pd) == i) {
        count = count + 1
        if (i < 500) {
            var pds = pd.map { |d| Fmt.d(3, d) }.join(" x ")
            Fmt.write("$3d  = $s   ", i, pds)
            if (count % 4 == 0) System.print()
        }
    }
    if (i == 499) System.print("\n")
    if (i >= limit - 1) {
        var squares = Int.primeSieve((limit - 1).sqrt.floor).count
        var cubes   = Int.primeSieve((limit - 1).cbrt.floor).count
        var count2 = count + squares - cubes
        Fmt.print("Counts under $,7d: MPNs = $,7d  Semi-primes = $,7d", limit, count, count2)
        if (limit == 500000) return
        limit = limit * 10
    }
    i = i + 1
}
Output:
Multiplicatively perfect numbers under 500:
  6  =   2 x   3     8  =   2 x   4    10  =   2 x   5    14  =   2 x   7   
 15  =   3 x   5    21  =   3 x   7    22  =   2 x  11    26  =   2 x  13   
 27  =   3 x   9    33  =   3 x  11    34  =   2 x  17    35  =   5 x   7   
 38  =   2 x  19    39  =   3 x  13    46  =   2 x  23    51  =   3 x  17   
 55  =   5 x  11    57  =   3 x  19    58  =   2 x  29    62  =   2 x  31   
 65  =   5 x  13    69  =   3 x  23    74  =   2 x  37    77  =   7 x  11   
 82  =   2 x  41    85  =   5 x  17    86  =   2 x  43    87  =   3 x  29   
 91  =   7 x  13    93  =   3 x  31    94  =   2 x  47    95  =   5 x  19   
106  =   2 x  53   111  =   3 x  37   115  =   5 x  23   118  =   2 x  59   
119  =   7 x  17   122  =   2 x  61   123  =   3 x  41   125  =   5 x  25   
129  =   3 x  43   133  =   7 x  19   134  =   2 x  67   141  =   3 x  47   
142  =   2 x  71   143  =  11 x  13   145  =   5 x  29   146  =   2 x  73   
155  =   5 x  31   158  =   2 x  79   159  =   3 x  53   161  =   7 x  23   
166  =   2 x  83   177  =   3 x  59   178  =   2 x  89   183  =   3 x  61   
185  =   5 x  37   187  =  11 x  17   194  =   2 x  97   201  =   3 x  67   
202  =   2 x 101   203  =   7 x  29   205  =   5 x  41   206  =   2 x 103   
209  =  11 x  19   213  =   3 x  71   214  =   2 x 107   215  =   5 x  43   
217  =   7 x  31   218  =   2 x 109   219  =   3 x  73   221  =  13 x  17   
226  =   2 x 113   235  =   5 x  47   237  =   3 x  79   247  =  13 x  19   
249  =   3 x  83   253  =  11 x  23   254  =   2 x 127   259  =   7 x  37   
262  =   2 x 131   265  =   5 x  53   267  =   3 x  89   274  =   2 x 137   
278  =   2 x 139   287  =   7 x  41   291  =   3 x  97   295  =   5 x  59   
298  =   2 x 149   299  =  13 x  23   301  =   7 x  43   302  =   2 x 151   
303  =   3 x 101   305  =   5 x  61   309  =   3 x 103   314  =   2 x 157   
319  =  11 x  29   321  =   3 x 107   323  =  17 x  19   326  =   2 x 163   
327  =   3 x 109   329  =   7 x  47   334  =   2 x 167   335  =   5 x  67   
339  =   3 x 113   341  =  11 x  31   343  =   7 x  49   346  =   2 x 173   
355  =   5 x  71   358  =   2 x 179   362  =   2 x 181   365  =   5 x  73   
371  =   7 x  53   377  =  13 x  29   381  =   3 x 127   382  =   2 x 191   
386  =   2 x 193   391  =  17 x  23   393  =   3 x 131   394  =   2 x 197   
395  =   5 x  79   398  =   2 x 199   403  =  13 x  31   407  =  11 x  37   
411  =   3 x 137   413  =   7 x  59   415  =   5 x  83   417  =   3 x 139   
422  =   2 x 211   427  =   7 x  61   437  =  19 x  23   445  =   5 x  89   
446  =   2 x 223   447  =   3 x 149   451  =  11 x  41   453  =   3 x 151   
454  =   2 x 227   458  =   2 x 229   466  =   2 x 233   469  =   7 x  67   
471  =   3 x 157   473  =  11 x  43   478  =   2 x 239   481  =  13 x  37   
482  =   2 x 241   485  =   5 x  97   489  =   3 x 163   493  =  17 x  29   
497  =   7 x  71   

Counts under     500: MPNs =     149  Semi-primes =     153
Counts under   5,000: MPNs =   1,353  Semi-primes =   1,365
Counts under  50,000: MPNs =  12,073  Semi-primes =  12,110
Counts under 500,000: MPNs = 108,222  Semi-primes = 108,326

XPL0

func Special(N);
int  N, D, P;
[D:= 2;  P:= 1;
while D < N do
    [if rem(N/D) = 0 then P:= P*D;
    D:= D+1;
    ];
return P = N;
];

int N, C;
[C:= 0;
Format(4, 0);
for N:= 2 to 500-1 do
    if Special(N) then
        [RlOut(0, float(N));
        C:= C+1;
        if rem(C/20) = 0 then CrLf(0);
        ];
]
Output:
   6   8  10  14  15  21  22  26  27  33  34  35  38  39  46  51  55  57  58  62
  65  69  74  77  82  85  86  87  91  93  94  95 106 111 115 118 119 122 123 125
 129 133 134 141 142 143 145 146 155 158 159 161 166 177 178 183 185 187 194 201
 202 203 205 206 209 213 214 215 217 218 219 221 226 235 237 247 249 253 254 259
 262 265 267 274 278 287 291 295 298 299 301 302 303 305 309 314 319 321 323 326
 327 329 334 335 339 341 343 346 355 358 362 365 371 377 381 382 386 391 393 394
 395 398 403 407 411 413 415 417 422 427 437 445 446 447 451 453 454 458 466 469
 471 473 478 481 482 485 489 493 497
Retrieved from "https://rosettacode.org/wiki/Multiplicatively_perfect_numbers?oldid=341792"