DefDbl A-Z
Dim fct(20, 1)
Private Sub Form_Load()
Text1.Text = ""
For n = 2 To 10000
a = b: b = c
f = factor(n)
nf = 1
For i = 1 To f
nf = nf * (fct(i, 1) + 1)
Next
c = nf
If a = b And b = c Then
Text1.Text = Text1.Text & Str(n - 1) & Str(c) & Chr(13) & Chr(10)
End If
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 the following values for n under 10,000, with the number of divisors of n, which, per the instructions, is the same as for n-1 and n+1. The number of factors includes counting 1 and the number itself.
34 4
86 4
94 4
142 4
202 4
214 4
218 4
231 8
243 6
244 6
302 4
375 8
394 4
446 4
604 6
634 4
664 8
698 4
903 8
922 4
1042 4
1106 8
1138 4
1262 4
1275 12
1310 8
1335 8
1346 4
1402 4
1642 4
1762 4
1833 8
1838 4
1886 8
1894 4
1925 12
1942 4
1982 4
2014 8
2055 8
2102 4
2134 8
2182 4
2218 4
2265 8
2306 4
2344 8
2362 4
2434 4
2462 4
2505 8
2518 4
2524 6
2642 4
2666 8
2697 8
2722 4
2734 4
2937 8
3098 4
3111 8
3386 4
3602 4
3656 8
3657 8
3694 4
3730 8
3866 4
3902 4
3958 4
4204 6
4286 4
4402 8
4414 4
4504 8
4505 8
4534 4
4594 4
4615 8
4670 8
4696 8
4808 8
4882 4
4924 6
5134 8
5602 4
5722 4
5854 4
5863 8
5944 8
5945 8
5998 4
6055 8
6062 8
6153 8
6158 4
6183 8
6214 8
6306 8
6458 4
6478 8
6585 8
6854 8
6855 8
6873 8
6986 8
7114 4
7142 4
7166 4
7234 4
7257 8
7258 8
7342 4
7402 4
7443 6
7527 8
7862 4
7954 8
7978 4
8158 4
8186 4
8225 12
8258 4
8295 16
8393 8
8394 8
8402 4
8458 4
8534 8
8696 8
8786 8
8823 8
8914 4
8937 8
9122 4
9163 12
9214 8
9368 8
9369 8
9454 8
9694 8
9705 8
9754 4
9822 8
9831 8
9878 8
9910 8
9938 4
9986 4
|
|
Posted by Charlie
on 2014-04-18 13:02:09 |
computer solution
