The longest sum of consecutive primes below 1000 that adds to a prime, contains n terms, and is equal to S.
Find n and S.
Inspired by Project Euler.
DefDbl A-Z
Dim pr(200), crlf$, maxlen, maxval
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
Do
p = nxtprm(p): ct = ct + 1
pr(ct) = p
Loop Until p > 1000
ct = ct - 1
For a = 1 To ct - 1
tot = pr(a)
For b = a + 1 To ct
tot = tot + pr(b)
If prmdiv(tot) = tot Then
If b - a + 1 > maxlen Then
maxlen = b - a + 1: maxlena = a: maxlenb = b
maxlentot = tot
End If
If tot > maxval Then
maxval = tot: maxvala = a: maxvalb = b
End If
End If
DoEvents
Next
Next
Text1.Text = Text1.Text & ct & crlf
Text1.Text = Text1.Text & maxlen & Str(pr(maxlena)) & Str(pr(maxlenb))
Text1.Text = Text1.Text & " " & maxlentot & crlf
Text1.Text = Text1.Text & maxval & Str(pr(maxvala)) & Str(pr(maxvalb)) & crlf
End Sub
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
If x = 0 Then nxtprm = 2: Exit Function
n = x + 1
While prmdiv(n) < n
n = n + 1
Wend
nxtprm = n
End Function
reports
168
163 13 997 76099
76099 13 997
indicating that there are 168 primes under 1000. The longest range that adds up to a prime is 163 primes long, from 13 to 997, adding up to 76099. This is also the largest such total.
So n is 163 and S is 76099.
|
|
Posted by Charlie
on 2016-10-11 13:45:47 |
computer solution