• Home
 · 
• Math/Dates
 · 
• Solves any polynomial equation

Solves any polynomial equation

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



Rate Solves any polynomial equation

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

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