Resolución de los sistemas de ecuaciones lineales complejos con ordenadores
Enviado por Aladar Peter Santha
- Método de Gauss para sistemas de tipo Cramer
- Cálculo de la inversa de una matriz
- Resolución de sistemas cualquiera con coeficientes decimales o enteros de Gauss
- Propiedades del módulo de un número complejo
- Error absoluto y relativo de un número complejo
- Error absoluto de la suma y de la diferencia
- Error absoluto del producto o del cociente
- Error relativo del producto y del cociente
- Error absoluto y relativo de una potencia
- Resolución de sistemas lineales cualquiera
- Bibliografía
Método de Gauss para sistemas de tipo Cramer
La resolución de un sistema Cramer (el número de las ecuaciones es igual al número de las incógnitas y su determinante es diferente de cero) es muy sencilla cuando tiene la forma triangular, como en el ejemplo siguiente:
Para resolver un sistema con coeficientes complejos de tipo Cramer, por el método de Gauss, hay que sustituirlo con un sistema reducido equivalente (triangular). La exposición del método se hará en el caso de un sistema de cuatro ecuaciones con cuatro incógnitas, evitando así complicaciones innecesarias en la escritura. Si el sistema
, respectivamente, se obtiene el sistema equivalente:
Dado un sistema donde el número de las ecuaciones coincide con el número de las incógnitas, el procedimiento siguiente averiguará si es de tipo Cramer y, en el caso afirmativo, resolverá el sistema. En el caso de que el sistema no fuera de tipo Cramer, el ordenador emitirá el mensaje oportuno.
Public Function MGSCCO1(ByRef cc0() As Double) As Variant
'Autor: Aladar Peter Santha
Dim y As Double, k As Integer, rc As String, er As Double
Dim i As Integer, j As Integer, n As Integer, sw As Integer, m As Integer, sig As String
Dim cc() As Double, res(2) As String, x() As Double, rr() As Double
cc() = cc0(): er = 0.00000000000001 ' cc() es la matriz del sistema
n = UBound(cc()): rc = Chr$(13) + Chr$(10)
ReDim x(n, 2)
For j = 1 To n
sw = 0
If cc(j, j, 1) = 0 And cc(j, j, 2) = 0 Then
For k = j + 1 To n
If cc(k, j, 1) <> 0 Or cc(k, j, 2) <> 0 Then
sw = 1: Exit For
End If
Next k
If sw = 0 Then
MsgBox "Es posible que el sistema no sea de tipo Cramer."
res(1) = "¡Revise y modifique las ecuaciones!"
res(2) = " ¡No se ha calculado!"
MGSCCO1 = res()
Exit Function
Else
For m = j To n + 1
y = cc(j, m, 1): cc(j, m, 1) = cc(k, m, 1): cc(k, m, 1) = y
y = cc(j, m, 2): cc(j, m, 2) = cc(k, m, 2): cc(k, m, 2) = y
Next m
End If
End If
If cc(j, j, 1) <> 0 Or cc(j, j, 2) <> 0 Then
For i = j + 1 To n
For m = j + 1 To n + 1
rr() = MultNC(cc(i, j, 1), cc(i, j, 2), cc(j, m, 1), cc(j, m, 2))
rr() = DivNC(rr(1), rr(2), cc(j, j, 1), cc(j, j, 2))
rr() = ResNC(cc(i, m, 1), cc(i, m, 2), rr(1), rr(2))
cc(i, m, 1) = rr(1): cc(i, m, 2) = rr(2)
If Abs(cc(i, m, 1)) < er Then cc(i, m, 1) = 0
If Abs(cc(i, m, 2)) < er Then cc(i, m, 2) = 0
Next m
cc(i, j, 1) = 0: cc(i, j, 2) = 0
Next i
End If
Next j
For i = n To 1 Step -1
x(i, 1) = cc(i, n + 1, 1): x(i, 2) = cc(i, n + 1, 2)
For j = n To i + 1 Step -1
rr() = MultNC(cc(i, j, 1), cc(i, j, 2), x(j, 1), x(j, 2))
rr() = ResNC(x(i, 1), x(i, 2), rr(1), rr(2))
x(i, 1) = rr(1): x(i, 2) = rr(2)
Next j
rr() = DivNC(x(i, 1), x(i, 2), cc(i, i, 1), cc(i, i, 2))
x(i, 1) = rr(1): x(i, 2) = rr(2)
Next i
res(2) = VerSistema1(cc())
res(1) = ""
For i = 1 To n
res(1) = res(1) + "x (" + Str$(i) + ") = "
If x(i, 1) <> 0 And x(i, 2) <> 0 Then
res(1) = res(1) + Format$(x(i, 1), "#0.###############0")
If Left$(x(i, 2), 1) = "-" Then sig = " – " Else sig = " + "
res(1) = res(1) + sig + Format$(Abs(x(i, 2)), "#0.###############0") + " i" + rc
End If
If x(i, 1) <> 0 And x(i, 2) = 0 Then
res(1) = res(1) + Format$(x(i, 1), "#0.###############0") + rc
End If
If x(i, 1) = 0 And x(i, 2) <> 0 Then
If Left$(x(i, 2), 1) = "-" Then sig = " – " Else sig = " + "
res(1) = res(1) + sig + Format$(Abs(x(i, 2)), "#0.###############0") + " i" + rc
End If
If x(i, 1) = 0 And x(i, 2) = 0 Then
res(1) = res(1) + "0" + rc
End If
Next i
MGSCCO1 = res()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function VerSistema1(ByRef c() As Double) As String
Dim sist As String, n As Integer, i As Integer, j As Integer, r As String
Dim pr As Double, pi As Double, p() As String
n = UBound(c()): sist = "": ReDim p(n)
For i = 1 To n: p(i) = "x(" + Str$(i) + ")": Next i
For i = 1 To n
For j = 1 To n
If c(i, j, 1) <> 0 And c(i, j, 2) <> 0 Then
If j = 1 Then
sist = sist + "( "
Else
sist = sist + " + ( "
End If
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
sist = sist + r + " ) "
Else
If c(i, j, 1) <> 0 And c(i, j, 2) = 0 Then
If c(i, j, 1) < 0 Then
If c(i, j, 1) <> -1 Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
sist = sist + r
Else
sist = sist + " – "
End If
End If
If c(i, j, 1) > 0 Then
If c(i, j, 1) <> 1 Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
If j <> 1 Then sist = sist + " + "
sist = sist + r
Else
If j <> 1 Then sist = sist + " + "
End If
End If
End If
If c(i, j, 2) <> 0 And c(i, j, 1) = 0 Then
If c(i, j, 2) < 0 Then
If c(i, j, 2) <> -1 Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
sist = sist + r
Else
sist = sist + " -i "
End If
End If
If c(i, j, 2) > 0 Then
If c(i, j, 2) <> 1 Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
If j <> 1 Then sist = sist + " + "
sist = sist + r
Else
If j <> 1 Then sist = sist + " +i "
End If
End If
End If
If c(i, j, 1) = 0 And c(i, j, 2) = 0 Then
If j = 1 Then sist = sist + "0 " Else sist = sist + " + 0"
End If
End If
sist = sist + " " + p(j)
Next j
pr = c(i, n + 1, 1): pi = c(i, n + 1, 2)
r = FormatoComplejo(pr, pi)
sist = sist + " = " + r + rc
VerSistema1 = sist
Next i
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function f1(ByVal x As String) As String
If Abs(Val(x)) >= 1 Then
f1 = x
Else
If Left$(x, 1) = "." Then f1 = "0" + x
End If
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function f2(ByVal x As Double) As String
Dim xx As String
xx = Str$(x)
If Abs(x) >= 1 Or x = 0 Then
f2 = xx
Else
If Left$(xx, 2) = "-." Then f2 = "-0" + Mid$(xx, 2)
If Left$(xx, 2) = " ." Then f2 = "0" + Mid$(xx, 2)
If f2 = "" Then f2 = xx
End If
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function FormatoComplejo(pr, pi) As String
'Escritura de un número complejo en una caja de texto.
r = ""
If pr <> 0 Then
r = r + f2(pr)
End If
If pi <> 0 Then
If Abs(pi) = 1 Then
If pi = 1 Then
If pr <> 0 Then r = r + " + "
Else
r = r + " – "
End If
Else
If pi > 0 Then
If pr <> 0 Then
r = r + " + "
End If
r = r + f2(pi)
Else
r = r + " – " + f1(Mid$(Str$(pi), 2))
End If
End If
r = r + " i"
End If
If r = "" Then r = "0"
FormatoComplejo = r
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function MultNC(ByVal z11 As Double, ByVal z12 As Double, ByVal z21 As Double, ByVal z22 As Double) As Variant
Dim pr(2) As Double, res() As Double
pr(1) = z11 * z21 – z12 * z22
pr(2) = z11 * z22 + z12 * z21
MultNC = pr()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function DivNC(ByVal z11 As Double, ByVal z12 As Double, ByVal z21 As Double, ByVal z22 As Double) As Variant
Dim cmv As Double, co() As Double, x(2) As Double, y(2) As Double, rr() As Double
ReDim co(2)
cmv = z21 * z21 + z22 * z22
x(1) = z11: x(2) = z12: y(1) = z21: y(2) = -z22
rr() = MultNC(x(1), x(2), y(1), y(2))
co(1) = rr(1) / cmv: co(2) = rr(2) / cmv
DivNC = co()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function SumNC(ByVal z11 As Double, ByVal z12 As Double, ByVal z21 As Double, ByVal z22 As Double) As Variant
Dim rr(2) As Double
rr(1) = z11 + z21: rr(2) = z12 + z22
SumNC = rr()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function ResNC(ByVal z11 As Double, ByVal z12 As Double, ByVal z21 As Double, ByVal z22 As Double) As Variant
Dim rr(2) As Double
rr(1) = z11 – z21: rr(2) = z12 – z22
ResNC = rr()
End Function
Observación 1.1:
Puesto que los ordenadores trabajan siempre con un número finito de dígitos por número, los coeficientes del sistema reducido (triangular) obtenido no se podrán calcular siempre con exactitud. Así, al efectuar los cálculos con un ordenador, el sistema inicial y el sistema triangular obtenido por el método de Gauss en la práctica podrían no ser equivalentes. Sin embargo, las soluciones del sistema reducido (triangular) en general aproximarán bien las soluciones del sistema inicial.
Si los coeficientes del sistema (1.2) son enteros de Gauss (según lo expuesto en [8] existe el máximo común divisor y el mínimo común múltiplo en Z[i]), entonces se puede llegar a un sistema reducido equivalente de la manera siguiente:
Si los coeficientes del sistema son números complejos decimales, para llegar a un sistema con coeficientes enteros equivalente, basta con multiplicar cada ecuación con una potencia de diez cuyo exponente es el número máximo de las cifras después del punto decimal, en las partes reales e imaginarias de los coeficientes de la ecuación.
Trabajando de esta manera, el programa de ordenador tendrá que utilizar las funciones para operar con enteros de Gauss y enteros y decimales largos. Con este programa se podrán resolver sistemas de tipo Cramer con coeficientes enteros de Gauss o decimales extra largos y con la precisión que se quiera.
Public Function MGSCEG2(ByRef cc0() As String, pr As Integer) As Variant
'Se utilizan las operaciones con enteros y decimales extra largos
Dim y As String, k As Integer, rc As String, qq() As String
Dim i As Integer, j As Integer, n As Integer, sw As Integer, m As Integer
Dim cc() As String, res(3) As String, x(2) As String, zz() As String, rr() As String
Dim z(2) As String, v1() As String, v2() As String, xx() As String, tt() As String
cc() = CSDSEC(cc0())
res(3) = VerSistemaC0(cc0())
n = UBound(cc(), 1): rc = Chr$(13) + Chr$(10)
ReDim xx(n, 2)
For j = 1 To n
sw = 0
If cc(j, j, 1) = "0" And cc(j, j, 2) = "0" Then
For k = j + 1 To n
If cc(k, j, 1) <> "0" Or cc(k, j, 2) <> "0" Then
sw = 1: Exit For
End If
Next k
If sw = 0 Then
MsgBox "El sistema no es de tipo Cramer."
res(1) = "¡Revise y modifique las ecuaciones!"
res(2) = "¡No se ha calculado!"
MGSCEG2 = res()
Exit Function
Else
For m = j To n + 1
y = cc(j, m, 1): cc(j, m, 1) = cc(k, m, 1): cc(k, m, 1) = y
y = cc(j, m, 2): cc(j, m, 2) = cc(k, m, 2): cc(k, m, 2) = y
Next m
End If
End If
If cc(j, j, 1) <> "0" Or cc(j, j, 2) <> "0" Then
For m = j + 1 To n
If cc(m, j, 1) <> "0" Or cc(m, j, 2) <> "0" Then
zz() = MCMEGG(cc(j, j, 1), cc(j, j, 2), cc(m, j, 1), cc(m, j, 2))
rr() = DivEEGG(zz(1), zz(2), cc(j, j, 1), cc(j, j, 2))
qq() = DivEEGG(zz(1), zz(2), cc(m, j, 1), cc(m, j, 2))
For k = j + 1 To n + 1
v1() = MultNCG(cc(j, k, 1), cc(j, k, 2), rr(1, 1), rr(1, 2))
v2() = MultNCG(cc(m, k, 1), cc(m, k, 2), qq(1, 1), qq(1, 2))
tt() = ResNCG(v2(1), v2(2), v1(1), v1(2))
cc(m, k, 1) = tt(1): cc(m, k, 2) = tt(2)
Next k
End If
cc(m, j, 1) = "0": cc(m, j, 2) = "0"
Next m
End If
Next j
res(2) = VerSistemaC0(cc())
'''''''''''''''''' Resolución del sistema reducido
For i = n To 1 Step -1
xx(i, 1) = cc(i, n + 1, 1): xx(i, 2) = cc(i, n + 1, 2)
For j = n To i + 1 Step -1
zz() = MultNCDG(cc(i, j, 1), cc(i, j, 2), xx(j, 1), xx(j, 2))
rr() = ResNCDG(xx(i, 1), xx(i, 2), zz(1), zz(2))
xx(i, 1) = rr(1): xx(i, 2) = rr(2)
Next j
rr() = DivNCDG(xx(i, 1), xx(i, 2), cc(i, i, 1), cc(i, i, 2), pr)
xx(i, 1) = rr(1): xx(i, 2) = rr(2)
Next i
' Edición del resultado.
res(1) = ""
For i = 1 To n
res(1) = res(1) + "x (" + Str$(i) + ") = "
If xx(i, 1) <> "0" And xx(i, 2) <> "0" Then
res(1) = res(1) + xx(i, 1)
If Left$(xx(i, 2), 2) = "-" Then
res(1) = res(1) + " – " + Mid$(xx(i, 2), 2) + " i" + rc
Else
res(1) = res(1) + " + " + xx(i, 2) + " i" + rc
End If
End If
If xx(i, 1) = "0" And xx(i, 2) <> "0" Then
If Left$(xx(i, 2), 2) = "-" Then
res(1) = res(1) + " – " + Mid$(xx(i, 2), 2) + " i" + rc
Else
res(1) = res(1) + " + " + xx(i, 2) + " i" + rc
End If
End If
If xx(i, 1) <> "0" And xx(i, 2) = "0" Then
res(1) = res(1) + xx(i, 1) + rc
End If
If xx(i, 1) = "0" And xx(i, 2) = "0" Then
res(1) = res(1) + "0" + rc
End If
Next i
MGSCEG2 = res()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function CSDSEC(ByRef c0() As String) As Variant
' Conversión de un sistema con coeficientes complejos decimales
' a un sistema equivalente con coeficientes enteros enteros de Gauss.
Dim i As Integer, j As Integer, k As Integer, p As Integer, q As Integer
Dim c() As String, caracter As String, t() As Integer, nd As Integer, pd As String
Dim k1 As Integer, k2 As Integer, x(2) As String, m As Integer
c() = c0()
p = UBound(c(), 1): q = p + 1
For i = 1 To p
ReDim t(p): caracter = ""
For j = 1 To q
For m = 1 To 2
For k = 1 To Len(c(i, j, m)) – 1
caracter = Right$(Left$(c(i, j, m), k), 1)
If caracter = "." Then
nd = Len(Mid$(c(i, j, m), k + 1))
If nd > t(i) Then t(i) = nd
End If
Next k
Next m
Next j
If t(i) > 0 Then
pd = "10"
For k1 = 1 To t(i) – 1
x(1) = pd: x(2) = "10": pd = Multiplicar(x(), 7)
Next k1
For k2 = 1 To q
x(1) = c(i, k2, 1): x(2) = pd: c(i, k2, 1) = MultiplicarDec(x(), 7)
x(1) = c(i, k2, 2): x(2) = pd: c(i, k2, 2) = MultiplicarDec(x(), 7) '
Next k2
End If
Next i
CSDSEC = c()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function VerSistemaC0(ByRef c() As String) As String
Dim sist As String, n As Integer, m As Integer, i As Integer, j As Integer, r As String
Dim pr As String, pi As String, p() As String, rc As String
n = UBound(c(), 1): m = UBound(c(), 2) – 1: sist = "": ReDim p(m)
rc = Chr$(13) + Chr$(10)
For i = 1 To m: p(i) = "x(" + Str$(i) + ")": Next i
For i = 1 To n
For j = 1 To m
If c(i, j, 1) <> "0" And c(i, j, 2) <> "0" Then
If j = 1 Then
sist = sist + "( "
Else
sist = sist + " + ( "
End If
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
sist = sist + r + " ) "
End If
If c(i, j, 1) <> "0" And c(i, j, 2) = "0" Then
If Left$(c(i, j, 1), 1) = "-" Then
If c(i, j, 1) <> "-1" Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
sist = sist + r
Else
sist = sist + " – "
End If
Else
If j <> 1 Then sist = sist + " + "
If c(i, j, 1) <> "1" Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
sist = sist + r
Else
sist = sist + " i "
End If
End If
End If
If c(i, j, 2) <> "0" And c(i, j, 1) = "0" Then
If Left$(c(i, j, 2), 1) = "-" Then
If c(i, j, 2) <> "-1" Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
sist = sist + r
Else
sist = sist + " -i "
End If
Else
If c(i, j, 2) <> "1" Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
If j <> 1 Then sist = sist + " + "
sist = sist + r
Else
sist = sist + " +i "
End If
End If
End If
If c(i, j, 1) = "0" And c(i, j, 2) = "0" Then
If j = 1 Then sist = sist + " 0" Else sist = sist + " + 0"
End If
sist = sist + " " + p(j)
Next j
pr = c(i, m + 1, 1): pi = c(i, m + 1, 2)
r = FormatoComplejo(pr, pi)
sist = sist + " = " + r + rc
VerSistemaC0 = sist
Next i
VerSistemaC0 = sist
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function FormatoComplejo(ByVal pr As String, ByVal pi As String) As String
'Escritura de un número complejo en una caja de texto.
Dim r As String
r = ""
If pr <> "0" Then
r = r + h(pr)
End If
If pi <> "0" Then
If pi = "1" Or pi = "-1" Then
If pi = "1" Then
If pr <> "0" Then r = r + " + "
Else
r = r + " – "
End If
Else
If Left$(pi, 1) <> "-" And pi <> "0" Then
If pr <> "0" Then
r = r + " + "
End If
r = r + h(pi)
Else
r = r + " – " + h(Mid$(pi, 2))
End If
End If
r = r + " i"
End If
If r = "" Then r = "0"
FormatoComplejo = r
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function h(ByVal xx As String) As String
' Sustituye .abc… por 0.abc y -.abc… por -0.abc
Dim dif As String, x(2) As String, v As String
If Left$(xx, 1) = "-" Then v = Mid$(xx, 2) Else v = xx
x(1) = "1": x(2) = v: dif = RestarDec(x(), 7)
If Left$(dif, 1) = "-" Then
h = xx
Else
If Left$(xx, 1) = "-" Then
If Left$(xx, 2) = "-." Then
h = "-0" + Mid$(xx, 2)
Else
h = xx
End If
Else
If xx = "0" Then
h = xx
Else
If Left$(xx, 1) = "." Then
h = "0" + xx
Else
h = xx
End If
End If
End If
End If
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function DivEEGG(ByVal z11 As String, ByVal z12 As String, ByVal z21 As String, ByVal z22 As String) As Variant
'División euclidea de enteros de Gauss.
Dim x(2) As String, q(2) As String, r() As String, v(2, 2) As String, pp As String
Dim rr() As String, y(2) As String, t As String, i As Integer, k As Integer
rr() = DivNCG(z11, z12, z21, z22, 6)
For i = 1 To 2
y(i) = FixNG(rr(i))
x(1) = y(i): x(2) = rr(i): x(1) = Restar(x(), 7)
If Left$(x(1), 1) = "-" Then x(1) = Mid$(x(1), 2)
x(2) = "0.5": t = RestarDec(x(), 7)
If t = "0" Or Left$(t, 1) = "-" Then
q(i) = y(i)
Else
x(1) = y(i): x(2) = "1"
If Left$(rr(i), 1) = "-" Then
q(i) = Restar(x(), 7)
Else
q(i) = Sumar(x(), 7)
End If
End If
Next i
r() = MultNCG(z21, z22, q(1), q(2))
r() = ResNCG(z11, z12, r(1), r(2))
v(1, 1) = q(1): v(1, 2) = q(2)
v(2, 1) = r(1): v(2, 2) = r(2)
DivEEGG = v()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function MCDEGG(ByVal z11 As String, ByVal z12 As String, ByVal z21 As String, ByVal z22 As String) As Variant
Dim rr() As String, u11 As String, u12 As String, u21 As String, u22 As String
Dim r() As String, res() As String, md1 As String, md2 As String, dif As String
Dim w1 As String, w2 As String, zz As String, x(2) As String, n As Integer
n = 7
u11 = z11: u12 = z12: u21 = z21: u22 = z22
x(1) = z11: x(2) = z11: md1 = Multiplicar(x(), n)
x(1) = z12: x(2) = z12: x(1) = Multiplicar(x(), n): x(2) = md1
md1 = Sumar(x(), n)
x(1) = z12: x(2) = z12: md2 = Multiplicar(x(), n)
x(1) = z22: x(2) = z22: x(1) = Multiplicar(x(), n): x(2) = md2
md2 = Sumar(x(), n)
x(1) = md1: x(2) = md2: dif = Restar(x(), n)
If Left$(dif, 1) = "-" Then
zz = z11: z11 = z12: z12 = zz
zz = z12: z12 = z22: z22 = zz
End If
Do
rr() = DivEEGG(u11, u12, u21, u22)
If rr(2, 1) = "0" And rr(2, 2) = "0" Then Exit Do
u11 = u21: u12 = u22: u21 = rr(2, 1): u22 = rr(2, 2)
Loop
ReDim res(2)
res(1) = u21: res(2) = u22
MCDEGG = res()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function MCMEGG(ByRef z11 As String, ByVal z12 As String, ByVal z21 As String, ByVal z22 As String) As Variant
Dim prod() As String, rr() As String, res() As String, mcd() As String
prod() = MultNCG(z11, z12, z21, z22)
mcd() = MCDEGG(z11, z12, z21, z22)
rr() = DivEEGG(prod(1), prod(2), mcd(1), mcd(2))
ReDim res(2)
res(1) = rr(1, 1): res(2) = rr(1, 2)
MCMEGG = res()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function DivNCG(ByVal u1 As String, ByVal u2 As String, ByVal v1 As String, ByVal v2 As String, ByVal pr As Integer) As Variant
Dim cmv As String, co(2) As String, rr() As String, x(2) As String, cc As String
Dim p1 As String, p2 As String, ov2 As String
' División de enteros de Gauss
If v1 = "0" And v2 = "0" Then
MsgBox "¡No se puede dividir con cero!"
End
End If
If u1 = "0" And u2 = "0" And (v1 <> "0" Or v2 <> "0") Then
co(1) = "0": co(2) = "0"
DivNCG = co()
Exit Function
End If
If u2 = "0" And v2 = "0" And v1 <> "0" Then
x(1) = u1: x(2) = v1: co(1) = DividirDec(x(), pr, 7): co(2) = "0"
DivNCG = co()
Exit Function
End If
If v2 = "0" Then
x(1) = u1: x(2) = v1: co(1) = DividirDec(x(), pr, 7)
x(1) = u2: x(2) = v1: co(2) = DividirDec(x(), pr, 7)
Else
If v1 <> "0" Then
x(1) = v1: x(2) = v1: p1 = Multiplicar(x(), 7)
x(1) = v2: x(2) = v2: p2 = Multiplicar(x(), 7)
x(1) = p1: x(2) = p2: cmv = SumarDec(x(), 7)
If Left$(v2, 1) = "-" Then ov2 = Mid(v2, 2) Else ov2 = "-" + v2
rr() = MultNCG(u1, u2, v1, ov2)
x(1) = rr(1): x(2) = cmv: co(1) = DividirDec(x(), pr, 7)
x(1) = rr(2): x(2) = cmv: co(2) = DividirDec(x(), pr, 7)
Else
x(1) = u1: x(2) = v2: co(1) = DividirDec(x(), pr, 7)
x(1) = u2: x(2) = v2: co(2) = DividirDec(x(), pr, 7)
cc = co(1): co(1) = co(2): co(2) = cc
If Left$(co(2), 1) = "-" Then co(2) = Mid(co(2), 2) Else co(2) = "-" + co(2)
If co(1) = "-0" Then co(1) = "0"
If co(2) = "-0" Then co(2) = "0"
End If
End If
DivNCG = co()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function DivNCDG(ByVal u1 As String, ByVal u2 As String, ByVal v1 As String, ByVal v2 As String, pr As Integer) As Variant
Dim cmv As String, co(2) As String, rr() As String, x(2) As String, p1 As String, p2 As String, ov2 As String
' División de números complejos con decimales
x(1) = v1: x(2) = v1: p1 = MultiplicarDec(x(), 7)
x(1) = v2: x(2) = v2: p2 = MultiplicarDec(x(), 7)
x(1) = p1: x(2) = p2: cmv = SumarDec(x(), 7)
If v2 <> "0" Then
If Left$(v2, 1) = "-" Then ov2 = Mid(v2, 2) Else ov2 = "-" + v2
Else
ov2 = v2
End If
rr() = MultNCDG(u1, u2, v1, ov2)
x(1) = rr(1): x(2) = cmv: co(1) = DividirDec(x(), pr, 7)
x(1) = rr(2): x(2) = cmv: co(2) = DividirDec(x(), pr, 7)
DivNCDG = co()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function SumNCG(ByVal u1 As String, ByVal u2 As String, ByVal v1 As String, ByVal v2 As String) As Variant
'Sumar enteros de Gauss
Dim rr(2) As String, x(2) As String
x(1) = u1: x(2) = v1: rr(1) = Sumar(x(), 7)
x(1) = u2: x(2) = v2: rr(2) = Sumar(x(), 7)
SumNCG = rr()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function SumNCDG(ByVal u1 As String, ByVal u2 As String, ByVal v1 As String, ByVal v2 As String) As Variant
'Sumar números complejos con decimales.
Dim rr(2) As String, x(2) As String
x(1) = u1: x(2) = v1: rr(1) = SumarDec(x(), 7)
x(1) = u2: x(2) = v2: rr(2) = SumarDec(x(), 7)
SumNCDG = rr()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function ResNCG(ByVal u1 As String, ByVal u2 As String, ByVal v1 As String, ByVal v2 As String) As Variant
'Restar enteros de Gauss
Dim rr(2) As String, x(2) As String
x(1) = u1: x(2) = v1: rr(1) = Restar(x(), 7)
x(1) = u2: x(2) = v2: rr(2) = Restar(x(), 7)
ResNCG = rr()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function ResNCDG(ByVal u1 As String, ByVal u2 As String, ByVal v1 As String, ByVal v2 As String) As Variant
' Restar númros complejos con decimales.
Dim rr(2) As String, x(2) As String
x(1) = u1: x(2) = v1: rr(1) = RestarDec(x(), 7)
x(1) = u2: x(2) = v2: rr(2) = RestarDec(x(), 7)
ResNCDG = rr()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function MultNCDG(ByVal u1 As String, ByVal v1 As String, ByVal u2 As String, ByVal v2 As String) As Variant
' Multiplicación de los números complejos con decimales.
Dim pc(2) As String, x(2) As String, p1 As String, p2 As String
If u1 = "0" And v1 = "0" Or u2 = "0" And v2 = "0" Then
pc(1) = "0": pc(2) = "0"
MultNCDG = pc(): Exit Function
End If
If v1 = "0" And v2 = "0" Then
x(1) = u1: x(2) = u2: pc(1) = MultiplicarDec(x(), 7): pc(2) = "0"
MultNCDG = pc(): Exit Function
End If
If u1 = "0" And u2 = "0" Then
x(1) = v1: x(2) = v2: pc(2) = MultiplicarDec(x(), 7): pc(1) = "0"
If Left$(pc(2), 1) = "-" Then pc(2) = Mid$(pc(2), 2) Else pc(2) = "-" + pc(2)
If pc(2) = "-0" Then pc(2) = "0"
MultNCDG = pc(): Exit Function
End If
x(1) = u1: x(2) = u2: p1 = MultiplicarDec(x(), 7)
x(1) = v1: x(2) = v2: p2 = MultiplicarDec(x(), 7)
x(1) = p1: x(2) = p2: pc(1) = RestarDec(x(), 7)
x(1) = u1: x(2) = v2: p1 = MultiplicarDec(x(), 7)
x(1) = u2: x(2) = v1: p2 = MultiplicarDec(x(), 7)
x(1) = p1: x(2) = p2: pc(2) = SumarDec(x(), 7)
MultNCDG = pc()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function MultNCG(ByVal u1 As String, ByVal v1 As String, ByVal u2 As String, ByVal v2 As String) As Variant
' Multiplicación de los enteros de Gauss.
Dim pc(2) As String, x(2) As String, p1 As String, p2 As String
If u1 = "0" And v1 = "0" Or u2 = "0" And v2 = "0" Then
pc(1) = "0": pc(2) = "0"
MultNCG = pc(): Exit Function
End If
If v1 = "0" And v2 = "0" Then
x(1) = u1: x(2) = u2: pc(1) = Multiplicar(x(), 7): pc(2) = "0"
MultNCG = pc(): Exit Function
End If
If u1 = "0" And u2 = "0" Then
x(1) = v1: x(2) = v2: pc(2) = Multiplicar(x(), 7): pc(1) = "0"
If Left$(pc(2), 1) = "-" Then pc(2) = Mid$(pc(2), 2) Else pc(2) = "-" + pc(2)
If pc(2) = "-0" Then pc(2) = "0"
MultNCG = pc(): Exit Function
End If
x(1) = u1: x(2) = u2: p1 = Multiplicar(x(), 7)
x(1) = v1: x(2) = v2: p2 = Multiplicar(x(), 7)
x(1) = p1: x(2) = p2: pc(1) = Restar(x(), 7)
x(1) = u1: x(2) = v2: p1 = Multiplicar(x(), 7)
x(1) = u2: x(2) = v1: p2 = Multiplicar(x(), 7)
x(1) = p1: x(2) = p2: pc(2) = Sumar(x(), 7)
MultNCG = pc()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function FixNG(ByVal u As String) As String
Dim v As String, pp As String, k As Integer, x(2) As String
If u = "-1" Then FixNG = "-1": Exit Function
If u = "1" Then FixNG = "1": Exit Function
If u = "0" Then FixNG = "0": Exit Function
If Left$(u, 2) = "0." Then FixNG = "0": Exit Function
If Left$(u, 3) = "-0." Then FixNG = "0": Exit Function
For k = 1 To Len(u)
pp = Right$(Left$(u, k), 1)
If pp = "." Then
v = Left$(u, k – 1)
If Left$(u, 1) = "-" Then
FixNG = v: Exit Function
Else
x(1) = v: x(2) = "1": FixNG = Sumar(x(), 7)
Exit Function
End If
End If
Next k
FixNG = u
End Function
Ejemplo 1.3:
Comparando (1.8) con (1.12) resulta que en el resultado (1.8) las últimas 2-3 cifras de los números decimales no estaban seguras.
Cálculo de la inversa de una matriz
La resolución de los sistemas lineales de tipo Cramer es importante puesto que permite calcular la matriz inversa de una matriz cuadrada de determinante no nulo y cuyos elementos son enteros de Gauss.
Las funciones siguientes devuelven la matriz inversa de una matriz compleja con determinante no nulo.
Public Function InvMatCGaussNGV1(ByRef a0() As String, ByVal pr As Integer) As String
Dim i As Integer, j As Integer, k As Integer, xx() As Double, minv() As String
Dim n0 As Integer, c() As String, a() As String, rr() As String, rc As String
a() = a0(): n0 = UBound(a(), 1): rc = Chr$(13) + Chr$(10)
ReDim c(n0, n0 + 1, 2), xx(n0, 2, n0), minv(n0, n0, 2)
For k = 1 To n0
For i = 1 To n0
For j = 1 To n0
c(i, j, 1) = a(i, j, 1)
c(i, j, 2) = a(i, j, 2)
Next j
Next i
For i = 1 To n0: c(i, n0 + 1, 1) = "0": c(i, n0 + 1, 2) = "0": Next i
c(k, n0 + 1, 1) = "1": c(k, n0 + 1, 2) = "0"
rr() = MGSCEG2(c(), pr)
For i = 1 To n0
minv(i, k, 1) = rr(i, 1): minv(i, k, 2) = rr(i, 2)
Next i
Next k
InvMatCGaussNGV1 = VerMatrizC(minv())
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function MGSCEG2(ByRef cc0() As String, ByVal pr As Integer) As Variant
'Se utilizan las operaciones con enteros y decimales extra largos.
' La matriz inversa se devuelve en la forma editada.
Dim y As String, k As Integer, rc As String, rr() As String, tt() As String
Dim i As Integer, j As Integer, n As Integer, sw As Integer, m As Integer
Dim cc() As String, res As String, x(2) As String, zz() As String, qq() As String
Dim z(2) As String, v1() As String, v2() As String, xx() As String
cc() = CSDSEC(cc0())
n = UBound(cc(), 1): rc = Chr$(13) + Chr$(10)
ReDim xx(n, 2)
For j = 1 To n
sw = 0
If cc(j, j, 1) = "0" And cc(j, j, 2) = "0" Then
For k = j + 1 To n
If cc(k, j, 1) <> "0" Or cc(k, j, 2) <> "0" Then
sw = 1: Exit For
End If
Next k
If sw = 0 Then
MsgBox "¡La matriz no tiene inversa!"
End
Else
For m = j To n
y = cc(j, m, 1): cc(j, m, 1) = cc(k, m, 1): cc(k, m, 1) = y
y = cc(j, m, 2): cc(j, m, 2) = cc(k, m, 2): cc(k, m, 2) = y
Next m
End If
End If
For m = j + 1 To n
If cc(m, j, 1) <> "0" Or cc(m, j, 2) <> "0" Then
zz() = MCMEGG(cc(j, j, 1), cc(j, j, 2), cc(m, j, 1), cc(m, j, 2))
rr() = DivEEGG(zz(1), zz(2), cc(j, j, 1), cc(j, j, 2))
qq() = DivEEGG(zz(1), zz(2), cc(m, j, 1), cc(m, j, 2))
For k = j + 1 To n + 1
v1() = MultNCG(cc(j, k, 1), cc(j, k, 2), rr(1, 1), rr(1, 2))
v2() = MultNCG(cc(m, k, 1), cc(m, k, 2), qq(1, 1), qq(1, 2))
tt() = ResNCG(v2(1), v2(2), v1(1), v1(2))
cc(m, k, 1) = tt(1): cc(m, k, 2) = tt(2)
Next k
End If
cc(m, j, 1) = "0": cc(m, j, 2) = "0"
Next m
Next j
'''''''''''''''''' Resolución del sistema reducido.
For i = n To 1 Step -1
xx(i, 1) = cc(i, n + 1, 1): xx(i, 2) = cc(i, n + 1, 2)
For j = n To i + 1 Step -1
zz() = MultNCDG(cc(i, j, 1), cc(i, j, 2), xx(j, 1), xx(j, 2))
rr() = ResNCDG(xx(i, 1), xx(i, 2), zz(1), zz(2))
xx(i, 1) = rr(1): xx(i, 2) = rr(2)
Next j
rr() = DivNCDG(xx(i, 1), xx(i, 2), cc(i, i, 1), cc(i, i, 2), pr)
xx(i, 1) = rr(1): xx(i, 2) = rr(2)
Next i
'res = ""
''''''''''' Edición del resultado.
'For i = 1 To n
'res = res + xx(i, 1)
'If Left$(xx(i, 2), 1) = "-" Then
'res = res + " – " + Mid$(xx(i, 2), 2) + " i"
'Else
'res = res + " + " + xx(i, 2) + " i"
'End If
'if i < n Then
'res = res + " , "
'End If
'Next i
MGSCEG2 = xx()
End Function
"- – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function CSDSEC(ByRef c0() As String) As Variant
' Conversión de un sistema con coeficientes complejos decimales
' a un sistema equivalente con coeficientes enteros enteros de Gauss.
Dim i As Integer, j As Integer, k As Integer, p As Integer ', q As Integer
Dim c() As String, caracter As String, t() As Integer, nd As Integer, pd As String
Dim k1 As Integer, k2 As Integer, x(2) As String, m As Integer
c() = c0()
p = UBound(c(), 1)
For i = 1 To p
ReDim t(p): caracter = ""
For j = 1 To p
Página siguiente |