The program below checks all such sets of consecutive primes that begin at or below the 4000th prime and have 200 or fewer members. Other than 3+5 = 8 (the trivial case) it finds only 439 + 443 + 449 = 1331 = 11^3.
3 5 8
439 443 449 1331
DefDbl A-Z
Dim crlf$, total(4000, 200), palin
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
pid = 11260
p = 1
For pr = 1 To 4200
p = nxtprm(p)
For row = 1 To 4000
st = pr - row + 1
If st < 0 Then st = 0
For col = st To 200
If pr >= row Then
total(row, col) = total(row, col) + p
End If
Next col
DoEvents
Next row
Next pr
Text1.Text = Text1.Text & "phase 2" & crlf
For row = 1 To 4000
For col = 2 To 200
DoEvents
If isPalin(total(row, col)) Then
cr = Int(palin ^ (1 / 3) + 0.5)
If cr * cr * cr = palin Then
firstp = row: lastp = row + col - 1
p = prm(row)
For i = firstp To lastp
Text1.Text = Text1.Text & Str(prm(i))
Next
Text1.Text = Text1.Text & " " & total(row, col) & crlf
End If
End If
Next
Next
Text1.Text = Text1.Text & crlf & " done"
End Sub
Function isPalin(x)
xs$ = LTrim(Str(x))
good = 1
For i = 1 To Len(xs) / 2
If Mid(xs, i, 1) <> Mid(xs, Len(xs) + 1 - i, 1) Then good = 0: Exit For
Next
palin = Val(xs)
isPalin = good
End Function
Function prm(i)
Dim p As Long
Open "17-bit primes.bin" For Random As #111 Len = 4
Get #111, i, p
prm = p
Close 111
End Function
Function prmdiv(num)
Dim n, dv, q
If num = 1 Then prmdiv = 1: Exit Function
n = Abs(num): If n > 0 Then limit = Sqr(n) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
dv = 2: GoSub DivideIt
dv = 3: GoSub DivideIt
dv = 5: GoSub DivideIt
dv = 7
Do Until dv > limit
GoSub DivideIt: dv = dv + 4 '11
GoSub DivideIt: dv = dv + 2 '13
GoSub DivideIt: dv = dv + 4 '17
GoSub DivideIt: dv = dv + 2 '19
GoSub DivideIt: dv = dv + 4 '23
GoSub DivideIt: dv = dv + 6 '29
GoSub DivideIt: dv = dv + 2 '31
GoSub DivideIt: dv = dv + 6 '37
Loop
If n > 1 Then prmdiv = n
Exit Function
DivideIt:
Do
q = Int(n / dv)
If q * dv = n And n > 0 Then
prmdiv = dv: Exit Function
Else
Exit Do
End If
Loop
Return
End Function
Function nxtprm(x)
Dim n
n = x + 1
While prmdiv(n) < n Or n < 2
n = n + 1
Wend
nxtprm = n
End Function
Posted by Charlie on 2018-05-16 13:37:46 |