All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars    
perplexus dot info

Home > Numbers
From primes to palindromes (Posted on 2018-05-16) Difficulty: 3 of 5

No Solution Yet Submitted by Ady TZIDON    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
Solution computer solution Comment 4 of 4 |
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
Please log in:
Login:
Password:
Remember me:
Sign up! | Forgot password


Search:
Search body:
Forums (0)
Newest Problems
Random Problem
FAQ | About This Site
Site Statistics
New Comments (1)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

Chatterbox:
Copyright © 2002 - 2018 by Animus Pactum Consulting. All rights reserved. Privacy Information