Resolución de los sistemas de ecuaciones lineales complejos con ordenadores

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