DefDbl A-Z
Dim crlf$, tval(10)
Dim fct(20, 1)
Private Sub Form_Load()
Text1.Text = ""
crlf$ = Chr(13) + Chr(10)
Form1.Visible = True
DoEvents
For target = 1 To 10000
For a = 0 To 1
tval(1) = a
For b = 0 To 1
tval(2) = b
For c = 0 To 1
tval(3) = c
For d = 0 To 1
tval(4) = d
For e = 0 To 1
tval(5) = e
For f = 0 To 1
tval(6) = f
For g = 0 To 1
tval(7) = g
For h = 0 To 1
tval(8) = h
For i = 0 To 1
tval(9) = i
For j = 0 To 1
tval(10) = j
good = 1
If a <> Abs(i Or j) Then good = 0
If b <> Abs(a <> b) Then good = 0
cons3 = 0
For ix = 1 To 8
If (tval(ix) = 0 And tval(ix + 1) = 0 And tval(ix + 2) = 0) Then cons3 = 1: Exit For
Next
If c <> cons3 Then good = 0
true1 = 0
For ix = 1 To 10
If tval(ix) = 1 And true1 = 0 Then true1 = ix
If tval(ix) = 1 Then truelast = ix
Next
diff = truelast - true1
If diff = 0 Then
texpect = 0
Else
If target Mod diff = 0 Then texpect = 1 Else texpect = 0
End If
If d <> texpect Then good = 0
sumtrue = 0
For ix = 1 To 10
sumtrue = sumtrue + tval(ix)
Next
If e <> Abs(sumtrue = target) Then good = 0
If f = 0 Then
texpect = 1
Else
If g + h + i + j > 0 Then texpect = 1 Else texpect = 0
End If
If f <> texpect Then good = 0
texpect = 1
For ix = 1 To 10
If tval(ix) = 1 Then If target Mod ix > 0 Then texpect = 0: Exit For
Next
If g <> texpect Then good = 0
cons3 = 0
For ix = 1 To 8
If tval(ix) And tval(ix + 1) And tval(ix + 2) Then cons3 = 1: Exit For
Next
If h = Abs(target <> sumtrue * 10) Then good = 0
If j = cons3 Then good = 0
If good Then
pfact = factor(target)
nf = 1
For ix = 1 To pfact
nf = nf * (fct(ix, 1))
Next
nf = nf - 2
If i <> Abs(nf > sumtrue) Then good = 0
If good Then
Text1.Text = Text1.Text & Str(target)
For ix = 1 To 10
Text1.Text = Text1.Text & Str(tval(ix))
Next
Text1.Text = Text1.Text + crlf$
DoEvents
End If
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next target
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
re(2): Solution
