Solved

Processing Alegebra Problems.

Posted on 2004-04-24
970 Views
I want to write a program that will process simple algebra problems.

For example, I want to be able to input...

3x + 15 = 11 - x, and have it process it in the normal way.
4x = -4
x = -1

just like that. I have started writing the program...what I have so far is.

Private Type monomial
CoEfficent As Integer
Variable As String * 1
Degree As Integer
End Type
Private Sub Command1_Click()
Dim eS As String
eS = Text1.Text

Dim lhs As String
Dim rhs As String
Dim monomial As String
lhs = Trim(Left(eS, InStr(eS, "=") - 1))
rhs = Trim(Right(eS, Len(eS) - InStr(eS, "=")))

Dim iCount As Integer
For iCount = 1 To Len(lhs)
If IsNumeric(Mid(lhs, iCount, 1)) = False Then
If isLetter(LCase(Mid(lhs, iCount, 1))) = True Then
'now, pull out the entire monomial...for processing.
For jCount = iCount To 1 Step -1 'step backwards
If (Mid(lhs, jCount, 1) = vbspace) Or (jCount = 1) Then
monomial = Mid(lhs, jCount + 1, iCount - jCount + 1)
MsgBox monomial
End If
Next jCount
End If
End If
Next iCount

'process RHS
For iCount = 1 To Len(rhs)
If IsNumeric(Mid(rhs, iCount, 1)) = False Then
If isLetter(LCase(Mid(rhs, iCount, 1))) = True Then
'we found a variable!
End If
End If
Next iCount

Private Function isLetter(char As String) As Boolean
Dim allowed As String
allowed = "abcdefghijklmnopqrstuvwxyz"
If InStr(allowed, char) = False Then
isLetter = False
Else
isLetter = True
End If
End Function

of course this code is kinda messed up, I just need some suggestions as to a good way to parse a string, extract monomials and integers and try to figure out what we are supposed to do.

-Brian
0
Question by:BrianGEFF719
• 15
• 8
• 4
• +3

LVL 19

Author Comment

ID: 10909996
This question is very difficult, so I will award extra points.
0

LVL 15

Expert Comment

ID: 10910266
explaion the problem in more detail.

what do you need exactly?

the problem is always in form:   Ax+b=c+dx      or Ax+b=cx+d

or even   Ax+bx+C=Dx+Ex-f-g

So clearly explain possible forms of the question.

0

LVL 9

Expert Comment

ID: 10911230
Will it also include squares or ^3?

I think first of all you should check if the input is correct:
1 check for = character
2 check if = character has a single occurence
3 check if a variable is present (i.e. x or y etc..)
4 check if no strange characters are present (i.e. # or \$ etc...)
5 more checks...?

Then you will have to convert the input to variables
ax + b = cx + d
a=1
b=2
c=3
d=4

then use the following formula:
x = (b-d)/a-c)
0

LVL 13

Expert Comment

ID: 10911257
One of the best functions to Parse Strings in VB is Split.......

If you have

Dim Sides( ) as String

text1.text = Ax+bx+C=Dx+Ex-f-g

Sides = Split ( text1.text,"=")

' Now Sides(0) will have "Ax+bx+C"
' and Sides(1) will have "Dx+Ex-f-g"

Similarly you can split for "+" and "-" and have all the polynomials......
I think this will be a good starting point for your project......
0

LVL 4

Expert Comment

ID: 10911541
I have accomplished this for large systems. (Writing compilers)
Here is a short explination

1) It will accept any valid algebretic expression.
2) All unknown data fields should be prompted for.
(You cannot proceed without knowing the values of the fields)

Method.
A) Parse the string and put it into Reverse polish notation (Look in a textbook for this algarothim (Or on the web)

B) Scan the fields (variables) is one is unknown then prompt for it.
C) Process the resulting Reverse Polish Stack while replacing the fields with their known values.

Good Luck,
Ed

0

LVL 19

Author Comment

ID: 10914033
The parsing is not the problem.

Secondly, the problem is not going to be in the same form.

it could be
5x + 2y + 4 = y + 4x + 14

or it could be

-2x - 4x = -2x + 12
0

LVL 19

Author Comment

ID: 10914042
SSOftware, the problem is, this is algebra. The user does not know the value of the variable, I am going to solve it for them, thats why I am writing this software.

-Brian
0

LVL 15

Expert Comment

ID: 10914096
5x + 2y + 4 = y + 4x + 14

An equation like this has infinite solutions. 2 variable s 1 equation.

how do you want to get the user input?  Any design? a textbox?

0

LVL 19

Author Comment

ID: 10914230
then throw in another equation, I am just throwing out equations for examples man...

0

LVL 19

Author Comment

ID: 10914232
5x + 2y + 4 = y + 4x + 14
2x = y

hows that, two variables, two equations...heh
0

LVL 15

Expert Comment

ID: 10914633
hmmm,

Now the question is totaly different and way more complecated.

do you want to solve a system of  multivariate equations?

in this case the solution is comletely different.

As long as the question is not clear answering it wolud not be possible.

0

LVL 15

Expert Comment

ID: 10914653
ok, that makes sense.

are you still looking for a good project management book? in that case I know another book which is
very nice and available. 19\$  on sale

but if your already found a book then you can delete the question.

Good Luck.
0

LVL 27

Expert Comment

ID: 10914924
Hi
Here is a module for solving equations of any form (linear/non-linear) with predefined precession:

'==========bas module code===========
Dim oScript As Object

Public Function SolveEquation(ByVal sEquation As String, _
ByRef Result() As Double, _
Optional ByVal nRoots As Integer = 1, _
Optional ByVal sVariable As String = "", _
Optional ByVal dblFrom As Double = -1000000, _
Optional ByVal dblTo As Double = 1000000, _
Optional ByVal dblPrecession As Double = 0.000001) As Integer

Dim sNormal As String
Dim i As Long, iSuccess As Integer
Dim c As Double

If sVariable = "" Then sVariable = FindVariable(sEquation)
sNormal = NormalizeEquation(sEquation)
If sNormal = "" Then
MsgBox "Invalid equation!", vbCritical
Exit Function
End If
ReDim Result(1 To nRoots)
Set oScript = CreateObject("MSScriptControl.ScriptControl")
oScript.Language = "vbscript"
For i = 1 To nRoots
If FindRoot(sNormal, sVariable, dblFrom, dblTo, dblPrecession, Result(i)) Then iSuccess = iSuccess + 1
c = (dblFrom + dblTo) / 2
If Result(i) < c Then dblFrom = c Else dblTo = c
Next i
SolveEquation = iSuccess
Set oScript = Nothing
End Function

Private Function NormalizeEquation(ByVal sEquation As String) As String
Dim s() As String
s = Split(sEquation, "=")
If UBound(s) <> 1 Then Exit Function
NormalizeEquation = Trim(s(0)) & " - (" & Trim(s(1)) & ")"
End Function

Private Function vbEval(ByVal sExpression As String, ByVal sArgument As String, ByVal dblArgument As Double) As Double
Dim s As String
s = Replace(sExpression, sArgument, "(" & CStr(dblArgument) & ")")
vbEval = oScript.Eval(s)
End Function

'Finding root of normalized equation with double division ("dikhotomy") method

Private Function FindRoot(ByVal sExpression As String, ByVal sArgument As String, _
ByVal a As Double, ByVal b As Double, _
ByVal epsilon As Double, ByRef res As Double) As Boolean
Dim x As Double
Dim c As Double
Dim x1 As Double, x2 As Double
Dim iter As Long, i As Long
iter = 500 'max iterrations
x1 = vbEval(sExpression, sArgument, a)
x2 = vbEval(sExpression, sArgument, b)
Do
c = (a + b) / 2
x = vbEval(sExpression, sArgument, c)
If x2 > x1 Then
If x > 0 Then
b = c
x2 = vbEval(sExpression, sArgument, b)
Else
a = c
x1 = vbEval(sExpression, sArgument, a)
End If
Else
If x > 0 Then
a = c
x1 = vbEval(sExpression, sArgument, a)
Else
b = c
x2 = vbEval(sExpression, sArgument, b)
End If
End If
If Abs(x) < epsilon Then
res = c
FindRoot = True
Exit Do
End If
i = i + 1
If i > iter Then
Exit Function
End If
Loop
End Function

Public Function FindVariable(ByVal sExpression As String) As String
Const sValid As String = "abcdefghijklmnopqrstuvwxyz"
Const sInvalid As String = "+-*/!^="
Dim sLetter As String, sVar As String
Dim bFound As Boolean
Dim i As Long
For i = 1 To Len(sExpression) - 1
sLetter = Mid(sExpression, i, 1)
If Not bFound Then bFound = InStr(1, sValid, LCase(sLetter))
If bFound Then
If InStr(1, sInvalid, LCase(sLetter)) Then Exit For
sVar = sVar & sLetter
End If
Next i
FindVariable = Trim(sVar)
End Function

'========Form code==============
'Add textbox and command button on form:

Private Sub Command1_Click()
Dim sVar As String, sMsg As String
Dim dblResult() As Double
sVar = FindVariable(Text1.Text)
Dim nRoots As Integer, i As Integer

nRoots = SolveEquation(Text1.Text, dblResult, 5, sVar)
sMsg = "Solving equation: " & Text1.Text & vbCrLf
If nRoots > 0 Then
sMsg = sMsg & "Found " & nRoots & " root(s):"
For i = 1 To nRoots
sMsg = sMsg & vbCrLf & sVar & i & " = " & dblResult(i)
Next i
Else
sMsg = sMsg & "No roots found!"
End If
MsgBox sMsg, vbInformation, "Result: "
End Sub

'  Text1.Text = "3*x + 15 = 11 - x"
Text1.Text = "x^2 - 15 = 11 - x"
Command1.Caption = "Solve me!"
End Sub
0

LVL 27

Accepted Solution

Ark earned 500 total points
ID: 10915128
Hi
More correct module and call (sometimes doubledivision doesn't find ALL roots, so another approach - decade approximation):

'==============bas module code===========
Dim oScript As Object

Public Function SolveEquation(ByVal sEquation As String, _
ByRef Result() As Double, _
Optional ByVal sVariable As String = "", _
Optional ByVal dblFrom As Double = -1000000, _
Optional ByVal dblTo As Double = 1000000, _
Optional ByVal dblPrecession As Double = 0.000001) As Long

Dim sNormal As String
Dim i As Long, iSuccess As Integer
Dim c As Double

If sVariable = "" Then sVariable = FindVariable(sEquation)
sNormal = NormalizeEquation(sEquation)
If sNormal = "" Then
MsgBox "Invalid equation!", vbCritical
Exit Function
End If
Set oScript = CreateObject("MSScriptControl.ScriptControl")
oScript.Language = "vbscript"
Call FindRoots(sNormal, sVariable, dblFrom, dblTo, dblPrecession, Result())
SolveEquation = UBound(Result)
Set oScript = Nothing
End Function

Private Function NormalizeEquation(ByVal sEquation As String) As String
Dim s() As String
s = Split(sEquation, "=")
If UBound(s) <> 1 Then Exit Function
NormalizeEquation = Trim(s(0)) & " - (" & Trim(s(1)) & ")"
End Function

Private Function vbEval(ByVal sExpression As String, ByVal sArgument As String, ByVal dblArgument As Double) As Double
Dim s As String
s = Replace(sExpression, sArgument, "(" & CStr(dblArgument) & ")")
vbEval = oScript.Eval(s)
End Function

Private Function FindRoots(ByVal sExpression As String, ByVal sArgument As String, _
ByVal a As Double, ByVal b As Double, _
ByVal epsilon As Double, ByRef res() As Double, _
Optional ByVal iStep As Double) As Boolean

Dim c As Double
Dim k As Integer, w As Integer
Dim x As Double, y As Double

If iStep = 0 Then iStep = Abs(a - b) / 1000
c = iStep
x = a
y = vbEval(sExpression, sArgument, a)
w = Sgn(y)

Do While x <= b
x = x + c
y = vbEval(sExpression, sArgument, x)
If y * w / c <= 0 Then
c = -c / 10
If Abs(c) <= Abs(epsilon / 10) Then
k = k + 1
ReDim Preserve res(k)
res(k) = x
c = iStep: w = -w
End If
End If
Loop
FindRoots = k
End Function

Public Function FindVariable(ByVal sExpression As String) As String
Const sValid As String = "abcdefghijklmnopqrstuvwxyz"
Const sInvalid As String = "+-*/!^="
Dim sLetter As String, sVar As String
Dim bFound As Boolean
Dim i As Long
For i = 1 To Len(sExpression) - 1
sLetter = Mid(sExpression, i, 1)
If Not bFound Then bFound = InStr(1, sValid, LCase(sLetter))
If bFound Then
If InStr(1, sInvalid, LCase(sLetter)) Then Exit For
sVar = sVar & sLetter
End If
Next i
FindVariable = Trim(sVar)
End Function

'===========form code==========
Private Sub Command1_Click()
Dim sVar As String, sMsg As String
Dim dblResult() As Double
'   sVar = FindVariable(Text1.Text)
sVar = "x"
Dim nRoots As Integer, i As Integer

nRoots = SolveEquation(Text1.Text, dblResult, sVar)
sMsg = "Solving equation: " & Text1.Text & vbCrLf
If nRoots > 0 Then
sMsg = sMsg & "Found " & nRoots & " root(s):"
For i = 1 To nRoots
sMsg = sMsg & vbCrLf & sVar & i & " = " & dblResult(i)
Next i
Else
sMsg = sMsg & "No roots found!"
End If
MsgBox sMsg, vbInformation, "Result: "
End Sub

Text1.Text = "x^4 - 15 = 11 - x"
'   Text1.Text = "sin(x)=0.5"
Command1.Caption = "Solve me!"
End Sub
0

LVL 19

Author Comment

ID: 10915300
Ark thats awesome man!

-Brian
0

LVL 27

Expert Comment

ID: 10915308
0

LVL 19

Author Comment

ID: 10915312
Ark, your code works ok, but try...

2x = 2

that fails?

-Biran
0

LVL 19

Author Comment

ID: 10915314
Your code assumes the CoEfficent of X is 1?

-Brian
0

LVL 27

Expert Comment

ID: 10915322
Hi
My code intended for correct (non-truncated) equations, so
2x=2 should be 2*x=2
0

LVL 19

Author Comment

ID: 10915325
it cant solve for other variables too..

4y = 2x
2y = x
y = x/2

it fails on that problem too.

-Brian
0

LVL 19

Author Comment

ID: 10915326
it cant solve for other variables too..

4y = 2x
2y = x
y = x/2

it fails on that problem too.

-Brian
0

LVL 19

Author Comment

ID: 10915331
ok, but can it solve for other variables...

4 * y = 2 * x?
0

LVL 19

Author Comment

ID: 10915337
So if I wanted to do....

2(x + 2) = 8

I would have to do...

2 * x + 2 * 2 = 8
0

LVL 27

Expert Comment

ID: 10915360
For last Q:
2*(x+2) is OK

for 2 variables: sorry I misunderstood original Q - I thought there is only one variable. Wait a moment, I prepare a code for 2 variables (though in this case it will be for linear equations - no roots/power/trigonometry, just +/-/*//)
0

LVL 27

Expert Comment

ID: 10915564
Hi
Here it is. I used double division method as it's faster then iterations, though can find only one root:

'==========another bas module code==========
Dim oScript As Object

Public Function SolveLinearEquation(ByVal sEquation As String, _
ByVal sFirstVariable As String, _
Optional sSecondVariable As String = "", _
Optional ByVal dblFrom As Double = -1000000, _
Optional ByVal dblTo As Double = 1000000, _
Optional ByVal dblPrecession As Double = 0.000001) As String

Dim sNormal As String
Dim nPos As Long
Dim bMultiple As Boolean
Dim s As String
Dim Result As Double
Dim sFormat As String

sFormat = "0." & String(Abs(Log10(dblPrecession)), "0")
nPos = 1
If sSecondVariable <> "" Then 'Replace second variable with 0/1 according to operation
On Error Resume Next
Do While nPos
nPos = InStr(nPos, sEquation, sSecondVariable)
If nPos Then
For i = -2 To 2
If i <> 0 Then
s = Mid(sEquation, nPos + i, 1)
If s = "*" Or s = "/" Then 'Replace with "1" if divide/mutiple, "0" otherwise
bMultiple = True
Exit For
Else
bMultiple = False
End If
End If
Next i
If bMultiple Then Mid(sEquation, nPos, 1) = "1" Else Mid(sEquation, nPos, 1) = "0"
End If
Loop
End If
sNormal = NormalizeLinearEquation(sEquation)

Set oScript = CreateObject("MSScriptControl.ScriptControl")
oScript.Language = "vbscript"

If FindRoot(sNormal, sFirstVariable, dblFrom, dblTo, dblPrecession, Result) Then
Result = CDbl(CDbl(Format(Result, sFormat)))

s = sFirstVariable & " = "
If sSecondVariable <> "" Then
If Result <> 1 Then
s = s & Result & " * "
End If
s = s & sSecondVariable
Else
s = s & Result
End If
Else
s = "No solution!"
End If
SolveLinearEquation = s
Set oScript = Nothing
End Function

Private Function NormalizeLinearEquation(ByVal sEquation As String) As String
Dim s() As String
s = Split(sEquation, "=")
If UBound(s) <> 1 Then Exit Function
NormalizeLinearEquation = Trim(s(0)) & " - (" & Trim(s(1)) & ")"
End Function

Private Function FindRoot(ByVal sExpression As String, ByVal sArgument As String, _
ByVal a As Double, ByVal b As Double, _
ByVal epsilon As Double, ByRef res As Double) As Boolean
Dim X As Double
Dim c As Double
Dim x1 As Double, x2 As Double
Dim iter As Long, i As Long
iter = 500 'max iterrations
x1 = vbEval(sExpression, sArgument, a)
x2 = vbEval(sExpression, sArgument, b)
Do
c = (a + b) / 2
X = vbEval(sExpression, sArgument, c)
If x2 > x1 Then
If X > 0 Then
b = c
x2 = vbEval(sExpression, sArgument, b)
Else
a = c
x1 = vbEval(sExpression, sArgument, a)
End If
Else
If X > 0 Then
a = c
x1 = vbEval(sExpression, sArgument, a)
Else
b = c
x2 = vbEval(sExpression, sArgument, b)
End If
End If
If Abs(X) < epsilon Then
res = c
FindRoot = True
Exit Do
End If
i = i + 1
If i > iter Then
Exit Function
End If
Loop
End Function

Private Function vbEval(ByVal sExpression As String, ByVal sArgument As String, ByVal dblArgument As Double) As Double
Dim s As String
s = Replace(sExpression, sArgument, "(" & CStr(dblArgument) & ")")
vbEval = oScript.Eval(s)
End Function

Private Function Log10(X)
Log10 = Log(X) / Log(10)
End Function

'Calling
Text1.Text = "x*2=2"
'   Text1.Text = "x*4=y*2"
Command2.Caption = "Solve me!"
End Sub

Private Sub Command2_Click()
Dim sResult As String
sResult = SolveLinearEquation(Text1.Text, "x")
'   sResult = SolveLinearEquation(Text1.Text, "x", "y")
MsgBox sResult
End Sub
0

LVL 19

Author Comment

ID: 10915634
Help me out with something, what exactly is being passed to the MS Scripting Control for Evaluation, exactly how much of the equation is being solved by MS Scripting Control.

-Brian
0

LVL 27

Expert Comment

ID: 10915672
MS script control solve expressions like:

x = oScript.Eval("2*2 + 3*3") 'Returns 13
0

LVL 19

Author Comment

ID: 10915812
but say I input 2 * x = 10

does the MS Script evaluate it just like that, that is what I am asking. I am asking, what exactly does your code do before it hands it to MS Script, so I can modify it and possibly port it to VB Script.

-Brian
0

LVL 19

Author Comment

ID: 10915816
I dont need MS Script control to process ("2 * 2 + 3*3"), Visual Basic handles it just fine.

-Brian
0

LVL 27

Expert Comment

ID: 10923184
Hi
VB can calculate 2*2+3*3 if you hardcoded this inside code, while Script control can eveluate this as a dynamic string. What my code does:

1. NormalizeEquation function - make equation normalized, ie place all values to the left:
2 * x = 10 => 2 * x - 10 (= 0) - I remove "= 0" part since I expect to pass expression to MS Script.
2. vbEval function - solves the equation. I pass formula, argument name and argument value to this function, like
"2 * x - 10", "x", 7
This function replace argument with its value:
"2 * 7 - 10"
and use MS Script to solve this string, then return value (4)
3. There are a lot of numeric methods to solve linear/non-linear equations (Newton's, modified Newton's, Rybakov's, dihotomy,power/decade approximation, khords, reverse approximation etc.).
All these methods applies to normalized equations like F(x) = 0, so I used my NormalizeEquation function.
Also, all these methods use re-calculation loop within predefined interval until result change less then predefined precession.
So, My FindRoot(s) function starts from leftmost argument (a) and using one of the above methods loop to rightmost(b) finding all roots. Actually, the simpliest solution can be like this:
For i = -1000000 To 1000000
result  = vbEval(MyFormula, "x", i)
' Save here all i when result change its sign (cross abcesse (x) line)
'Number of roots = number of times result crossed x line.
Next i

'For each root:
For i=RootMin To RootMax Step 0.01 'narrow area
result  = vbEval(MyFormula, "x", i)
' Recalculate RootMin and RootMax for narrowed area
Next i

For i=RootMin To RootMax Step 0.0001 'narrow area
result  = vbEval(MyFormula, "x", i)
' Recalculate RootMin and RootMax for narrowed area
Next i

etc. until you reach needed precession. But this method is tooooo slow, so I used much more faster above methods.
0

Featured Post

Suggested Solutions

VBA to format 3 80
Use closed file on desktop in vba 6 57
Use Multiple Forms 4 38
Saving history changes to sub form 4 24
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asseâ€¦
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we aâ€¦
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that aâ€¦
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This lâ€¦