RosettaCodeData/Task/Cyclops-numbers/FreeBASIC/cyclops-numbers.basic

125 lines
3.9 KiB
Plaintext

Dim Shared As Double t
Dim Shared As Uinteger n(16), clops(52), primes(52), blinds(52), pals(52)
Dim Shared As Uinteger num, iClop, iPrime, iBlind, iPal
Dim Shared As Uinteger first1, last1, midPt
midPt = 8
Function convertToNumber As Uinteger
Dim As Uinteger p10 = 1, nr = 0, c2 = last1
Do
nr += n(c2) * p10
If c2 = midPt Then p10 *= 100 Else p10 *= 10 'Add 0 if at midPoint
c2 -= 1
Loop Until c2 < first1
Return nr
End Function
Sub increment(dgt As Uinteger)
If n(dgt) < 9 Then n(dgt) += 1 : Exit Sub
n(dgt) = 1
If dgt > first1 Then increment(dgt - 1) : Exit Sub 'Carry
first1 -= 1 : last1 += 1
For dgt = first1 To last1 'New width: set all digits to 1
n(dgt) = 1
Next dgt
End Sub
Function isPrime(v As Uinteger) As Boolean
'Skip check for 2 and 3 because we're starting at 101
If v Mod 2 = 0 Then Return False
If v Mod 3 = 0 Then Return False
Dim As Uinteger f = 5
While f*f <= v
If v Mod f = 0 Then Return False
f += 2
If v Mod f = 0 Then Return False
f += 4
Wend
Return True
End Function
Function isBlind As Boolean
Dim As Uinteger temp = 0
Swap temp, midPt 'Keep fn convertToNumber from adding 0 at midPt
Dim As Boolean rslt = isPrime(convertToNumber())
Swap temp, midPt
Return rslt
End Function
Function isPalindrome As Boolean
Dim As Uinteger a = first1, b = last1
While b > a
If n(a) <> n(b) Then Return False
a += 1 : b -= 1
Wend
Return True
End Function
Sub print50(title As String, addr() As Uinteger)
Dim As Uinteger r = 0
Print : Print title
While r < 50
Print Using "#########"; addr(r);
r += 1 : If r Mod 10 = 0 Then Print
Wend
End Sub
Sub display
print50(" First 50 Cyclopean numbers:", clops())
print50(" First 50 Cyclopean primes:", primes())
print50(" First 50 blind Cyclopean primes:", blinds())
print50(" First 50 palindromic Cyclopean primes:", pals())
Print
Print Using " First Cyclopean number above 10,000,000 is ######### at index ######"; clops(50); clops(51)
Print Using " First Cyclopean prime above 10,000,000 is ######### at index ######"; primes(50); primes(51)
Print Using " First blind Cyclopean prime above 10,000,000 is ######### at index ######"; blinds(50); blinds(51)
Print Using " First palindromic Cyclopean prime above 10,000,000 is ######### at index ######"; pals(50); pals(51)
Print
Print Using " Compute time: ###.### sec"; t
End Sub
Sub cyclops
clops(0) = 0 : iClop = 1 : iPrime = 0 : iBlind = 0 : iPal = 0
first1 = midPt-1 : last1 = midPt : n(first1) = 1 : n(last1) = 1
' Record first 50 numbers in each category
While iPal < 50
num = convertToNumber()
If iClop < 50 Then clops(iClop) = num
iClop += 1
If isPrime(num) Then
If iPrime < 50 Then primes(iPrime) = num : iPrime += 1
If iBlind < 50 Andalso isBlind() Then blinds(iBlind) = num : iBlind += 1
If iPal < 50 Andalso isPalindrome() Then pals(iPal) = num : iPal += 1
End If
num += 1
increment(last1)
Wend
' Keep counting Cyclops numbers until 10,000,000
While convertToNumber() < 1e7
increment(last1) : iClop += 1
Wend
' Find next number in each category
clops(50) = convertToNumber() : clops(51) = iClop
iPrime = 1 : iBlind = 1 : iPal = 1
While (iPrime Or iBlind Or iPal)
num = convertToNumber()
iClop += 1
If isPrime(num) Then
If iPrime = 1 Then primes(50) = num : primes(51) = iClop : iPrime = 0
If iBlind = 1 Andalso isBlind() Then blinds(50) = num : blinds(51) = iClop : iBlind = 0
If iPal = 1 Andalso isPalindrome() Then pals(50) = num : pals(51) = iClop : iPal = 0
End If
increment(last1)
Wend
End Sub
t = Timer
cyclops()
t = Timer - t
display()
Sleep