Having a Visual Basic 3.0 formula evaluator already written, I modified a routine to evaluate all possiblities (brute force attack). The routine is rather sloppy as the evaluation routine requires some preparatory work outside itself. The prep work is left unbolded below, while the actual solving logic is in boldface:
Sub cmdStart_click ()
currentx = 1: currenty = 1
Open "blockout.txt" For Output As #2
For be = 1 To 3
basEq$ = Choose(be, "12+8/2/2/2=1*2+4", "(2+7)*5=6*4+18-5", "1+2+3+4=236-20+8")
Print : Print basEq$: Print
Print #2, : Print #2, basEq$: Print #2,
For i = 1 To Len(basEq$) - 1
For j = i + 1 To Len(basEq$)
indEq$ = Left$(basEq$, i - 1) + Mid$(basEq$, i + 1, j - i - 1) + Mid$(basEq$, j + 1)
ix = InStr(indEq$, "=")
If ix > 0 Then
eq1$ = Left$(indEq$, ix - 1)
eq2$ = Mid$(indEq$, ix + 1)
eq$ = eq1$
Do
ix = InStr(eq$, "+")
If ix = 0 Then Exit Do
eq$ = Left$(eq$, ix - 1) + "&" + Mid$(eq$, ix + 1)
Loop
Do
ix = InStr(eq$, "(-)")
If ix = 0 Then Exit Do
eq$ = Left$(eq$, ix - 1) + "+" + Mid$(eq$, ix + 3)
Loop
Do
ix = InStr(eq$, "-")
If ix = 0 Then Exit Do
eq$ = Left$(eq$, ix - 1) + "_" + Mid$(eq$, ix + 1)
Loop
Do
ix = InStr(eq$, "+")
If ix = 0 Then Exit Do
eq$ = Left$(eq$, ix - 1) + "-" + Mid$(eq$, ix + 1)
Loop
ans1$ = evaluate(eq$)
eq$ = eq2$
Do
ix = InStr(eq$, "+")
If ix = 0 Then Exit Do
eq$ = Left$(eq$, ix - 1) + "&" + Mid$(eq$, ix + 1)
Loop
Do
ix = InStr(eq$, "(-)")
If ix = 0 Then Exit Do
eq$ = Left$(eq$, ix - 1) + "+" + Mid$(eq$, ix + 3)
Loop
Do
ix = InStr(eq$, "-")
If ix = 0 Then Exit Do
eq$ = Left$(eq$, ix - 1) + "_" + Mid$(eq$, ix + 1)
Loop
Do
ix = InStr(eq$, "+")
If ix = 0 Then Exit Do
eq$ = Left$(eq$, ix - 1) + "-" + Mid$(eq$, ix + 1)
Loop
ans2$ = evaluate(eq$)
If Val(ans1$) = Val(ans2$) Then
Print eq1$; "="; eq2$; "; "; ans1$; " "; ans2$
Print #2, eq1$; "="; eq2$; "; "; ans1$; " "; ans2$
End If
End If
Next
Next
Next be
Close 2
End Sub
The program lists the original string followed by solutions with two characters missing together with the evaluation of each side, separated from the new equation by a semicolon. Along with the real answers it found one spurious answer:
12+8/2/2/2=1*2+4
1+8/2/2/2=1*2+; 2 2
128/2/2/2=12+4; 16 16
(2+7)*5=6*4+18-5
2+7*5=6*4+18-5; 37 37
1+2+3+4=236-20+8
1+23+4=236-208; 28 28
The spurious solution is of course 1+8/2/2/2=1*2+, where both sides were evaluated to 2, as 1*2+ was evaluated as 2.
The evaluate subroutine and supporting subroutines follow. Having been written for a calculator program, it's more complicated than the simple arithmetic here requires. A warning: the code was designed with the non-standard precedence of multiplication over division so that, say 2/3*4 evaluates as if it were 2/(3*4), but that did not affect the particular equations in the puzzle.
Function evaluate (stIn$)
Dim ix As Integer, i As Integer, j As Integer, n As Double
s$ = LCase$(stIn$)
Do
ix = InStr(s$, " ")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Mid$(s$, ix + 1)
Loop
On Error GoTo evalErr
errSig$ = Chr$(10) + Chr$(11) ' number code then err code
' now tokenize unary functions -- two bytes, 1st of which is chr$(10)
Do
ix = InStr(s$, "abs")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(1) + Mid$(s$, ix + 3)
Loop
Do
ix = InStr(s$, "sqr")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(2) + Mid$(s$, ix + 3)
Loop
Do
ix = InStr(s$, "asin")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(6) + Mid$(s$, ix + 4)
Loop
Do
ix = InStr(s$, "acos")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(7) + Mid$(s$, ix + 4)
Loop
Do
ix = InStr(s$, "atan")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(8) + Mid$(s$, ix + 4)
Loop
Do
ix = InStr(s$, "sin")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(3) + Mid$(s$, ix + 3)
Loop
Do
ix = InStr(s$, "cos")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(4) + Mid$(s$, ix + 3)
Loop
Do
ix = InStr(s$, "tan")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(5) + Mid$(s$, ix + 3)
Loop
Do
ix = InStr(s$, "log")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(9) + Mid$(s$, ix + 3)
Loop
Do
ix = InStr(s$, "ln")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(10) + Mid$(s$, ix + 2)
Loop
Do
ix = InStr(s$, "exp")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(12) + Mid$(s$, ix + 3)
Loop
Do
ix = InStr(s$, "pi")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(13) + Mid$(s$, ix + 2)
Loop
Do
ix = InStr(s$, "int")
If ix = 0 Then Exit Do
s$ = Left$(s$, ix - 1) + Chr$(10) + Chr$(14) + Mid$(s$, ix + 3)
Loop
i = 1: pTyp = 0
Do
iPrev = i
Select Case Mid$(s$, i, 1)
Case "x"
typ = 1
v$ = LTrim$(LCase$(Str$(x)))
s$ = Left$(s$, i - 1) + v$ + Mid$(s$, i + 1)
i = i + Len(v$)
Case "/", "*", "&", "_", "^"
typ = 2
i = i + 1
Case "0" To "9", ".", "-", "e", "d"
typ = 3
ix = verify(Mid$(s$, i), "0123456789.+-ed")
If ix = 0 Then
i = Len(s$) + 1
Else
i = i + ix - 1
End If
Case Chr$(10)
If Mid$(s$, i + 1, 1) = Chr$(13) Then
typ = 13
Else
typ = 4
End If
i = i + 2
Case "("
typ = 5
i = i + 1
Case ")"
typ = 6
i = i + 1
Case Else
GoTo evalErr
End Select
If typ <> pTyp Then
If iPrev <> 1 And typ <> 2 And pTyp <> 2 And pTyp <> 4 And typ <> 6 And pTyp <> 5 Then
If Mid$(s$, iPrev - 1, 1) <> "-" Then
s$ = Left$(s$, iPrev - 1) + "*" + Mid$(s$, iPrev)
i = i + 1
End If
End If
pTyp = typ
End If
Loop Until i > Len(s$)
Do
ix = InStr(s$, ")")
If ix = 0 Then Exit Do
For i = ix To 1 Step -1
If Mid$(s$, i, 1) = "(" Then Exit For
Next
If i = 0 Then GoTo evalErr
If Mid$(s$, i, 1) <> "(" Then GoTo evalErr
s$ = Left$(s$, i - 1) + evaluate(Mid$(s$, i + 1, ix - i - 1)) + Mid$(s$, ix + 1)
Loop ' after this, there are no paj
Do ' now look for unary functions
ix = InStr(s$, Chr$(10))
If ix = 0 Then Exit Do
typFunc = Asc(Mid$(s$, ix + 1, 1))
If typFunc = 11 Then GoTo evalErr
If typFunc = 13 Then ' pi
i = ix + 2
Else
i = verify(Mid$(s$, ix + 2), "01234567890.+-ed")
If i = 0 Then i = Len(s$) + 1: Else i = ix + i + 1
n = Val(Mid$(s$, ix + 2, i - ix - 2))
End If
Select Case typFunc
Case 1
n = Abs(n)
Case 2
n = Sqr(n)
Case 3
If optDeg Then n = n * 3.14159265358979 / 180
n = Sin(n)
Case 4
If optDeg Then n = n * 3.14159265358979 / 180
n = Cos(n)
Case 5
If optDeg Then n = n * 3.14159265358979 / 180
n = Tan(n)
Case 6
If Abs(n) = 1 Then
n = Sgn(n) * Atn(1) * 2
Else
n = Atn(n / Sqr(1 - n * n))
End If
If optDeg Then n = n * 180 / 3.14159265358979
Case 7
If n = 0 Then
n = Atn(1) * 2
ElseIf Abs(n) = 1 Then
n = 3.14159265358979 / 2 - Sgn(n) * Atn(1) * 2
Else
n = 3.14159265358979 / 2 - Atn(n / Sqr(1 - n * n))' Atn(Sqr(1 - n * n) / n)
End If
If optDeg Then n = n * 180 / 3.14159265358979
Case 8
n = Atn(n)
If optDeg Then n = n * 180 / 3.14159265358979
Case 9
n = Log(n) / Log(10)
Case 10
n = Log(n)
Case 12
n = Exp(n)
Case 13
n = 3.14159265358979
Case 14
n = Int(n)
End Select
s$ = Left$(s$, ix - 1) + LTrim$(LCase$(Str$(n))) + Mid$(s$, i)
Loop
Do
ix = InStr(s$, "^")
If ix = 0 Then Exit Do
i = verify(Mid$(s$, ix + 1), "0123456789.+-ed"): If i = 0 Then i = Len(s$) + 1 - ix
i = ix + i
j = revVerify(ix - 1, s$, "0123456789.+-ed")
n = Val(Mid$(s$, j + 1, ix - j - 1)) ^ Val(Mid$(s$, ix + 1, i - ix - 1))
s$ = Left$(s$, j) + LTrim$(LCase$(Str$(n))) + Mid$(s$, i)
Loop
Do
ix = InStr(s$, "*")
If ix = 0 Then Exit Do
i = verify(Mid$(s$, ix + 1), "0123456789.+-ed"): If i = 0 Then i = Len(s$) + 1 - ix
i = ix + i
j = revVerify(ix - 1, s$, "0123456789.+-ed")
n = Val(Mid$(s$, j + 1, ix - j - 1)) * Val(Mid$(s$, ix + 1, i - ix - 1))
s$ = Left$(s$, j) + LTrim$(LCase$(Str$(n))) + Mid$(s$, i)
Loop
Do
ix = InStr(s$, "/")
If ix = 0 Then Exit Do
i = verify(Mid$(s$, ix + 1), "0123456789.+-ed"): If i = 0 Then i = Len(s$) + 1 - ix
i = ix + i
j = revVerify(ix - 1, s$, "0123456789.+-ed")
n = Val(Mid$(s$, j + 1, ix - j - 1)) / Val(Mid$(s$, ix + 1, i - ix - 1))
s$ = Left$(s$, j) + LTrim$(LCase$(Str$(n))) + Mid$(s$, i)
Loop
Do
ix = InStr(s$, "&")
ix2 = InStr(s$, "_")
If ix2 > 0 And (ix2 < ix Or ix = 0) Then ix = ix2
If ix = 0 Then Exit Do
i = verify(Mid$(s$, ix + 1), "0123456789.+-ed"): If i = 0 Then i = Len(s$) + 1 - ix
i = ix + i
j = revVerify(ix - 1, s$, "0123456789.+-ed")
If Mid$(s$, ix, 1) = "&" Then
n = Val(Mid$(s$, j + 1, ix - j - 1)) + Val(Mid$(s$, ix + 1, i - ix - 1))
Else
n = Val(Mid$(s$, j + 1, ix - j - 1)) - Val(Mid$(s$, ix + 1, i - ix - 1))
End If
s$ = Left$(s$, j) + LTrim$(LCase$(Str$(n))) + Mid$(s$, i)
Loop
evaluate = LCase$(s$)
Exit Function
evalErr:
evaluate = errSig$
Exit Function
End Function
Function revVerify (p As Integer, s1$, s2$)
Dim i As Integer
For i = p To 1 Step -1
If InStr(s2$, Mid$(s1$, i, 1)) = 0 Then revVerify = i: Exit Function
Next
revVerify = 0
End Function
Function verify (s1$, s2$)
Dim i As Integer
For i = 1 To Len(s1$)
If InStr(s2$, Mid$(s1$, i, 1)) = 0 Then verify = i: Exit Function
Next
verify = 0
End Function
|
|
Posted by Charlie
on 2004-11-22 14:38:11 |
computer methodology (spoilers)
