Data update

Task/Multi-base-primes/FreeBASIC/multi-base-primes.basic

@@ -0,0 +1,98 @@
+Const maxBase = 36 ' o 62
+Function isPrime(Byval ValorEval As Integer) As Boolean
+    If ValorEval < 2 Then Return False
+    If ValorEval Mod 2 = 0 Then Return ValorEval = 2
+    If ValorEval Mod 3 = 0 Then Return ValorEval = 3
+    Dim d As Integer = 5
+    While d * d <= ValorEval
+        If ValorEval Mod d = 0 Then Return False Else d += 2
+    Wend
+    Return True
+End Function
+Function maxval(arr() As Integer) As Integer
+    Dim As Integer max_value = arr(0)
+    For i As Integer = 1 To Ubound(arr)
+        If arr(i) > max_value Then max_value = arr(i)
+    Next
+    Return max_value
+End Function
+Function join(arr() As Integer, delimiter As String) As String
+    Dim As String result = ""
+    For i As Integer = 0 To Ubound(arr)
+        result &= Str(arr(i))
+        If i < Ubound(arr) Then result &= delimiter
+    Next
+    Return result
+End Function
+
+Function evalPoly(x As Integer, p() As Integer) As Integer
+    Dim result As Integer = 0
+    For y As Integer = 0 To Ubound(p)
+        result = result * x + p(y)
+    Next
+    Return result
+End Function
+
+Function stringify(digits() As Integer) As String
+    Dim res As String
+    For i As Integer = 0 To Ubound(digits)
+        Dim di As Integer = digits(i)
+        res &= Chr(Iif(di <= 9, di + Asc("0"), Iif(di < 36, di + Asc("A") - 10, di + Asc("a") - 36)))
+    Next
+    Return res
+End Function
+
+Sub maxPrimeVases(ndig As Integer, maxVase As Integer)
+    Dim As Double t0 = Timer
+    Dim As String maxPrimeBases()
+    Dim As Integer digits(ndig - 1)
+    Dim As Integer maxlen = 0
+    Dim As Integer limit = 10 ^ ndig
+    Dim As Integer maxDigit = maxBase
+    If ndig > 1 Then digits(0) = 1
+    Do
+        For i As Integer = Ubound(digits) To 0 Step -1
+            Dim As Integer di = digits(i) + 1
+            If di < maxDigit Then
+                digits(i) = di
+                Exit For
+            Else
+                digits(i) = 0
+            End If
+        Next
+        Dim As Integer minBase = maxval(digits()) + 1
+        Dim As Integer maxPoss = maxBase - minBase + 1
+        If minBase = 1 Then Exit Do
+        Dim As Integer bases()
+        For base_ As Integer = minBase To maxBase
+            If isPrime(evalPoly(base_, digits())) Then
+                Redim Preserve bases(Ubound(bases) + 1)
+                bases(Ubound(bases)) = base_
+            Else
+                maxPoss -= 1
+                If maxPoss < maxlen Then Exit For
+            End If
+        Next
+        Dim As Integer l = Ubound(bases) + 1
+        If l > maxlen Then
+            maxlen = l
+            maxDigit = maxBase - maxlen
+            Redim maxPrimeBases(0)
+        End If
+        If l = maxlen Then
+            Redim Preserve maxPrimeBases(Ubound(maxPrimeBases) + 1)
+            maxPrimeBases(Ubound(maxPrimeBases)) = Chr(10) & stringify(digits()) & " => " & join(bases(), ", ")
+        End If
+    Loop
+    Print Using "# character strings which are prime in most bases: ## (#.##s):"; ndig; maxlen; Timer - t0;
+    For i As Integer = 0 To Ubound(maxPrimeBases)
+        Print maxPrimeBases(i);
+    Next
+    Print Chr(10)
+End Sub
+
+For n As Integer = 1 To Iif(maxBase > 36, 4, 6)
+    maxPrimeVases(n, maxBase)
+Next n
+
+Sleep