Go Premium for a chance to win a PS4. Enter to Win

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 980
  • Last Modified:

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
0
BrianGEFF719
Asked:
BrianGEFF719
  • 15
  • 8
  • 4
  • +3
1 Solution
 
BrianGEFF719Author Commented:
This question is very difficult, so I will award extra points.
0
 
unknown_routineCommented:
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
 
p_sieCommented:
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
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
imarshadCommented:
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
 
SSSoftwareCommented:
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
 
BrianGEFF719Author 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
 
BrianGEFF719Author 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
 
unknown_routineCommented:
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
 
BrianGEFF719Author Commented:
then throw in another equation, I am just throwing out equations for examples man...
 
0
 
BrianGEFF719Author Commented:
5x + 2y + 4 = y + 4x + 14
2x = y


hows that, two variables, two equations...heh
0
 
unknown_routineCommented:
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
 
unknown_routineCommented:
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
 
ArkCommented:
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

Private Sub Form_Load()
'  Text1.Text = "3*x + 15 = 11 - x"
   Text1.Text = "x^2 - 15 = 11 - x"
   Command1.Caption = "Solve me!"
End Sub
0
 
ArkCommented:
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

Private Sub Form_Load()
   Text1.Text = "x^4 - 15 = 11 - x"
'   Text1.Text = "sin(x)=0.5"
   Command1.Caption = "Solve me!"
End Sub
0
 
BrianGEFF719Author Commented:
Ark thats awesome man!


-Brian
0
 
ArkCommented:
Thanks for points, glad I could help you.
0
 
BrianGEFF719Author Commented:
Ark, your code works ok, but try...

2x = 2


that fails?


-Biran
0
 
BrianGEFF719Author Commented:
Your code assumes the CoEfficent of X is 1?


-Brian
0
 
ArkCommented:
Hi
My code intended for correct (non-truncated) equations, so
2x=2 should be 2*x=2
0
 
BrianGEFF719Author Commented:
it cant solve for other variables too..


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



it fails on that problem too.

-Brian
0
 
BrianGEFF719Author Commented:
it cant solve for other variables too..


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



it fails on that problem too.

-Brian
0
 
BrianGEFF719Author Commented:
ok, but can it solve for other variables...


4 * y = 2 * x?
0
 
BrianGEFF719Author Commented:
So if I wanted to do....


2(x + 2) = 8

I would have to do...

2 * x + 2 * 2 = 8
0
 
ArkCommented:
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
 
ArkCommented:
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
Private Sub Form_Load()
   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
 
BrianGEFF719Author 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
 
ArkCommented:
MS script control solve expressions like:

x = oScript.Eval("2*2 + 3*3") 'Returns 13
0
 
BrianGEFF719Author 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
 
BrianGEFF719Author Commented:
I dont need MS Script control to process ("2 * 2 + 3*3"), Visual Basic handles it just fine.


-Brian
0
 
ArkCommented:
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

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 15
  • 8
  • 4
  • +3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now