(In reply to
computer results (spoilers) by Charlie)
The below programs are left in their 2016 state. The 2017 version uses the same logic.
DefDbl A-Z
Dim crlf$, nlist$, nptr, closest, closelist$, lst$, stack(11), stacklvl
Dim frmla$(1 To 50), leadzeros
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
For leadzeros = 1 To 0 Step -1
nlist = "2016"
h$ = nlist
Do
permute nlist
nptr = 1
stacklvl = 0
lst = ""
addOn
Loop Until nlist = h$
Next leadzeros
For i = 1 To 50
Text1.Text = Text1.Text & i & " " & frmla(i) & crlf
Next
Text1.Text = Text1.Text & crlf & " done"
End Sub
Sub addOn()
DoEvents
lin = Len(lst)
If stacklvl = 1 Then
If nptr = 5 Then
If stack(1) = Int(stack(1)) And stack(1) >= 1 And stack(1) <= 50 Then
' Text1.Text = Text1.Text & stack(1) & Str(Abs(10958 - stack(1)))
' Text1.Text = Text1.Text & lst & crlf
' closest = stack(1)
' closelist = lst
frmla(stack(1)) = lst
End If
End If
End If
If stacklvl > 0 Then
If stack(1) = Int(stack(1)) And (stack(1) = 0 Or stack(1) > 2) And stack(1) <= 16 Then
fact = 1
For fctr = 2 To stack(1)
fact = fact * fctr
Next
stsave = stack(1)
stack(1) = fact
lst = lst + "!"
addOn
lst = Left(lst, Len(lst) - 1)
stack(1) = stsave
End If
End If
If stacklvl >= 2 Then
y = stack(2): x = stack(1)
stack(1) = x * y
For i = 2 To 10
stack(i) = stack(i + 1)
Next
stacklvl = stacklvl - 1
lst = lst + "*"
addOn
For i = 11 To 3 Step -1
stack(i) = stack(i - 1)
Next
stack(2) = y: stack(1) = x
stacklvl = stacklvl + 1
lst = Left(lst, Len(lst) - 1)
y = stack(2): x = stack(1)
stack(1) = y - x
For i = 2 To 10
stack(i) = stack(i + 1)
Next
stacklvl = stacklvl - 1
lst = lst + "-"
addOn
For i = 11 To 3 Step -1
stack(i) = stack(i - 1)
Next
stack(2) = y: stack(1) = x
stacklvl = stacklvl + 1
lst = Left(lst, Len(lst) - 1)
y = stack(2): x = stack(1)
stack(1) = x + y
For i = 2 To 10
stack(i) = stack(i + 1)
Next
stacklvl = stacklvl - 1
lst = lst + "+"
addOn
For i = 11 To 3 Step -1
stack(i) = stack(i - 1)
Next
stack(2) = y: stack(1) = x
stacklvl = stacklvl + 1
lst = Left(lst, Len(lst) - 1)
If Abs(stack(1)) > 1E-100 Then
y = stack(2): x = stack(1)
stack(1) = y / x
For i = 2 To 10
stack(i) = stack(i + 1)
Next
stacklvl = stacklvl - 1
lst = lst + "/"
addOn
For i = 11 To 3 Step -1
stack(i) = stack(i - 1)
Next
stack(2) = y: stack(1) = x
stacklvl = stacklvl + 1
lst = Left(lst, Len(lst) - 1)
End If
nflag = 0
If stack(2) = 0 And stack(1) > 0 Then good = 1 Else good = 0
If stack(2) < 0 And stack(1) = Int(stack(1)) Then
q = Int(x / 2): r = x - 2 * q
If r = 0 Then nflag = 1
good = 1
End If
If Abs(stack(2)) > 0 Then If stack(1) * Log(Abs(stack(2))) / Log(10) < 50 Then good = 1
If good Then
y = stack(2): x = stack(1)
xodd = 0: xeven = 0
If x = Int(x) And x >= 0 Then
If stack(2) <> 0 Then good = 0
If good = 0 Then If stack(1) * Log(Abs(stack(2))) / Log(10) < 50 Then good = 1
If good Then
q = Int(x / 2): r = x - 2 * q
If r = 1 Then
xodd = 1
Else
xeven = 1
End If
End If
End If
If y >= 0 Or xodd Or xeven Then
If y < 0 Then
If xodd Then
stack(1) = (-Abs(y)) ^ x
ElseIf xeven Then
stack(1) = (Abs(y)) ^ x
End If
Else
stack(1) = y ^ x
End If
For i = 2 To 10
stack(i) = stack(i + 1)
Next
stacklvl = stacklvl - 1
lst = lst + "^"
If y = 0 Or stack(1) <> 0 Then
addOn
End If
For i = 11 To 3 Step -1
stack(i) = stack(i - 1)
Next
stack(2) = y: stack(1) = x
stacklvl = stacklvl + 1
lst = Left(lst, Len(lst) - 1)
End If
End If
End If ' stacklvl>=2
If Len(lst) <> lin Then
xx = xx
End If
If nptr < 5 Then
For i = 11 To 2 Step -1
stack(i) = stack(i - 1)
Next
stack(1) = Val(Mid(nlist, nptr, 1))
nptr = nptr + 1
stacklvl = stacklvl + 1
lst = lst + "," + Mid(nlist, nptr - 1, 1)
addOn
For i = 1 To 10
stack(i) = stack(i + 1)
Next
nptr = nptr - 1
stacklvl = stacklvl - 1
lst = Left(lst, Len(lst) - 2)
If Len(lst) <> lin Then
xx = xx
End If
If Len(lst) > 0 And InStr(nlist, Right(lst, 1)) > 0 Then
If stack(1) <> 0 Or leadzeros = 1 Then
stack(1) = 10 * stack(1) + Val(Mid(nlist, nptr, 1))
lst = lst + Mid(nlist, nptr, 1)
nptr = nptr + 1
addOn
nptr = nptr - 1
stack(1) = (stack(1) - Val(Mid(nlist, nptr, 1)))
lst = Left(lst, Len(lst) - 1)
End If
End If
End If
End Sub
The algebraic version of the RPN output from the above program was done by
DefDbl A-Z
Dim crlf$, nlist$, stack$(11), stacklvl
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
Open "2016 formulae.txt" For Input As #1
Open "2016 formulae with alg.txt" For Output As #2
Do
Line Input #1, l$
ix = InStr(l, ",")
If ix > 0 Then
rpn$ = Mid(l, ix)
ix2 = InStr(rpn, "2")
ix0 = InStr(rpn, "0")
ix1 = InStr(rpn, "1")
ix7 = InStr(rpn, "6")
If ix7 > ix1 And ix1 > ix0 And ix0 > ix2 Then inorder = 1 Else inorder = 0
ptr = 1
stacklvl = 0
c$ = ""
While ptr <= Len(rpn)
DoEvents
prevc$ = c$
c$ = Mid(rpn, ptr, 1)
If c = "," Then
ptr = ptr + 1
raisestack
stack(1) = Mid(rpn, ptr, 1)
stacklvl = stacklvl + 1
ElseIf c >= "0" And c <= "9" Then
stack(1) = stack(1) + c
ElseIf c = "*" Then
If InStr(stack(2), "+") > 0 Or InStr(stack(2), "-") > 0 Then
stack(2) = "(" + stack(2) + ")"
End If
If InStr(stack(1), "+") > 0 Or InStr(stack(1), "-") > 0 Then
stack(1) = "(" + stack(1) + ")"
End If
stack(1) = stack(2) + "*" + stack(1)
lowerstack
stacklvl = stacklvl - 1
ElseIf c = "/" Then
If InStr(stack(2), "+") > 0 Or InStr(stack(2), "-") > 0 Or InStr(stack(1), "*") > 0 Then
stack(2) = "(" + stack(2) + ")"
End If
If InStr(stack(1), "+") > 0 Or InStr(stack(1), "-") > 0 Or InStr(stack(1), "*") > 0 Then
stack(1) = "(" + stack(1) + ")"
End If
stack(1) = stack(2) + "/" + stack(1)
lowerstack
stacklvl = stacklvl - 1
ElseIf c = "+" Or c = "-" Then
If c = "-" Then
If InStr(stack(2), "+") > 0 Or InStr(stack(2), "-") > 0 Then
stack(2) = "(" + stack(2) + ")"
End If
If InStr(stack(1), "+") > 0 Or InStr(stack(1), "-") > 0 Then
stack(1) = "(" + stack(1) + ")"
End If
End If
stack(1) = stack(2) + c + stack(1)
lowerstack
stacklvl = stacklvl - 1
ElseIf c = "^" Then
If InStr(stack(2), "+") > 0 Or InStr(stack(2), "-") > 0 Or InStr(stack(1), "*") > 0 Or InStr(stack(1), "/") > 0 Then
stack(2) = "(" + stack(2) + ")"
End If
If InStr(stack(1), "+") > 0 Or InStr(stack(1), "-") > 0 Or InStr(stack(1), "*") > 0 Or InStr(stack(1), "/") > 0 Then
stack(1) = "(" + stack(1) + ")"
End If
stack(1) = stack(2) + "^" + stack(1)
lowerstack
stacklvl = stacklvl - 1
ElseIf c = "!" Then
If InStr(stack(1), "+") > 0 Or InStr(stack(1), "-") > 0 Or InStr(stack(1), "*") > 0 Or InStr(stack(1), "/") > 0 Or InStr(stack(1), "^") > 0 Then
stack(1) = "(" + stack(1) + ")"
End If
stack(1) = stack(1) + "!"
End If
ptr = ptr + 1
Wend
Print #2, l + " " + stack(1);
If inorder Then Print #2, " <---" Else Print #2,
Text1.Text = Text1.Text & l + " " + stack(1) & crlf
Else
Print #2, l
End If
Loop Until EOF(1)
Close
Text1.Text = Text1.Text & crlf & " done"
End Sub
Sub raisestack()
For i = 11 To 2 Step -1
stack(i) = stack(i - 1)
Next
End Sub
Sub lowerstack()
For i = 2 To 10
stack(i) = stack(i + 1)
Next
End Sub
|
|
Posted by Charlie
on 2017-06-23 18:17:48 |
program
