September 2017 Update

Task/Digital-root-Multiplicative-digital-root/FreeBASIC/digital-root-multiplicative-digital-root.freebasic

@@ -0,0 +1,52 @@
+' 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