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

Home > Just Math
Prime power puzzle (Posted on 2017-04-01) Difficulty: 3 of 5
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)


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
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 (13)
Unsolved Problems
Top Rated Problems
This month's top
Most Commented On

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