Processing Alegebra Problems.

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
LVL 19
Who is Participating?

x

Commented:
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

Author Commented:
This question is very difficult, so I will award extra points.
0

Commented:
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

Commented:
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

Commented:
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

Commented:
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

Author Commented:
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

Author Commented:
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

Commented:
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

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

0

Author Commented:
5x + 2y + 4 = y + 4x + 14
2x = y

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

Commented:
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

Commented:
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

Commented:
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

Author Commented:
Ark thats awesome man!

-Brian
0

Commented:
0

Author Commented:
Ark, your code works ok, but try...

2x = 2

that fails?

-Biran
0

Author Commented:
Your code assumes the CoEfficent of X is 1?

-Brian
0

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

Author Commented:
it cant solve for other variables too..

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

it fails on that problem too.

-Brian
0

Author Commented:
it cant solve for other variables too..

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

it fails on that problem too.

-Brian
0

Author Commented:
ok, but can it solve for other variables...

4 * y = 2 * x?
0

Author Commented:
So if I wanted to do....

2(x + 2) = 8

I would have to do...

2 * x + 2 * 2 = 8
0

Commented:
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

Commented:
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

Author Commented:
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

Commented:
MS script control solve expressions like:

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

Author Commented:
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

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

-Brian
0

Commented:
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
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.