44 lines
1.3 KiB
Plaintext
44 lines
1.3 KiB
Plaintext
' Rosetta Code problem: https://rosettacode.org/wiki/Arithmetic_numbers
|
|
' by Jjuanhdez, 06/2022
|
|
|
|
Dim As Double t0 = Timer
|
|
Dim As Integer N = 1, ArithCnt = 0, CompCnt = 0
|
|
Dim As Integer Div, DivCnt, Sum, Quot
|
|
|
|
Print "The first 100 arithmetic numbers are:"
|
|
Do
|
|
Div = 1 : DivCnt = 0 : Sum = 0
|
|
Do
|
|
Quot = N / Div
|
|
If Quot < Div Then Exit Do
|
|
If Quot = Div AndAlso (N Mod Div) = 0 Then 'N is a square
|
|
Sum += Quot
|
|
DivCnt += 1
|
|
Exit Do
|
|
End If
|
|
If (N Mod Div) = 0 Then
|
|
Sum += Div + Quot
|
|
DivCnt += 2
|
|
End If
|
|
Div += 1
|
|
Loop
|
|
|
|
If (Sum Mod DivCnt) = 0 Then 'N is arithmetic
|
|
ArithCnt += 1
|
|
If ArithCnt <= 100 Then
|
|
Print Using "####"; N;
|
|
If (ArithCnt Mod 20) = 0 Then Print
|
|
End If
|
|
If DivCnt > 2 Then CompCnt += 1
|
|
Select Case ArithCnt
|
|
Case 1e3
|
|
Print Using !"\nThe #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt
|
|
Case 1e4, 1e5, 1e6
|
|
Print Using "The #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt
|
|
End Select
|
|
End If
|
|
N += 1
|
|
Loop Until ArithCnt >= 1e6
|
|
Print !"\nTook"; Timer - t0; " seconds on i5 @3.20 GHz"
|
|
Sleep
|