There is a prime quadruple i.e. four consecutive primes such that:
a. Each one of them consists of distinct digits.
b. For each one of them the sum of the digits' cubes is a prime number.
c. In the new sequence of 4 primes none has repeated digits.
I believe there is a poor chance of multiple solutions but you are welcome to explore the issue after finding "my" quadruple (all are 3 digit primes).
Each row of four successive primes is followed by a line with their sum of digits' cubes:
821 823 827 829
521 547 863 1249
2063 2069 2081 2083
251 953 521 547
2069 2081 2083 2087
953 521 547 863
2081 2083 2087 2089
521 547 863 1249
850613 850631 850637 850673
881 881 1223 1223
The four-digit cases are really one set of six successive primes:
2063 2069 2081 2083 2087 2089
251 953 521 547 863 1249
The six-digit case does not fit the puzzle's requirement that there be no repeat digit within each of the digit cube totals.
DefDbl A-Z
Dim crlf$
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
Do
pppp = ppp
ppp = pp
pp = p
p = nxtprm(p)
sc = sumcubes(p)
If sc > 0 And prmdiv(sc) = sc Then
succCt = succCt + 1
If succCt > 3 Then
Text1.Text = Text1.Text & pppp & Str(ppp) & Str(pp) & Str(p) & crlf
Text1.Text = Text1.Text & sumcubes(pppp) & Str(sumcubes(ppp)) & Str(sumcubes(pp)) & Str(sumcubes(p)) & crlf
Text1.Text = Text1.Text & crlf
DoEvents
End If
Else
succCt = 0
End If
Loop Until p > 1000000
Text1.Text = Text1.Text & "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 sumcubes(x)
s$ = LTrim(Str(x))
tot = 0
For i = 1 To Len(s)
If InStr(Mid(s, i + 1), Mid(s, i, 1)) > 0 Then sumcubes = 0: Exit Function
v = Val(Mid(s, i, 1))
tot = tot + v * v * v
Next
sumcubes = tot
End Function
|
|
Posted by Charlie
on 2015-05-06 15:40:46 |
computer solution
