lunes, 12 de diciembre de 2011

Ecuaciones diferenciales ordinarias


'edo a resolver
Public Function g(t, y) As Double

    g = (t - y) / 2

End Function


'runge kutta 44
Public Function rk_44(t0, y0, h) As Double

    k1 = g(t0, y0)
    k2 = g(t0 + h / 2, y0 + h * k1 / 2)
    k3 = g(t0 + h / 2, y0 + h * k2 / 2)
    k4 = g(t0 + h, y0 + h * k3)
    
    rk_44 = y0 + (h / 6) * (k1 + 2 * k2 + 2 * k3 + k4)

End Function

'heun
Public Function e_heun(t0, y0, h) As Double

    yp = y0 + h * g(t0, y0)
    e_heun = y0 + 0.5 * h * (g(t0, y0) + g(t0 + h, yp))

End Function

'poligono mejorado
Public Function poli_m(t0, y0, h) As Double

    ym = y0 + 0.5 * h * g(t0, y0)
    poli_m = y0 + h * g(t0 + h / 2, ym)

End Function

'ralston
Public Function ralston_(t0, y0, h) As Double

    k1 = g(t0, y0)
    k2 = g(t0 + 0.75 * h, y0 + 0.75 * h * k1)
    ralston_ = y0 + (h / 3) * (k1 + 2 * k2)
    
End Function

'euler explicito
Public Function eu_ex(t0, y0, h)

    eu_ex = y0 + h * g(t0, y0)

End Function

Invertir Matrices a través de VBA

Podemos calcular una matriz de 2x2 y de 3x3 en VBA con una subrutina a partir de la regla

$$A^{-1}=\dfrac {1} {det\left( A\right) }adj\left( A\right)$$

a continuación se muestran los códigos, para que esta subrutina corra de forma correcta la matriz a invertir debe encontrarse emplazada en el rango de celdas "B3:D5" y los resultados serán desplegados en el rango de celdas "F3:H5" como se muestra en la figura



Private Sub inv3x3()

'invertir una matriz A = [a b;c d]
'recordando que la la inversa de esta matriz es:
'1/det(A).*[d -b;-c a]

Dim A(1 To 2, 1 To 2) As Double

    For i = 1 To 2
    For j = 1 To 2
    
        A(i, j) = Cells(2 + i, 1 + j)
    
    Next j
    Next i

'determinante de la matriz
det = A(1, 1) * A(2, 2) - A(1, 2) * A(2, 1)

'si el determinate de la matriz es 0 => inversa de la matriz no existe
    If det = 0 Then
        MsgBox ("La matriz no es invertible")
        Exit Sub
    End If

'reordenando los terminos y multiplicando por el reciproco del determinate
    Cells(3, 5) = det ^ -1 * A(2, 2)
    Cells(3, 6) = det ^ -1 * -A(1, 2)
    Cells(4, 5) = det ^ -1 * -A(2, 1)
    Cells(4, 6) = det ^ -1 * A(1, 1)

End Sub


para invertir una matriz de 2x2 se ocupa el siguiente código, para que esta subrutina se ejecute de forma optima la matriz a invertir debe ubicarse en el rango "B3:C4" y los resultados serán arrojados en rango de celdas "E3:F4" como se muestra en la siguiente imagen





Private Sub inv2x2()

'invertir una matriz A = [a b;c d]
'recordando que la la inversa de esta matriz es:
'1/det(A).*[d -b;-c a]

Dim A(1 To 2, 1 To 2) As Double

    For i = 1 To 2
    For j = 1 To 2
    
        A(i, j) = Cells(2 + i, 1 + j)
    
    Next j
    Next i

'determinante de la matriz
det = A(1, 1) * A(2, 2) - A(1, 2) * A(2, 1)

'si el determinate de la matriz es 0 => inversa de la matriz no existe
    If det = 0 Then
        MsgBox ("La matriz no es invertible")
        Exit Sub
    End If

'reordenando los terminos y multiplicando por el reciproco del determinate
    Cells(3, 5) = det ^ -1 * A(2, 2)
    Cells(3, 6) = det ^ -1 * -A(1, 2)
    Cells(4, 5) = det ^ -1 * -A(2, 1)
    Cells(4, 6) = det ^ -1 * A(1, 1)

End Sub

domingo, 11 de diciembre de 2011

Ecuaciones no lineales

Funciones programadas en VBA para resolver ecuaciones no lineales



'función a resolver
Public Function g(x) As Double
    g = Exp(-x) - x
End Function

'derivada de g(x)
Public Function dg(x) As Double
    h = 0.000001
    dg = (g(x + h) - g(x)) / h
End Function

'bisección

Public Function biseccion(a, b, n)

If g(a) * g(b) > 0 Then
    MsgBox ("la función tiene el mismo signo en ambos extremos")
End If

If g(a) * g(b) = 0 Then

    If g(a) = 0 Then
        s = a
    Else
        s = b
    End If

Else

    For i = 1 To n
        
        s = (a + b) / 2
        
        If g(a) * g(s) < 0 Then
            b = s
        Else
            a = s
        End If
    
    Next i

End If


biseccion = s

End Function


'newton raphson
Public Function newtonraphson(x0, n) As Double

xi=x0

For i = 1 To n

    xi_1 = xi - g(xi) / dg(xi)
    xi = xi_1
    
Next i

newtonraphson = xi_1

End Function

'punto fijo
Public Function ptofijo(x0, n)

xi=x0

For i = 1 To n
    
    x_i = g(xi) + xi
    xi = xi_1

Next i

ptofijo = x_i

End Function