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

 Weird numbers (Posted on 2014-05-02)
A weird number is a positive integer n such that the sum of the proper divisors of n is greater than n, but no subset of its proper divisors add up to n. What is the smallest weird number?

 See The Solution Submitted by Math Man No Rating

Comments: ( Back to comment list | You must be logged in to post comments.)
 computer solution Comment 2 of 2 |
DefDbl A-Z
Dim fct(20, 1), good, f, fcnt, fcntd, n, tot, prod, maxf, fctrs(100), fctrcnt, ftot

Text1.Text = ""
crlf\$ = Chr(13) + Chr(10)
For n = 2 To 25000
DoEvents
f = factor(n)
fcnt = 0
For i = 1 To f: fcnt = fcnt + fct(i, 1): Next
fcntx = 1
For i = 1 To f: fcntx = fcntx * fct(i, 1): Next
good = 1: tot = 0: fcntd = 0: prod = 1: fctrcnt = 0
sumIt 1
If tot > n And good = 1 Then
ftot = 0
If good Then
Form1.Visible = True
Text1.Text = Text1.Text & Str(n) & "   "
For ix = 1 To fctrcnt
Text1.Text = Text1.Text & Str(fctrs(ix))
Next
Text1.Text = Text1.Text & crlf\$
DoEvents
End If
End If
Next n
End Sub

For countit = 0 To 1
If good = 0 Then Exit Sub
ftot = ftot + fctrs(wh) * countit
If wh = fctrcnt Then
If ftot = n Then good = 0: Exit Sub
Else
End If
ftot = ftot - fctrs(wh) * countit
Next
End Sub

Function sumIt(wh)
For inc = 0 To fct(wh, 1)
For mct = 1 To inc: prod = prod * fct(wh, 0): Next
fcntd = fcntd + inc
If wh < f Then
sumIt wh + 1
Else
If fcntd < fcnt Then
tot = tot + prod:
fctrcnt = fctrcnt + 1: fctrs(fctrcnt) = prod:
End If
End If
If inc <> 0 Then
For mct = 1 To inc: prod = prod / fct(wh, 0): Next
End If
fcntd = fcntd - inc
Next
End Function

Function factor(num)
diffCt = 0: good = 1
nm1 = Abs(num): If nm1 > 0 Then limit = Sqr(nm1) 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 nm1 > 1 Then diffCt = diffCt + 1: fct(diffCt, 0) = nm1: fct(diffCt, 1) = 1
factor = diffCt
Exit Function

DivideIt:
cnt = 0
Do
q = Int(nm1 / dv)
If q * dv = nm1 And nm1 > 0 Then
nm1 = q: cnt = cnt + 1: If nm1 > 0 Then limit = Sqr(nm1) 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

`number   its divisors less than the number itself   70    1 7 5 35 2 14 10  836    1 19 11 209 2 38 22 418 4 76 44  4030    1 31 13 403 5 155 65 2015 2 62 26 806 10 310 130  5830    1 53 11 583 5 265 55 2915 2 106 22 1166 10 530 110  7192    1 31 29 899 2 62 58 1798 4 124 116 3596 8 248 232  7912    1 43 23 989 2 86 46 1978 4 172 92 3956 8 344 184  9272    1 61 19 1159 2 122 38 2318 4 244 76 4636 8 488 152  10430    1 149 7 1043 5 745 35 5215 2 298 14 2086 10 1490 70  10570    1 151 7 1057 5 755 35 5285 2 302 14 2114 10 1510 70  10792    1 71 19 1349 2 142 38 2698 4 284 76 5396 8 568 152  10990    1 157 7 1099 5 785 35 5495 2 314 14 2198 10 1570 70  11410    1 163 7 1141 5 815 35 5705 2 326 14 2282 10 1630 70  11690    1 167 7 1169 5 835 35 5845 2 334 14 2338 10 1670 70  12110    1 173 7 1211 5 865 35 6055 2 346 14 2422 10 1730 70  12530    1 179 7 1253 5 895 35 6265 2 358 14 2506 10 1790 70  12670    1 181 7 1267 5 905 35 6335 2 362 14 2534 10 1810 70  13370    1 191 7 1337 5 955 35 6685 2 382 14 2674 10 1910 70  13510    1 193 7 1351 5 965 35 6755 2 386 14 2702 10 1930 70  13790    1 197 7 1379 5 985 35 6895 2 394 14 2758 10 1970 70  13930    1 199 7 1393 5 995 35 6965 2 398 14 2786 10 1990 70  14770    1 211 7 1477 5 1055 35 7385 2 422 14 2954 10 2110 70  15610    1 223 7 1561 5 1115 35 7805 2 446 14 3122 10 2230 70  15890    1 227 7 1589 5 1135 35 7945 2 454 14 3178 10 2270 70  16030    1 229 7 1603 5 1145 35 8015 2 458 14 3206 10 2290 70  16310    1 233 7 1631 5 1165 35 8155 2 466 14 3262 10 2330 70  16730    1 239 7 1673 5 1195 35 8365 2 478 14 3346 10 2390 70  16870    1 241 7 1687 5 1205 35 8435 2 482 14 3374 10 2410 70  17272    1 127 17 2159 2 254 34 4318 4 508 68 8636 8 1016 136  17570    1 251 7 1757 5 1255 35 8785 2 502 14 3514 10 2510 70  17990    1 257 7 1799 5 1285 35 8995 2 514 14 3598 10 2570 70  18410    1 263 7 1841 5 1315 35 9205 2 526 14 3682 10 2630 70  18830    1 269 7 1883 5 1345 35 9415 2 538 14 3766 10 2690 70  18970    1 271 7 1897 5 1355 35 9485 2 542 14 3794 10 2710 70  19390    1 277 7 1939 5 1385 35 9695 2 554 14 3878 10 2770 70  19670    1 281 7 1967 5 1405 35 9835 2 562 14 3934 10 2810 70  19810    1 283 7 1981 5 1415 35 9905 2 566 14 3962 10 2830 70  20510    1 293 7 2051 5 1465 35 10255 2 586 14 4102 10 2930 70  21490    1 307 7 2149 5 1535 35 10745 2 614 14 4298 10 3070 70  21770    1 311 7 2177 5 1555 35 10885 2 622 14 4354 10 3110 70  21910    1 313 7 2191 5 1565 35 10955 2 626 14 4382 10 3130 70  22190    1 317 7 2219 5 1585 35 11095 2 634 14 4438 10 3170 70  23170    1 331 7 2317 5 1655 35 11585 2 662 14 4634 10 3310 70  23590    1 337 7 2359 5 1685 35 11795 2 674 14 4718 10 3370 70  24290    1 347 7 2429 5 1735 35 12145 2 694 14 4858 10 3470 70  24430    1 349 7 2443 5 1745 35 12215 2 698 14 4886 10 3490 70  24710    1 353 7 2471 5 1765 35 12355 2 706 14 4942 10 3530 70`

 Posted by Charlie on 2014-05-02 16:50:42

 Search: Search body:
Forums (0)