 All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars  perplexus dot info  Prime power puzzle (Posted on 2017-04-01) 603, 604, and 605 are the first 3 consecutive integers that are the product of a prime and another prime squared.

603=32*67
604=22*151
605=5*112

1. What is the first set of 4 consecutive integers that are the product of a prime and another prime squared?
2. What is the first set of 5 consecutive integers that are the product of a prime and another prime squared?

 See The Solution Submitted by Math Man Rating: 5.0000 (1 votes) Comments: ( Back to comment list | You must be logged in to post comments.) re(2): Half A proof | Comment 6 of 9 | (In reply to re: Half A proof by Math Man)

Indeed, streamlining the program as suggested does in fact find the set of four consecutive integers, though of course it misses the first occurrence of one, two or three consecutive such integers:

1 in row 18
2 in row 99
3 in row 7444
4 in row 17042641444

17042641444 itself is 2*2*4260660361
17042641443 is  3*3*1893626827
17042641442 is the 2*92311^2 that instituted the subsearch
17042641441 is 7*7*347809009

It misses the first 1 in row through 3 in row as none of them have a member of the form 2*p^2, while 4 in a row are guaranteed to have one such member.

DefDbl A-Z
Dim crlf\$, fct(20, 1)

Form1.Visible = True

Text1.Text = ""
crlf = Chr\$(13) + Chr\$(10)

p = 1
Do
p = nxtprm(p)
p2 = 2 * p * p

For n = p2 - 3 To p2 + 3
f = factor(n)
If f = 2 Then
If fct(1, 1) + fct(2, 1) = 3 Then
consec = consec + 1
Else
consec = 0
End If
Else
consec = 0
End If

If consec > conmax Then
Text1.Text = Text1.Text & consec & " in row " & n & crlf
conmax = consec
End If
DoEvents
Next n

Loop

Text1.Text = Text1.Text & crlf & " done"

End Sub

Function factor(num)
diffCt = 0: good = 1
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
If INKEY\$ = Chr\$(27) Then s\$ = Chr\$(27): Exit Function
Loop
If n > 1 Then diffCt = diffCt + 1: fct(diffCt, 0) = n: fct(diffCt, 1) = 1
factor = diffCt
Exit Function

DivideIt:
cnt = 0
Do
q = Int(n / dv)
If q * dv = n And n > 0 Then
n = q: cnt = cnt + 1: If n > 0 Then limit = Sqr(n) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
Else
Exit Do
End If
Loop
If cnt > 0 Then
diffCt = diffCt + 1
fct(diffCt, 0) = dv
fct(diffCt, 1) = cnt
End If
Return
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
n = n + 1
Wend
nxtprm = n
End Function

Stopping at 2*429227^2, we still have not found five in a row.

 Posted by Charlie on 2017-04-02 19:08:32 Please log in:

 Search: Search body:
Forums (0)