DefDbl A-Z
Dim fct(20, 1), f, factr, dgt$
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
For dg = 0 To 9
dgt$ = LTrim(Str(dg))
For n = 2 To 1000000
factr = 1
f = factor(n)
If f > 1 Or fct(1, 1) > 1 Then
If f > 2 Or f = 2 And (fct(1, 1) > 1 Or fct(2, 1)) > 1 Then
If isitgood(1) Then
Text1.Text = Text1.Text & mform(dg, "#0") & mform(n, "#####0" & " ")
vlu = n
Do
pf = prmdiv(vlu): vlu = vlu / pf
Text1.Text = Text1.Text & Str(pf)
Loop Until vlu = 1
Text1.Text = Text1.Text & Chr(13) & Chr(10)
DoEvents
Exit For
End If
End If
End If
Next
Next
End Sub
Function isitgood(wh)
bad = 0
For usetimes = 0 To fct(wh, 1)
factr = factr * fct(wh, 0) ^ usetimes
If wh = f Then
fs$ = LTrim(Str(Int(factr + 0.5)))
If InStr(fs$, dgt$) = 0 And factr <> 1 Then bad = 1: Exit For
Else
If isitgood(wh + 1) = 0 Then bad = 1: Exit For
End If
factr = factr / fct(wh, 0) ^ usetimes
Next
If bad Then isitgood = 0 Else isitgood = 1
End Function
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
finds
p N prime factors of N
0 10201 101 101
1 121 11 11
2 254 2 127
3 39 3 13
4 1849 43 43
5 25 5 5
6 16043 61 263
7 497 7 71
8 6889 83 83
9 1691 19 89
(I thought for completeness, we might include zero.)
Seeking candidates for N with more than 3 divisors:
(by using
If f > 2 Or f = 2 And (fct(1, 1) > 1 Or fct(2, 1)) > 1 Then
)
1 1859 11 13 13
2 32258 2 127 127
3 34917 3 103 113
5 75815 5 59 257
7 53179 7 71 107
9 150499 19 89 89
Again, only the prime factors are shown, but of course all the divisors may be found by multiplication, such as:
19*89=1691, 89^2=7921, in addition to 19, 89 and 150499 itself.
|
Posted by Charlie
on 2014-05-25 14:15:40 |