65 lines
1.3 KiB
Text
65 lines
1.3 KiB
Text
' version 04-12-2016
|
|
' compile with: fbc -s console
|
|
|
|
' define true and false for older versions
|
|
#Ifndef TRUE
|
|
#Define FALSE 0
|
|
#Define TRUE Not FALSE
|
|
#EndIf
|
|
|
|
#Define max 1000000 ' maximum for number to be tested
|
|
|
|
Function kaprekar(n As ULong) As ULong
|
|
|
|
If n = 1 Then Return TRUE
|
|
|
|
Dim As ULong x, p1, p2
|
|
Dim As ULongInt sq = CLngInt(n) * n
|
|
Dim As String sq_str = Str(sq)
|
|
Dim As ULong l = Len(sq_str)
|
|
|
|
' decrease the lenght l for every "0"
|
|
' at the end of the string
|
|
For x = l -1 To 1 Step -1
|
|
If sq_str[x] = Asc("0") Then
|
|
l = l -1
|
|
Else
|
|
Exit For
|
|
End If
|
|
Next
|
|
|
|
For x = 1 To l -1
|
|
p2 = Val(Mid(sq_str, x +1))
|
|
If p2 > n Then
|
|
Continue For
|
|
End If
|
|
p1 = Val(Left(sq_str, x))
|
|
If p1 > n Then Return FALSE ' p1 > n leave
|
|
If (p1 + p2) = n Then Return TRUE
|
|
Next
|
|
|
|
End Function
|
|
|
|
' ------=< MAIN >=------
|
|
|
|
Dim As ULong n, count
|
|
|
|
Print "Kaprekar numbers below 10000"
|
|
|
|
For n = 1 To max -1
|
|
If kaprekar(n) = TRUE Then
|
|
count = count + 1
|
|
If n < 10000 Then
|
|
Print count, n
|
|
End If
|
|
End If
|
|
Next
|
|
|
|
Print
|
|
Print count;" numbers below "; Str(max);" are Kaprekar numbers"
|
|
|
|
' empty keyboard buffer
|
|
While Inkey <> "" : Wend
|
|
Print : Print "hit any key to end program"
|
|
Sleep
|
|
End
|