Código de la técnica Eliminación de Gauss-Jordan en VB6 para resolver sistemas de ecuaciones lineales de reales Por Harvey Triana Revisión 22 de Noviembre de 2006 La solución de un sistema de n ecuaciones lineales simultáneas con 'n' incógnitas es un interesante reto a los programadores. El siguiente código lo escribí inicialmente en FORTRAN en 1992, aquí presento la versión Visual Basic 6, escrita en 1992, y con una revisión en Noviembre de 2006. En general, la función encuentra aplicación en Ingeniería y matemática superior.
Eliminación de Gauss-Jordan para números reales en VB6 '-------------------------------------------------------' Solución de Ecuaciones Lineales ' Por: Harvey Triana ' Argumentos: ' a(): Arreglo bidimensional que contiene la matriz ' r(): Arreglo unidimensional que entregará la r. '-------------------------------------------------------Option Explicit
Static Sub Main() Call Sample1 Call Sample2 End Sub Public Function GaussianElimination( GaussianElimination( _ ByRef a() As Double Double, , _ ByRef r() As Double Double) ) As Boolean Dim Dim Dim Dim Dim Dim Dim Dim
t s i l j k n m
As As As As As As As As
Double Double Long Long Long Long Long Long
On Error GoTo ErrHandler n = UBound(r) UBound(r) m = n + 1 For l = 1 To n - 1 j = l For k = l + 1 To n If (Abs Abs(a(j, (a(j, l)) >= Abs Abs(a(k, (a(k, l))) Then Else j = k Next If Not (j = l) Then For i = 1 To m t = a(l, i) a(l, i) = a(j, i) a(j, i) = t Next End If For j = l + 1 To n t = a(j, l) / a(l, l) For i = 1 To m a(j, i) = a(j, i) - t * a(l, i)
Next Next Next r(n) = a(n, m) / a(n, n) For i = 1 To n - 1 j = n - i s = 0 For l = 1 To i k = j + l s = s + a(j, k) * r(k) Next r(j) = (a(j, m) - s) / a(j, j) Next GaussianElimination = True Exit Function ErrHandler: GaussianElimination = False End Function Private Sub Sample1() ' Solucionar el siguiente sistema de ecuaciones lineales ' |1 1 1 6| ' |1 0 1 4| ' |1 1 0 3| Dim a(1 To 3, 1 To 4) As Double, r(1 To 3) As Double a(1, 1) = 1: a(1, 2) = 1: a(1, 3) = 1: a(1, 4) = 6 a(2, 1) = 1: a(2, 2) = 0: a(2, 3) = 1: a(2, 4) = 4 a(3, 1) = 1: a(3, 2) = 1: a(3, 3) = 0: a(3, 4) = 3 Call ShowMatrix(a(), "Ejemplo 1") If GaussianElimination(a(), r()) Then Call ShowSolution(r()) Else Debug.Print "No es un sistema de ecuaciones lineales" End If End Sub Private Sub Sample2() ' Solucionar el siguiente sistema de ecuaciones lineales ' |1 1 1 1 5| ' |1 0 1 1 3| ' |1 0 0 1 0| ' |1 1 0 0 3| Dim a(1 To 4, 1 To 5) As Double, r(1 To 4) As Double a(1, a(2, a(3, a(4,
1) 1) 1) 1)
= = = =
1: 1: 1: 1:
a(1, a(2, a(3, a(4,
2) 2) 2) 2)
= = = =
1: 0: 0: 1:
a(1, a(2, a(3, a(4,
3) 3) 3) 3)
= = = =
1: 1: 0: 0:
a(1, a(2, a(3, a(4,
4) 4) 4) 4)
= = = =
1: 1: 1: 0:
a(1, a(2, a(3, a(4,
' pasar matriz por valor If GaussianElimination(CloneMatrix(a()), r()) Then Call ShowMatrix(a(), "Ejemplo 2") Call ShowSolution(r()) Else Debug.Print "No es un sistema de ecuaciones lineales" End If
5) 5) 5) 5)
= = = =
5 3 0 3
Debug.Print End Sub Public Sub ShowMatrix(a() As Double, Title As String) Dim i As Long, j As Long Debug.Print Title For i = 1 To UBound(a, 1) Debug.Print "|"; For j = 1 To UBound(a, 2) Debug.Print a(i, j); Next Debug.Print "|" Next Debug.Print End Sub Public Sub ShowSolution(r() As Double) Dim i As Long Debug.Print "Solución por Eliminación Gaussiana" For i = 1 To UBound(r) Debug.Print "C" & i & " = " & r(i) Next Debug.Print End Sub Public Function CloneMatrix(a() As Double) As Double() Dim r() As Double Dim i As Long, j As Long, n As Long, m As Long ' strict base 1 n = UBound(a, 1) m = UBound(a, 2) ReDim r(1 To n, 1 To m) For i = 1 To n For j = 1 To m r(i, j) = a(i, j) Next Next CloneMatrix = r End Function Agregue la función CloneMatrix para ilustrar el hecho de que en VB6 podemos a través de código, pasar una matriz por valor. Por ejemplo, recuerde que la función GaussianElimination transforma la matriz durante el calculo, y si deseamos operaciones posteriores con la misma debemos pasarla por valor; ver Sample2 para ilustración.
Si usted tiene una sugerencia para mejorar el código, por favor envíeme un e-mail.
Referencias 1. 2.
Gaussian Elimination, http://mathworld.wolfram.com/GaussianElimination.html Eliminación de Gauss-Jordan, http://es.wikipedia.org/wiki/Eliminaci%C3%B3n_de_Gauss-Jordan
