Multiplicatively perfect numbers: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added FreeBASIC)
m (added {{draft task}}, since it now seems unlikely this will ever be deleted and it messes up the stats.)
Line 1: Line 1:
{{draft task}}

=Duplicate of task [[Semiprime]]=
=Duplicate of task [[Semiprime]]=



Revision as of 22:42, 7 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.

Duplicate of task Semiprime

Definition

If the product of the divisors of an integer n (other than 1 and n itself) is equal to the number itself, then n is a special number.
Task
Find and show on this page the Special numbers where n < 500

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

These are what are called 'multiplicatively perfect numbers' (see OEIS-A00742).

If this is intended to be a draft task, then I think the title should be changed to that.

import "./math" for Int, Nums
import "./fmt" for Fmt

var limit = 500
System.print("Special numbers under %(limit):")
for (i in 1...limit) {
    var pd = Int.properDivisors(i).skip(1)
    if (pd.count > 1 && Nums.prod(pd) == i) {
        var pds = pd.map { |d| Fmt.d(3, d) }.join(" x ")
        Fmt.print("$3d  = $s", i, pds)
    }
}
Output:
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

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