Visual Basic para Aplicaciones - Método de iteración

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 1
Ha aumentado su posición en 51 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Método de iteración

Publicado por Hygge (1 intervención) el 24/04/2018 07:33:14
Hola.

Estoy intentando resolver en VBA o en R (preferentemente en R) un método de bisección que me permita, realizando 10 iteraciones, obtener una raíz real a la función f(x): x^3 + 4x^2 - 10 = 0. La raíz que estoy buscando es 1.365230013.
Necesitaría hacerlo con la función f(x) creada aparte (en otro procedimiento) y que de ahí sea llamada al algoritmo de resolución

Tendría que poner los extremos (en este caso pondría 0 y 2, la tolerancia que sería <0.0001 y el número máximo de iteraciones N0 = 10

Si alguno me puede ayudar, lo agradeceria
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Método de iteración

Publicado por JuanC (565 intervenciones) el 29/04/2018 15:55:27
encontré algo en la web y lo modifiqué un poco... adaptalo a tu gusto y necesidad...
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
Option Explicit
 
Sub test()
Dim raiz#
If Biseccion("fx", 0, 2, raiz) Then
   MsgBox raiz
End If
End Sub
 
Function fx(ByVal x As Double) As Double
fx = x ^ 3 + 4 * x ^ 2 - 10
End Function
 
Function Biseccion(ByVal funcion As String, ByVal Xa As Double, ByVal Xb As Double, ByRef res As Double, Optional ByVal tol As Double = 0.0001, Optional ByVal ite As Integer = 10) As Boolean
Dim a#, b#, c#, Xc#, err#, it%
Biseccion = False
a = Excel.Run(funcion, Xa)
b = Excel.Run(funcion, Xb)
If ((a * b) < 0) Then
   err = VBA.Abs(Xa - Xb)
   Do While tol <= err
            Xc = (Xa + Xb) / 2
            c = Excel.Run(funcion, Xc)
            err = VBA.Abs(Xa - Xb)
            it = it + 1
            If it > ite Then Exit Do
            If ((c * a) < 0) Then
                Xb = Xc
            ElseIf ((c * b) < 0) Then
                   Xa = Xc
            End If
   Loop
   res = Xc
   Biseccion = True
End If
End Function
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar