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

Home > Numbers
Find this number (Posted on 2016-04-04) Difficulty: 2 of 5
Every composite number N can be represented by a product of k (k>1) primes, not necessarily distinct, N=p1, p2, p3, … plast, e.g. 28=2*2*7.
In this case, the sum of al primes from the smallest to the last, including both is 2+3+5+7=17, which differs from the number 28.

What is the smallest composite number that equals the inclusive sum of the primes from its smallest to the largest prime factor, including both ?

How many additional numbers, displaying the said feature exist below 200?

No Solution Yet Submitted by Ady TZIDON    
No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
Solution computer solution Comment 1 of 1
The smallest four are listed in the first column below. The prime addends are shown to the right.

10         2 3 5
39         3 5 7 11 13
155         5 7 11 13 17 19 23 29 31
371         7 11 13 17 19 23 29 31 37 41 43 47 53

Looking up the sequence of numbers in Sloane's OEIS finds A055233, indicating that the next two in this sequence are 2935561623745 and 454539357304421.

The same four numbers also begin the sequence A055514, but that sequence has a less stringent criterion for membership: that the sum of the consecutive primes is divisible by the first and last primes, perhaps also having a smaller divisor as well. not requiring that the primes be summed back to that prime.

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


Private Sub Form_Load()
 Form1.Visible = True
 
 Text1.Text = ""
 crlf = Chr$(13) + Chr$(10)
 
 For n = 4 To 999
   DoEvents
   f = factor(n)
   p = fct(1, 0): lastp = fct(f, 0)
   p1 = p
   s = 0
   Do
     s = s + p
     p = nxtprm(p)
   Loop Until p > lastp
   If s = n And f > 1 Then
     Text1.Text = Text1.Text & n & "        "
     p = p1
     Do
       Text1.Text = Text1.Text & Str(p)
       p = nxtprm(p)
     Loop Until p > lastp
     Text1.Text = Text1.Text & crlf
     
   End If
 Next
 n = 2935561623745#
     
 
 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


  Posted by Charlie on 2016-04-04 11:21:07
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 (3)
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