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

Home > Numbers
Matryoshka Nesting Primes (Posted on 2016-03-03) Difficulty: 3 of 5
In what base(s) there exist a prime number abcd (a string of distinct digits), such that a, ab, abc are also prime numbers?

No Solution Yet Submitted by Ady TZIDON    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
re(7): computer solution -- the program | Comment 8 of 11 |
(In reply to re(6): computer solution (continued) by Charlie)

DefDbl A-Z
Dim crlf$


Private Sub Form_Load()
 Form1.Visible = True
 
 Text1.Text = ""
 crlf = Chr$(13) + Chr$(10)
 
 Open "4 primes bases.txt" For Output As #2
 
 For bse = 3 To 36
   Text1.Text = Text1.Text & bse & crlf
   st = bse * bse * bse
   fin = st * bse
   p = nxtprm(st)
   Do
     DoEvents
     s4$ = base$(p, bse)
     p1 = fromBase(Left(s4$, 1), bse)
     If prmdiv(p1) = p1 And p1 > 1 Then
        p2 = fromBase(Left(s4$, 2), bse)
        If prmdiv(p2) = p2 Then
          p3 = fromBase(Left(s4$, 3), bse)
          If prmdiv(p3) = p3 Then
            Print #2, bse & "  " & s4 & "  " & p1 & Str(p2) & Str(p3) & Str(p)
          End If
        End If
     End If
     p = nxtprm(p)
   Loop Until p > fin
 Next bse
 
 Close 2
 
 Text1.Text = Text1.Text & crlf & " done"
  
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
  n = x + 1
  While prmdiv(n) < n
    n = n + 1
  Wend
  nxtprm = n
End Function

Function base$(n, b)
  v$ = ""
  n2 = n
  Do
    d = n2 Mod b
    n2 = n2 \ b
    v$ = Mid("0123456789abcdefghijklmnopqrstuvwxyz", d + 1, 1) + v$
  Loop Until n2 = 0
  base$ = v$
End Function

Function fromBase(n$, b)
  v = 0
  For i = 1 To Len(n$)
    c$ = LCase$(Mid(n$, i, 1))
    If c$ > " " Then
      v = v * b + InStr("0123456789abcdefghijklmnopqrstuvwxyz", c$) - 1
    End If
  Next
  fromBase = v
End Function


  Posted by Charlie on 2016-03-03 15:29:17
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 (2)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

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