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?
(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)
Private Sub Form_Load()
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 |