Trucos Resolución de ecuaciones lineales

Lo que nos dice el autor sobre esta rutina:

Solución de Ecuaciones Lineales
======================
La solución de un sistema de 'n' ecuaciones lineales con 'n' incógnitas es un interesante reto a los programadores.
El siguiente código lo escribí inicialmente en Fortran, aquí te presento la versión Visual Basic.
He utilizado esta función en programación de Simuladores de Flujo y Solución del Método de los Mínimos Cuadrados.
En general, la función tiene múltiples usos en procedimientos matemáticos.

Es un código bastante complicado de seguir, pero si necesitas una guía, es el método de Eliminación de Gauss.



'Esto acelerará los cálculos

DefInt A-Z

Private Sub EjemploSencillo()
   'Se tiene el siguiente sistema de ecuaciones lineales que debe ser resuelto:
   '|1 1 1 6|
   '|1 0 1 4|
   '|1 1 0 3|

    Dim Sistema(1 To 3, 1 To 4) As Double 'Almacenará el sistema de ecuaciones
    Dim Solución(1 To 3) As Double 'Almacenará la solución del sistema

    Sistema(1, 1) = 1: Sistema(1, 2) = 1: Sistema(1, 3) = 1: Sistema(1, 4) = 6
    Sistema(2, 1) = 1: Sistema(2, 2) = 0: Sistema(2, 3) = 1: Sistema(2, 4) = 4
    Sistema(3, 1) = 1: Sistema(3, 2) = 1: Sistema(3, 3) = 0: Sistema(3, 4) = 3

    If Gauss(Sistema(), Solución()) Then
       Debug.Print "Solución:"
       Debug.Print "C1 = "; Solución(1)
       Debug.Print "C2 = "; Solución(2)
       Debug.Print "C3 = "; Solución(3)
       Stop
    Else
       MsgBox "El sistema de ecuaciones no tiene solución..."
    End If
End Sub

'-------------------------------------------------------------------------
'Matrix Solution. Return True if then function was successful
'-------------------------------------------------------------------------
Static Function Gauss(ByRef A() As Double, ByRef C() As Double) As Boolean
    Dim Tem As Double, Sum As Double, i, l, j, k, n, m

    On Error GoTo Gauss_Err

    n = UBound(C)
    m = n + 1
    For l = 1 To n - 1
        j = l
        For k = l + 1 To n
            If (Abs(A(j, l)) < Abs(A(k, l))) Then j = k
        Next
        If Not (j = l) Then
           For i = 1 To m
               Tem = A(l, i)
               A(l, i) = A(j, i)
               A(j, i) = Tem
           Next
        End If
        For j = l + 1 To n
            Tem = A(j, l) / A(l, l)
            For i = 1 To m
                A(j, i) = A(j, i) - Tem * A(l, i)
            Next
        Next
    Next
    C(n) = A(n, m) / A(n, n)
    For i = 1 To n - 1
        j = n - i
        Sum = 0
        For l = 1 To i
            k = j + l
            Sum = Sum + A(j, k) * C(k)
        Next
        C(j) = (A(j, m) - Sum) / A(j, j)
    Next
    Gauss = True

   'Programmed by Harvey Triana ©

    Exit Function

Gauss_Err: Gauss = False
End Function



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com