The sum of all divisors of this semiprime number is 2696.
What is the number?
Bonus: What if the word "semiprime" was erased from the puzzle?
DefDbl A-Z
Dim crlf$, fct(20, 1), sumOfDiv, f, thisFact
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
For n = 2 To 2696
thisFact = 1
sumOfDiv = 0
f = factor(n)
addThem 1
If sumOfDiv = 2696 Then
Text1.Text = Text1.Text & n & Str(sumOfDiv) & crlf
End If
Next
Text1.Text = Text1.Text & Str(tot2)
End Sub
Sub addThem(wh)
pwr = 1
For p = 0 To fct(wh, 1)
thisFact = thisFact * pwr
If wh = f Then
sumOfDiv = sumOfDiv + thisFact
Else
addThem wh + 1
End If
thisFact = thisFact / pwr
pwr = pwr * fct(wh, 0)
Next
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
finds only the semiprime solution, so erasing "semiprime" from the puzzle doesn't add any solutions.
|
|
Posted by Charlie
on 2019-02-13 13:43:15 |
bonus
