78 lines
1.7 KiB
Plaintext
78 lines
1.7 KiB
Plaintext
' Rosetta Code problem: https://rosettacode.org/wiki/Arithmetic_numbers
|
|
' by Rich Love, 9/21/22
|
|
' FutureBasic 7.0.14
|
|
|
|
output file "Arithmetic numbers.app"
|
|
Dim As long N = 1, ArithCnt = 0, CompCnt = 0
|
|
Dim As long Div, DivCnt, Sum, Quot
|
|
|
|
toolbox Microseconds( UnsignedWide * microTickCount )
|
|
dim as UnsignedWide Time1, Time2
|
|
|
|
window 1, @"Arithmetic numbers",(0,0,600,200)
|
|
|
|
Print "The first 100 arithmetic numbers are:"
|
|
|
|
Microseconds( @Time1 ) //start time
|
|
|
|
for N = 1 to 2000000)
|
|
|
|
Div = 1 : DivCnt = 0 : Sum = 0
|
|
|
|
while 1
|
|
|
|
Quot = N / Div
|
|
If Quot < Div Then Exit while
|
|
If Quot = Div And (N Mod Div) = 0 'N is a square
|
|
Sum += Quot
|
|
DivCnt += 1
|
|
Exit while
|
|
End If
|
|
If (N Mod Div) = 0
|
|
Sum += Div + Quot
|
|
DivCnt += 2
|
|
End If
|
|
Div ++
|
|
|
|
wend
|
|
|
|
|
|
|
|
If (Sum Mod DivCnt) = 0 'N is arithmetic
|
|
ArithCnt ++
|
|
|
|
If ArithCnt <= 100
|
|
Print Using "####"; N;
|
|
If (ArithCnt Mod 20) = 0 Then PRINT
|
|
End If
|
|
|
|
If DivCnt > 2 Then CompCnt ++
|
|
|
|
Select Case ArithCnt
|
|
Case 1e3
|
|
PRINT
|
|
PRINT USING "The #######th arithmetic number is";ArithCnt;
|
|
PRINT USING "#####,### up to which ";N;
|
|
PRINT USING "###,### are composite. ";compcnt
|
|
Case 1e4, 1e5, 1e6
|
|
PRINT USING "The #######th arithmetic number is";ArithCnt;
|
|
PRINT USING "#####,### up to which ";N;
|
|
PRINT USING "###,### are composite. ";compcnt
|
|
End Select
|
|
|
|
if ArithCnt = 1e6 then exit next
|
|
End If
|
|
|
|
|
|
next N
|
|
|
|
Microseconds( @Time2 ) //end time
|
|
|
|
float TimeTaken
|
|
TimeTaken = (Time2.lo-Time1.lo)/1000/100/10
|
|
print
|
|
print "It took " + str$(TimeTaken) + " seconds to complete." // Approx 1.2 seconds on a M1 Mac Mini ( Macmini9,1 )
|
|
|
|
|
|
handleevents
|