RosettaCodeData/Task/Blum-integer/QB64/blum-integer.qb64

74 lines
2.1 KiB
Plaintext

Dim Shared inc(7) As Integer
inc(0) = 4: inc(1) = 2: inc(2) = 4
inc(3) = 2: inc(4) = 4: inc(5) = 6
inc(6) = 2: inc(7) = 6
Dim blum(49) As Long
Dim counts(9) As Long
Dim bc As Long, i As Long, p As Long, q As Long, j As Integer
i = 1
Do
p = firstPrimeFactor(i)
If p Mod 4 = 3 Then
q = i \ p
If q <> p And q Mod 4 = 3 And isPrime(q) Then
If bc < 50 Then blum(bc) = i
counts(i Mod 10) = counts(i Mod 10) + 1
bc = bc + 1
If bc = 50 Then
Print "First 50 Blum integers:"
For j = 0 To 49
Print Using "####"; blum(j);
If (j + 1) Mod 10 = 0 Then Print
Next
Print
ElseIf bc = 26828 Or bc Mod 100000 = 0 Then
Print Using "The ###,###th Blum integer is: #,###,###"; bc; i
If bc = 400000 Then
Print Chr$(10); "% distribution of the first 400,000 Blum integers:"
For j = 1 To 9 Step 2
If j <> 5 Then
Print Using " ##.###% end in #"; (counts(j%) / 4000); j%
End If
Next
End
End If
End If
End If
End If
If i Mod 5 = 3 Then i = i + 4 Else i = i + 2
Loop
End
Function firstPrimeFactor& (n As Long)
Dim k As Long, idx As Integer
If n = 1 Then firstPrimeFactor& = 1: Exit Function
If n Mod 3 = 0 Then firstPrimeFactor& = 3: Exit Function
If n Mod 5 = 0 Then firstPrimeFactor& = 5: Exit Function
k = 7: idx = 0
Do While k * k <= n
If n Mod k = 0 Then
firstPrimeFactor& = k
Exit Function
End If
k = k + inc(idx)
idx = (idx + 1) Mod 8
Loop
firstPrimeFactor& = n
End Function
Function isPrime% (n As Long)
Dim i As Long
If n <= 1 Then Exit Function
If n <= 3 Then isPrime% = 1: Exit Function
If n Mod 2 = 0 Or n Mod 3 = 0 Then Exit Function
i = 5
While i * i <= n
If n Mod i = 0 Or n Mod (i + 2) = 0 Then Exit Function
i = i + 6
Wend
isPrime% = 1
End Function