53 lines
1.0 KiB
Plaintext
53 lines
1.0 KiB
Plaintext
' FB 1.05.0 Win64
|
|
|
|
Function multDigitalRoot(n As UInteger, ByRef mp As Integer, base_ As Integer = 10) As Integer
|
|
Dim mdr As Integer
|
|
mp = 0
|
|
Do
|
|
mdr = IIf(n > 0, 1, 0)
|
|
While n > 0
|
|
mdr *= n Mod base_
|
|
n = n \ base_
|
|
Wend
|
|
mp += 1
|
|
n = mdr
|
|
Loop until mdr < base_
|
|
Return mdr
|
|
End Function
|
|
|
|
Dim As Integer mdr, mp
|
|
Dim a(3) As UInteger = {123321, 7739, 893, 899998}
|
|
For i As UInteger = 0 To 3
|
|
mp = 0
|
|
mdr = multDigitalRoot(a(i), mp)
|
|
Print a(i); Tab(10); "MDR ="; mdr; Tab(20); "MP ="; mp
|
|
Print
|
|
Next
|
|
Print
|
|
Print "MDR 1 2 3 4 5"
|
|
Print "=== ==========================="
|
|
Print
|
|
Dim num(0 To 9, 0 To 5) As UInteger '' all zero by default
|
|
Dim As UInteger n = 0, count = 0
|
|
Do
|
|
mdr = multDigitalRoot(n, mp)
|
|
If num(mdr, 0) < 5 Then
|
|
num(mdr, 0) += 1
|
|
num(mdr, num(mdr, 0)) = n
|
|
count += 1
|
|
End If
|
|
n += 1
|
|
Loop Until count = 50
|
|
|
|
For i As UInteger = 0 To 9
|
|
Print i; ":" ;
|
|
For j As UInteger = 1 To 5
|
|
Print Using "######"; num(i, j);
|
|
Next j
|
|
Print
|
|
Next i
|
|
|
|
Print
|
|
Print "Press any key to quit"
|
|
Sleep
|