by RedSting71 (9 Submissions)
Category: Math/Dates
Compatability: VB 6.0
Difficulty: Unknown Difficulty
Originally Published: Sat 20th July 2002
Date Added: Mon 8th February 2021
Rating: 
(1 Votes)
Solves any polynomial equation
API Declarations
'Example: Math_Solve("x^2-2","x",1) - solves the equation x^2 - 2 = 0
'The polynomial is automatically set equal to 0, the variable is the variable in the polynomial you're solving for, and the number after that is an initial guess -- doesnt have to be close; as a rule of thumb, just use 1
VBcoders
Dim X As String
Dim der As String
Dim der2 As String
Dim Equation As String
Dim equation2 As String
Dim bottom As String
Dim top As String
i = 0
X = guess
Equation = polynomial
der = Math_GetDerivative(polynomial, variable)
Do: DoEvents
equation2 = Math_ReplaceExpressionVariable(Equation, variable, X)
top = Math_EvaluateExpression(equation2)
der2 = Math_ReplaceExpressionVariable(der, variable, X)
bottom = Math_EvaluateExpression(der2)
X = X - top / bottom
i = i + 1
Loop Until i = 20
Math_Solve = X
End Function
Function Math_ReplaceExpressionVariable(szExpression As String, szVar As String, szVarVal As String) As String
Dim szTemp As String
Dim szExpressionParts() As String
Dim loop1 As Long
If Val(szVarVal) < 0 Then
szVarVal = "(" & szVarVal & ")"
End If
szTemp = Replace(szExpression, " ", "")
szExpressionParts = Split(szTemp, szVar)
For loop1 = LBound(szExpressionParts, 1) To UBound(szExpressionParts, 1) - 1
If Len(szExpressionParts(loop1)) > 0 Then
If Not (IsNumeric(Right(szExpressionParts(loop1), 1))) Then
szExpressionParts(loop1) = szExpressionParts(loop1) & "1"
End If
Else
szExpressionParts(loop1) = 1
End If
Next loop1
szTemp = Join(szExpressionParts, "*" & szVarVal)
szTemp = Replace(szTemp, "+", " + ")
szTemp = Replace(szTemp, "-", " - ")
szTemp = Replace(szTemp, "*", " * ")
szTemp = Replace(szTemp, "/", " / ")
szTemp = Replace(szTemp, "^", " ^ ")
Math_ReplaceExpressionVariable = szTemp
End Function
Function Math_GetSimpleDerivative(strExpression As String, strVariable As String) As String
Dim strParts() As String
Dim strCoEfficient As String
Dim strExponent As String
'if the variable is in the expression
If InStr(1, strExpression, strVariable) > 0 Then
'split the expression by the variable
strParts = Split(Trim(strExpression), strVariable)
'get the coefficient
strCoEfficient = Trim(strParts(0))
'if there is not co-effiocient, assume it is 1
If strCoEfficient = "" Then strCoEfficient = "1"
'make -x = -1x
If strCoEfficient = "-" Then strCoEfficient = "-1"
'strim leading and trainling spaces
strExponent = Trim(strParts(1))
'if the exponent part contains an ^
If InStr(1, strExponent, "^") > 0 Then
'split it out to find the exponent number
strExponent = Trim(Split(strExponent, "^")(1))
If strExponent <> "1" Then
'calculate the new coefficient, append the variable
Math_GetSimpleDerivative = CStr(Val(strCoEfficient) * Val(strExponent)) & strVariable
'decriment the exponent
strExponent = Val(strExponent - 1)
' if the new exponent is not 1, append it
If strExponent <> "1" Then
Math_GetSimpleDerivative = Math_GetSimpleDerivative & "^" & strExponent
End If
Else 'otherwise (exponent is 1)
'return just the coefficient
Math_GetSimpleDerivative = strCoEfficient
End If
Else 'otherwise (no exponent)
'return just the coefficient
Math_GetSimpleDerivative = strCoEfficient
End If
Else 'othewise (no variable, just a constant)
'return 0
Math_GetSimpleDerivative = "0"
End If
End Function
Function Math_GetDerivative(strExpression As String, strVariable As String) As String
Dim strSimpleExpressions() As String
Dim strTemp As String
Dim loop1 As Long
'remove spaces
strTemp = Replace(strExpression, " ", "")
'temporarily replace negavtive exponents
strTemp = Replace(strTemp, "^-", "#negex#")
'convert subtracted simple expressions to add negative
strTemp = Replace(strTemp, "-", "+-")
'restore negavtive exponents
strTemp = Replace(strTemp, "#negex#", "^-")
'split the expression into an array of simple expressions
strSimpleExpressions = Split(strTemp, "+")
'loop through the array, replacing each element(simple expression) with its derivative
For loop1 = 0 To UBound(strSimpleExpressions)
strSimpleExpressions(loop1) = Math_GetSimpleDerivative(strSimpleExpressions(loop1), strVariable)
Next
'rebuild the string
strTemp = Join(strSimpleExpressions, "+")
'temporarily replace negavtive exponents
strTemp = Replace(strTemp, "^-", "#negex#")
'convert add negative to subtracted simple expressions
strTemp = Replace(strTemp, "+-", "-")
'insert spaces around subtraction
strTemp = Replace(strTemp, "-", " - ")
'restore negavtive exponents
strTemp = Replace(strTemp, "#negex#", "^-")
'insert spaces around addition
strTemp = Replace(strTemp, "+", " + ")
'return derivative expression
Math_GetDerivative = strTemp
End Function
Function Math_EvaluateExpression(szExpression As String) As String
Dim iLeftParenLoc As Integer
Dim iRightParenLoc As Integer
Dim iLeftParenCount As Integer
Dim iRightParenCount As Integer
Dim szTempExpression As String
Dim szNewExpression As String
Dim szParenExpression As String
Dim iExpressionLen As Integer
Dim szChar As String
Dim iOpperatorLoc As Integer
Dim iOpperatorLoc2 As Integer
Dim szLeftExpression As String
Dim szRightExpression As String
Dim iLeftBound As Integer
Dim iRightBound As Integer
Dim szOpperator As String
Dim loop1 As Integer
Dim loop2 As Integer
szTempExpression = Trim(szExpression)
iLeftParenLoc = InStr(szTempExpression, "(")
iExpressionLen = Len(szTempExpression)
Do While iLeftParenLoc > 0
For loop1 = iLeftParenLoc To iExpressionLen
szChar = Mid(szTempExpression, loop1, 1)
If szChar = "(" Then
iLeftParenCount = iLeftParenCount + 1
ElseIf szChar = ")" Then
iRightParenCount = iRightParenCount + 1
Else
szParenExpression = szParenExpression & szChar
End If
If iLeftParenCount = iRightParenCount Then
iRightParenLoc = loop1
Exit For
End If
Next
szParenExpression = Mid(szTempExpression, iLeftParenLoc + 1, iRightParenLoc - iLeftParenLoc - 1)
szTempExpression = left(szTempExpression, iLeftParenLoc - 1) & CStr(Math_EvaluateExpression(szParenExpression)) & Right(szTempExpression, iExpressionLen - iRightParenLoc)
iLeftParenCount = 0
iRightParenCount = 0
iExpressionLen = Len(szTempExpression)
iLeftParenLoc = InStr(szTempExpression, "(")
Loop
For loop1 = 0 To 2
If loop1 = 0 Then
szOpperator = "^"
iOpperatorLoc = InStr(szTempExpression, " ^ ")
ElseIf loop1 = 1 Then
szOpperator = "*"
iOpperatorLoc = InStr(szTempExpression, " * ")
iOpperatorLoc2 = InStr(szTempExpression, " / ")
If (iOpperatorLoc2 < iOpperatorLoc And iOpperatorLoc2 <> 0) Or (iOpperatorLoc = 0 And iOpperatorLoc2 <> 0) Then
iOpperatorLoc = iOpperatorLoc2
szOpperator = "/"
End If
ElseIf loop1 = 2 Then
szOpperator = "+"
iOpperatorLoc = CInt(InStr(szTempExpression, " + "))
iOpperatorLoc2 = CInt(InStr(szTempExpression, " - "))
If (iOpperatorLoc2 < iOpperatorLoc And iOpperatorLoc2 <> 0) Or (iOpperatorLoc = 0 And iOpperatorLoc2 <> 0) Then
iOpperatorLoc = iOpperatorLoc2
szOpperator = "-"
End If
End If
Do While iOpperatorLoc > 0
iOpperatorLoc = iOpperatorLoc
For loop2 = iOpperatorLoc - 1 To 1 Step -1
szChar = Mid(szTempExpression, loop2, 1)
If szChar = " " Then
Exit For
End If
Next
iLeftBound = loop2
For loop2 = iOpperatorLoc + 3 To iExpressionLen
szChar = Mid(szTempExpression, loop2, 1)
If szChar = " " Then
Exit For
End If
Next
iRightBound = loop2
szLeftExpression = Trim(Mid(szTempExpression, iLeftBound + 1, iOpperatorLoc - (iLeftBound + 1)))
szRightExpression = Trim(Mid(szTempExpression, iOpperatorLoc + 3, iRightBound - (iOpperatorLoc + 3)))
Select Case szOpperator
Case "^"
szNewExpression = CStr(Val(szLeftExpression) ^ Val(szRightExpression))
Case "*"
szNewExpression = CStr(Val(szLeftExpression) * Val(szRightExpression))
Case "/"
szNewExpression = CStr(Val(szLeftExpression) / Val(szRightExpression))
Case "+"
szNewExpression = CStr(Val(szLeftExpression) + Val(szRightExpression))
Case "-"
szNewExpression = CStr(Val(szLeftExpression) - Val(szRightExpression))
End Select
szTempExpression = left(szTempExpression, iLeftBound) & szNewExpression & Right(szTempExpression, iExpressionLen - iRightBound + 1)
iExpressionLen = Len(szTempExpression)
'iOpperatorLoc = InStr(szTempExpression, szOpperators(loop1))
If loop1 = 0 Then
szOpperator = "^"
iOpperatorLoc = InStr(szTempExpression, " ^ ")
ElseIf loop1 = 1 Then
szOpperator = "*"
iOpperatorLoc = InStr(szTempExpression, " * ")
iOpperatorLoc2 = InStr(szTempExpression, " / ")
If (iOpperatorLoc2 < iOpperatorLoc And iOpperatorLoc2 <> 0) Or (iOpperatorLoc = 0 And iOpperatorLoc2 <> 0) Then
iOpperatorLoc = iOpperatorLoc2
szOpperator = "/"
End If
ElseIf loop1 = 2 Then
szOpperator = "+"
iOpperatorLoc = InStr(szTempExpression, " + ")
iOpperatorLoc2 = InStr(szTempExpression, " - ")
If (iOpperatorLoc2 < iOpperatorLoc And iOpperatorLoc2 <> 0) Or (iOpperatorLoc = 0 And iOpperatorLoc2 <> 0) Then
iOpperatorLoc = iOpperatorLoc2
szOpperator = "-"
End If
End If
Loop
Next
Math_EvaluateExpression = Val(szTempExpression)
End Function
