• Home
 · 
• Math/Dates
 · 
• Finds the solution to any polynomial equation using Newton's Method... very effective and easy

Finds the solution to any polynomial equation using Newton's Method... very effective and easy

Finds the solution to any polynomial equation using Newton's Method... very effective and easy

API Declarations


'The function to call is Solve(), will return answer
'The polynomial is an equation set equal to 0
'Guess is an initial guess, doesn't have to be close to the actual answer, but should be decent; as a rule of thumb, just go with "1"
'Solve("x^2-2", "x", "1") - will solve the equation x^2 - 2 = 0 for x, using 1 as the value of x(1)
'If you're not familiar with Newton's Method, buy a book on numerical analysis



Rate Finds the solution to any polynomial equation using Newton's Method... very effective and easy

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

'Define variables
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

'Get the equation
Equation = polynomial

'Get the derivative
der = GetDerivative(polynomial, variable)

'Begin iteration process
Do: DoEvents

'Get equation, substitute X, solve
equation2 = ReplaceExpressionVariable(equation, variable, X)
top = EvaluateExpression(equation2)

'Substitute X in derivative and solve
der2 = ReplaceExpressionVariable(der, variable, X)
bottom = EvaluateExpression(der2)

'Get new approximation of X
X = X - top / bottom

'Add one to iteration count
i = i + 1

'You can change this value, but 10 iterations is sufficient most of the time
Loop Until i = 10

Solve = X
End Function

Function ReplaceExpressionVariable(szExpression As String, szVar As String, szVarVal As String) As String
Dim szTemp As String
Dim szExpressionParts() As String
Dim loop1 As Long

'put parens arounf negative var vals
If Val(szVarVal) < 0 Then
    szVarVal = "(" & szVarVal & ")"
End If

'strip the spaces
szTemp = Replace(szExpression, " ", "")

'split the expression
szExpressionParts = Split(szTemp, szVar)

'loop throught the expression parts to find variable without co-efficients
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

'put the parts back together in a string
szTemp = Join(szExpressionParts, "*" & szVarVal)

'put spaces between the opperators
szTemp = Replace(szTemp, "+", " + ")
szTemp = Replace(szTemp, "-", " - ")
szTemp = Replace(szTemp, "*", " * ")
szTemp = Replace(szTemp, "/", " / ")
szTemp = Replace(szTemp, "^", " ^ ")

'return the value
ReplaceExpressionVariable = szTemp
End Function

Function 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(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
EvaluateExpression = Val(szTempExpression)
End Function

Function 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) = 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
GetDerivative = strTemp

End Function

Function 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
            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
                GetSimpleDerivative = GetSimpleDerivative & "^" & strExponent
            End If
        Else 'otherwise (exponent is 1)
             
            'return just the coefficient
            GetSimpleDerivative = strCoEfficient
        End If
         
    Else 'otherwise (no exponent)

        'return just the coefficient
        GetSimpleDerivative = strCoEfficient
    End If
Else 'othewise (no variable, just a constant)

    'return 0
    GetSimpleDerivative = "0"
End If

End Function