RosettaCodeData/Task/Zumkeller-numbers/FreeBASIC/zumkeller-numbers.basic
2024-10-16 18:07:41 -07:00

96 lines
2.6 KiB
Text

' Function to get divisors of a number
Sub getDivisors(n As Integer, divs() As Integer)
Redim divs(1)
divs(0) = 1
divs(1) = n
Dim As Integer i = 2, j
While i * i <= n
If n Mod i = 0 Then
j = n \ i
Redim Preserve divs(Ubound(divs) + 1)
divs(Ubound(divs)) = i
If i <> j Then
Redim Preserve divs(Ubound(divs) + 1)
divs(Ubound(divs)) = j
End If
End If
i += 1
Wend
End Sub
' Function to check if a sum can be formed by a subset of divisors
Function isPartSum(divs() As Integer, sum As Integer) As Boolean
If sum = 0 Then Return True
Dim le As Integer = Ubound(divs) + 1
If le = 0 Then Return False
Dim last As Integer = divs(le - 1)
Dim newDivs(le - 2) As Integer
For i As Integer = 0 To le - 2
newDivs(i) = divs(i)
Next
If last > sum Then Return isPartSum(newDivs(), sum)
Return isPartSum(newDivs(), sum) Orelse isPartSum(newDivs(), sum - last)
End Function
' Function to check if a number is a Zumkeller number
Function isZumkeller(n As Integer) As Boolean
Dim divs() As Integer
getDivisors(n, divs())
Dim sum As Integer = 0
For i As Integer = 0 To Ubound(divs)
sum += divs(i)
Next
' if sum is odd can't be split into two partitions with equal sums
If sum Mod 2 = 1 Then Return False
' if n is odd use 'abundant odd number' optimization
If n Mod 2 = 1 Then
Dim abundance As Integer = sum - 2 * n
Return abundance > 0 Andalso abundance Mod 2 = 0
End If
' if n and sum are both even check if there's a partition which totals sum / 2
Return isPartSum(divs(), sum \ 2)
End Function
Sub main()
Print "The first 220 Zumkeller numbers are:"
Dim As Integer i = 2
Dim As Integer cnt = 0
While cnt < 220
If isZumkeller(i) Then
Print Using "### "; i;
cnt += 1
If cnt Mod 20 = 0 Then Print
End If
i += 1
Wend
Print !"\nThe first 40 odd Zumkeller numbers are:"
i = 3
cnt = 0
While cnt < 40
If isZumkeller(i) Then
Print Using "##### "; i;
cnt += 1
If cnt Mod 10 = 0 Then Print
End If
i += 2
Wend
Print !"\nThe first 40 odd Zumkeller numbers which don't end in 5 are:"
i = 3
cnt = 0
While cnt < 40
If i Mod 10 <> 5 Andalso isZumkeller(i) Then
Print Using "####### "; i;
cnt += 1
If cnt Mod 8 = 0 Then Print
End If
i += 2
Wend
End Sub
main()
Sleep