Jump to content

Practical numbers: Difference between revisions

add freebasic
(→‎{{header|jq}}: add 6666 and 66666)
(add freebasic)
Line 157:
=={{header|Delphi}}==
See [https://rosettacode.org/wiki/Practical_numbers#Pascal Pascal].
 
=={{header|FreeBASIC}}==
<lang freebasic>sub make_divisors( n as uinteger, div() as uinteger )
'produces a list of an integer's proper divisors
for i as uinteger = n/2 to 1 step -1
if n mod i = 0 then
redim preserve div(1 to 1 + ubound(div))
div(ubound(div)) = i
end if
next i
end sub
 
function sum_divisors( n as uinteger, div() as uinteger ) as uinteger
'takes a list of divisors and an integer which, when interpreted
'as binary, selects which terms to sum
dim as uinteger sum = 0, term = 1
while n
if n mod 2 = 1 then sum += div(term)
term += 1
n\=2
wend
return sum
end function
 
function is_practical( n as uinteger ) as boolean
'determines if an integer is practical
if n = 1 then return true
if n mod 2 = 1 then return false 'there can be no odd practicals other than 1
if n < 5 then return true '2 and 4 are practical, but small enough to be handled specially
dim as uinteger hits(1 to n-1), nt, i, sd
redim as uinteger div(0 to 0)
make_divisors( n, div() )
nt = ubound(div)
for i = 1 to 2^nt-1
sd = sum_divisors(i, div())
if sd<n then hits(sd)+=1
next i
for i = 1 to n-1
if hits(i) = 0 then return false
next i
return true
end function
 
print 1;" "; 'treat 1 as a special case
 
for n as uinteger = 2 to 666
if is_practical(n) then print n;" ";
next n:print</lang>
 
All practical numbers up to and including the stretch goal of DCLXVI.
 
{{out}}<pre>
1 2 4 6 8 12 16 18 20 24 28 30 32 36 40 42 48 54 56 60 64 66 72 78 80 84 88 90 96 100 104 108 112 120 126 128 132 140 144 150 156 160 162 168 176 180 192 196 198 200 204 208 210 216 220 224 228 234 240 252 256 260 264 270 272 276 280 288 294 300 304 306 308 312 320 324 330 336 340 342 348 352 360 364 368 378 380 384 390 392 396 400 408 414 416 420 432 440 448 450 456 460 462 464 468 476 480 486 496 500 504 510 512 520 522 528 532 540 544 546 552 558 560 570 576 580 588 594 600 608 612 616 620 624 630 640 644 648 660 666</pre>
 
=={{header|Go}}==
781

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.