Polynommial calculator

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • MOORPHEEUUS
    New Member
    • Dec 2013
    • 1

    #1

    Polynommial calculator

    Can someone please tell me IF IT´S POSSIBLE, to have a vba code for calculating real-valued root of the polynomial of n power in excel 2007, by using Newton method?
    i tried to solve a simple P(x) such as X^10 + X^9+X^8+X^7+X^6 +X^5+X^4+X^3+X^ 2+X-200 = 0 , by using solver from excel 2007, but it didn't work out.
    Al old friend of mine, NEO, send me the following code:

    Code:
    Sub polySolver(coeffs As Range, powers As Range) As Double 
        Dim rowCount As Integer 
        Dim i 
        Dim iii 
        Dim xn As Double 
        Dim xnm1 As Double 
        Dim fx As Double 
        fx = 0 
        Dim fxprime As Double 
        fxprime = 0 
        xnm1 = 0.1 
        Do 
            For Each i In coeffs 
                For Each iii In powers 
                    fx = (fx + i) * xnm1 ^ iii 
                    fxprime = fxprime + (iii * i) * xnm1 ^ (iii - 1) 
                     
                    xn = xnm1 - fx / fxprime 
                    xnm1 = xn 
                     
                Next i 
            Next iii 
        Loop Until (Abs(fx) < 0.00001) 
         
        polySolver = xn 
    End Function
    but i haven't any sucess with it in trying to find root (s)of P(x) above ..
    Can someone help fix it up??
    I'm looking forward to receiving good news.
    many thks
    Last edited by Rabbit; Dec 18 '13, 09:24 PM. Reason: Please use [CODE] and [/CODE] tags when posting code or formatted data.
  • Honduras2811
    New Member
    • Apr 2014
    • 21

    #2
    This looks interesting. I'll see what I can do with it.

    After a very quick look there are some serious problems with your code. Did it run at all? If so, I'm surprised.

    1. PolySolver should be declared as a Function, not a Subroutine. Returning a value makes it a function.

    2. Haphazard use of parentheses. Parentheses determine the order of execution of mathematical functions. Never be afraid to use too many parentheses, both to make life easier for the computer and for you. I've never seen the actual algorithm but it would be a miracle if the mathematical expressions return anything meaningful the way they are.

    For instance in this line:

    fxprime = fxprime + (iii * i) * xnm1 ^ (iii - 1)

    Due to the precedence of mathematical operators the computer will do this, I think:

    1. Raise xnm1 to the (iii - 1) power
    2. multiply (iii * i)
    3. multiply the result of 2. by the new value of xnml
    4. Add the result to fxprime
    5. Assign the result to fxprime.

    Is that what you want it to do?
    Last edited by Honduras2811; Apr 7 '14, 04:00 PM. Reason: Saving space

    Comment

    • Honduras2811
      New Member
      • Apr 2014
      • 21

      #3
      OK. I got it to compile with no errors. It produces 0s, but it does it very quickly.[

      I converted it to VB 6 because I haven't used VBA for a decade. If you have any questions about the changes I made, just ask.

      Here's the modified code.

      Code:
      Option Explicit
      
      '---------------------------------------------------------
      ' Procedure : cmdRun_Click
      ' Author    : Rory Starkweather
      ' Date      : 04/07/2014
      ' Purpose   : Fill two arrays that replace the Range type
      '               variables that Excel VBA uses. intCoeffs is
      '               filled with 10 1s. intPowers is filled donward
      '               from 10 to 1. This matches up with the example
      '               in the OP.
      '---------------------------------------------------------
      Private Sub cmdRun_Click()
      
          Dim intCoeffs(1 To 10) As Integer
          Dim intPowers(1 To 10) As Integer
          Dim intIndex As Integer
          Dim dblResult As Double
          
          On Error GoTo cmdRun_Click_Error
            Dim errstrErrorMessage As String
            Dim errlngRetVal As Long
      
          For intIndex = 10 To 1 Step -1
              intCoeffs(intIndex) = 1
              intPowers(intIndex) = intIndex
          Next ' intIndex
          
          dblResult = rsPolySolver(intCoeffs(), intPowers())
          frmMain.lblRoot.Caption = CStr(dblResult)
      
          '*** On Error GoTo 0
          Exit Sub
      
      cmdRun_Click_Error:
      
          errstrErrorMessage = "Error " & Err.Number & _
                               " (" & Err.Description & _
                               ") in procedure cmdRun_Click" & _
                               " of Form frmMain"
          errlngRetVal = MsgBox(errstrErrorMessage, _    vbExclamation + vbOKOnly)
          
      End Sub
      Code:
      Option Explicit
      
      '///Public Function PolySolver(coeffs As Range, powers As Range) As Double
      '---------------------------------------------------------------------------------------
      ' Procedure : rsPolySolver
      ' Author    : Rory Starkweather
      ' Date      : 04/07/2014
      ' Purpose   : The good stuff. Almost. Only the looping code was changed. The
      '              math is exactly like the original.
      '---------------------------------------------------------------------------------------
      Public Function rsPolySolver(ByRef intCoeffs() As Integer, _
                                  ByRef intPowers() As Integer) As Double
      
          'Dim rowCount As Integer    *Not used
          Dim i As Integer
          Dim iii As Integer
          Dim xn As Double
          Dim xnm1 As Double
          Dim fx As Double
          Dim fxprime As Double
          
          Dim intInnerIndex As Integer
          Dim intOuterIndex As Integer
          
          On Error GoTo PolySolver_Error
            Dim errstrErrorMessage As String
            Dim errlngRetVal As Long
      
          fx = 0
          fxprime = 0
          xnm1 = 0.1
          
          
          Do
              '///For Each i In coeffs
              For intOuterIndex = 1 To 10
                  i = intCoeffs(intOuterIndex)
                  '///For Each iii In powers
                  For intInnerIndex = 1 To 10
                      iii = intPowers(intInnerIndex)
                      fx = (fx + i) * xnm1 ^ iii
                      fxprime = fxprime + (iii * i) * xnm1 ^ (iii - 1)
       
                      xn = xnm1 - fx / fxprime
                      xnm1 = xn
       
                  '///Next i
                  Next ' intInnerIndex
              '///Next iii
              Next ' intOuterIndex
              
          Loop Until (Abs(fx) < 0.00001)
       
          rsPolySolver = xn
      
          '*** On Error GoTo 0
          Exit Function
      
      PolySolver_Error:
      
          errstrErrorMessage = "Error " & Err.Number & _
                               " (" & Err.Description & _
                               ") in procedure PolySolver" & _
                               " of Module mdlProcs"
          errlngRetVal = MsgBox(errstrErrorMessage, vbExclamation + vbOKOnly)
      
          
      End Function
      It exits the Loop the first time Abs(fx)is tested because fx is always 0.

      Comment

      Working...