RosettaCodeData/Task/Amicable-pairs/S-BASIC/amicable-pairs.basic
2023-07-01 13:44:08 -04:00

41 lines
800 B
Text

$lines
$constant search_limit = 20000
rem - return p mod q
function mod(p, q = integer) = integer
end = p - q * (p / q)
rem - return sum of the proper divisors of n
function sumf(n = integer) = integer
var f1, f2, sum = integer
sum = 1
f1 = 2
while (f1 * f1) <= n do
begin
if mod(n, f1) = 0 then
begin
sum = sum + f1
f2 = n / f1
if f2 > f1 then sum = sum + f2
end
f1 = f1 + 1
end
end = sum
rem - main program begins here
var a, b, count = integer
print "Searching up to"; search_limit; " for amicable pairs:"
count = 0
for a = 2 to search_limit do
b = sumf(a)
if b > a then
if a = sumf(b) then
begin
print using "##### #####"; a; b
count = count + 1
end
next a
print count; " pairs were found"
end