Resolución de los sistemas de ecuaciones lineales complejos con ordenadores (página 2)
Enviado por Aladar Peter Santha
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 p
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 VerMatrizC(ByRef c() As String) As String
Dim mtr As String, n As Integer, i As Integer, j As Integer, rc As String
n = UBound(c()): mtr = ""
rc = Chr$(13) + Chr$(10)
For i = 1 To n
For j = 1 To n
If c(i, j, 1) <> "0" And c(i, j, 2) <> "0" Then
mtr = mtr + c(i, j, 1)
If Left$(c(i, j, 2), 1) <> "-" Then
If c(i, j, 2) <> "1" Then
mtr = mtr + " + " + c(i, j, 2) + " i"
Else
mtr = mtr + " + " + " i"
End If
Else
If c(i, j, 2) <> "-1" Then
mtr = mtr + " – " + Mid$(c(i, j, 2), 2) + " i"
Else
mtr = mtr + " – " + " i"
End If
End If
Else
If c(i, j, 1) <> "0" Then
mtr = mtr + c(i, j, 1)
End If
If c(i, j, 2) <> "0" Then
If Left$(c(i, j, 2), 1) = "-" Then
mtr = mtr + " – "
If c(i, j, 2) <> "-1" Then
mtr = mtr + Mid$(c(i, j, 2), 2)
End If
End If
If Left$(c(i, j, 2), 1) <> "-" Then
If c(i, j, 2) <> "1" Then
mtr = mtr + c(i, j, 2)
End If
End If
mtr = mtr + " i "
End If
End If
If c(i, j, 1) = "0" And c(i, j, 2) = "0" Then mtr = mtr + "0"
If j < n Then mtr = mtr + " , "
Next j
If i < n Then mtr = mtr + rc
Next i
VerMatrizC = mtr
End Function
Cuando en una cadena de operaciones se quiere utilizar las inversas de algunas matrices, en el código anterior en vez de la función InvMatCGaussNGV1 hay que utilizar la función InvMatCGaussNGV2 que devuelve directamente las matrices inversas sin editarlas:
Public Function InvMatCGaussNGV2(ByRef a0() As String, ByVal pr As Integer) As Variant
Dim i As Integer, j As Integer, k As Integer, xx() As Double
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) As String
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
InvMatCGaussNGV2 = minv()
End Function
Ejemplo 2.1:
Resolución de sistemas cualquiera con coeficientes decimales o enteros de Gauss
Obviamente, con el método de Gauss modificado (Ver la función MGSCEG2) se pueden resolver no solamente sistemas de ecuaciones lineales de tipo Cramer, sino también sistemas lineales cualesquiera cuyos coeficientes se pueden introducir de manera exacta en el ordenador. Si los coeficientes del sistema son números complejos decimales, multiplicando las ecuaciones con potencias de 10 se puede obtener siempre un sistema equivalente cuyos coeficientes son enteros de Gauss. Así se obtiene un sistema reducido (triangular o trapezoidal) equivalente al sistema inicial, tal como se ha visto en el caso real (Ver [7]).
En este caso el sistema es compatible y en el caso contrario es incompatible. En el caso compatible puede ocurrir que sea, determinado o indeterminado. Las funciones necesarias para realizar esta tarea son las siguientes:
Public Function MGSCEG3(ByRef cc0() As String, pr As Integer) As Variant
'Autor: Aladar Peter Santha
'Resolución de un sistema de ecuaciones lineales con coeficientes complejos cualquiera
' con coeficientes exactos.
'Se utilizan las operaciones con enteros y decimales extra-largos.
Dim y As String, mensaje As String, k As Integer, nm As Integer, r As Integer
Dim i As Integer, j As Integer, j0 As Integer, n As Integer, m As Integer, rc As String
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
Dim k0 As Integer, i0 As Integer, t() As Integer, tn() As Integer, m0 As Integer
Dim yi As Integer, kk As Integer, sol As String, qq() As String, sw As Integer
n = UBound(cc0(), 1): m = UBound(cc0(), 2) – 1
cc() = CSDSEC2(cc0()): rc = Chr$(13) + Chr$(10)
ReDim t(m), tn(m)
If n < m Then nm = n Else nm = m
' – – – – – – – – – – – – – – – – – Obtención del sistema reducido
For i = 1 To m: t(i) = i: Next i
res(3) = VerSistemaC(cc0(), t()) ' res(3) contiene el sistema inicial.
For j = 1 To nm
If cc(j, j, 1) = "0" And cc(j, j, 2) = "0" Then
k0 = j: i0 = j
If n >= m Then
For i = j To m
For k = j To n
If cc(k, i, 1) <> "0" Or cc(k, i, 2) <> "0" Then
k0 = k: i0 = i
sw = 1: Exit For
End If
Next k
If sw = 1 Then sw = 0
Exit For
Next i
Else
For k = j To n
For i = j To m
If cc(k, i, 1) <> 0 Or cc(k, i, 2) <> 0 Then
k0 = k: i0 = i
sw = 1: Exit For
End If
Next i
If sw = 1 Then sw = 0
Exit For
Next k
End If
If k0 <> j Then
For i = 1 To m + 1
y = cc(j, i, 1): cc(j, i, 1) = cc(k0, i, 1): cc(k0, i, 1) = y
y = cc(j, i, 2): cc(j, i, 2) = cc(k0, i, 2): cc(k0, i, 2) = y
Next i
End If
If i0 <> j Then
For i = 1 To n
y = cc(i, j, 1): cc(i, j, 1) = cc(i, i0, 1): cc(i, i0, 1) = y
y = cc(i, j, 2): cc(i, j, 2) = cc(i, i0, 2): cc(i, i0, 2) = y
Next i
yi = t(j): t(j) = t(i0): t(i0) = yi
End If
End If
If cc(j, j, 1) <> "0" Or cc(j, j, 2) <> "0" Then
For m0 = j + 1 To n
If cc(m0, j, 1) <> "0" Or cc(m0, j, 2) <> "0" Then
zz() = MCMEGG(cc(j, j, 1), cc(j, j, 2), cc(m0, j, 1), cc(m0, j, 2))
rr() = DivEEGG(zz(1), zz(2), cc(j, j, 1), cc(j, j, 2))
qq() = DivEEGG(zz(1), zz(2), cc(m0, j, 1), cc(m0, j, 2))
For k = j + 1 To m + 1
v1() = MultNCG(cc(j, k, 1), cc(j, k, 2), rr(1, 1), rr(1, 2))
v2() = MultNCG(cc(m0, k, 1), cc(m0, k, 2), qq(1, 1), qq(1, 2))
tt() = ResNCG(v2(1), v2(2), v1(1), v1(2))
cc(m0, k, 1) = tt(1): cc(m0, k, 2) = tt(2)
Next k
End If
cc(m0, j, 1) = "0": cc(m0, j, 2) = "0"
Next m0
End If
Next j
' – – – – – – – – – – – – – – – – – – – – – Rango de la matriz del sistema
For i = n To 1 Step -1
For j0 = 1 To m
If cc(i, j0, 1) <> "0" Or cc(i, j0, 2) Then
r = i: sw = 1: Exit For
End If
Next j0
If sw = 1 Then Exit For
Next i
' – – – – – – – – – – – – – – – – – – – – Compatibilidad del sistema
For i = n To r + 1 Step -1
If cc(i, m + 1, 1) <> "0" And cc(i, m + 1, 2) <> "0" And cc(i, m, 1) = "0" And cc(i, m, 2) = "0" Then
res(1) = "El sistema es incompatible"
res(2) = VerSistemaC(cc(), t())
MGSCEG3 = res()
Exit Function
End If
Next i
' – – – – – – – – – – – – – – – – – Resolución del sistema reducido.
ReDim sp(m – r + 1, m, 2), cn(r, m + 1, 2), xx(m, 2)
For k = r + 1 To m + 1
If k < m + 1 Then
For kk = r + 1 To m
If kk = k Then
xx(kk, 1) = "1": xx(kk, 2) = "0"
Else
xx(kk, 1) = "0": xx(kk, 2) = "0"
End If
Next kk
Else
For kk = r + 1 To m: xx(kk, 1) = "0": xx(kk, 2) = "0": Next kk
End If
Next k
For k = r + 1 To m + 1
For i = 1 To r
For j = 1 To r
cn(i, j, 1) = cc(i, j, 1): cn(i, j, 2) = cc(i, j, 2)
Next j
Next i
For i = 1 To r
If k <= m Then
If cn(i, k, 1) <> "0" Then
If Left$(cc(i, k, 1), 1) = "-" Then
cn(i, r + 1, 1) = Mid$(cc(i, k, 1), 2)
Else
cn(i, r + 1, 1) = "-" + cc(i, k, 1)
End If
If cn(i, r + 1, 1) = "-0" Then cn(i, r + 1, 1) = "0"
End If
If cn(i, k, 2) <> "0" Then
If Left$(cc(i, k, 2), 1) = "-" Then
cn(i, r + 1, 2) = Mid$(cc(i, k, 2), 2)
Else
cn(i, r + 1, 2) = "-" + cc(i, k, 2)
End If
If cn(i, r + 1, 2) = "-0" Then cn(i, r + 1, 2) = "0"
End If
Else
cn(i, r + 1, 1) = cc(i, k, 1): cn(i, r + 1, 2) = cc(i, k, 2)
End If
Next i
' – – – – – – – – – – – – – – – – – – – – Resolución
For i = r To 1 Step -1
xx(i, 1) = cn(i, r + 1, 1): xx(i, 2) = cn(i, r + 1, 2)
For j = r To i + 1 Step -1
rr() = MultNCDG(cn(i, j, 1), cn(i, j, 2), xx(j, 1), xx(j, 2))
zz() = ResNCDG(xx(i, 1), xx(i, 2), rr(1), rr(2))
xx(i, 1) = zz(1): xx(i, 2) = zz(2)
Next j
rr() = DivNCDG(xx(i, 1), xx(i, 2), cn(i, i, 1), cn(i, i, 2), pr)
xx(i, 1) = rr(1): xx(i, 2) = rr(2)
Next i
For i = 1 To m: tn(i) = t(i): Next i
For i = 1 To m – 1
For j = i + 1 To m
If tn(i) > tn(j) Then
yi = tn(i): tn(i) = tn(j): tn(j) = yi
yi = xx(i, 1): xx(i, 1) = xx(j, 1): xx(j, 1) = yi
yi = xx(i, 2): xx(i, 2) = xx(j, 2): xx(j, 2) = yi
End If
Next j
Next i
If k < m + 1 Then
For j = 1 To m
sp(k – r, j, 1) = xx(j, 1): sp(k – r, j, 2) = xx(j, 2)
Next j
End If
Next k
' – – – – – – – – – – – – – – – – – – – Edición de los resultados
sol = "": i = 0: j = 0
If r < m Then
sol = sol + "El sistema es compatible indeterminado." + rc
sol = sol + "Grado de indeterminación: " + Str$(m – r) + rc + rc
sol = sol + "Un sistema fundamental de soluciones" + rc + "del sistema omogeneo:" + rc + rc
For j = 1 To m – r
sol = sol + "Solución nº:" + Str$(j) + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + RutinaEdicionComplejos(sp(j, i, 1), sp(j, i, 2))
Next i
If j < m – r Then sol = sol + rc
Next j
sol = sol + rc
sol = sol + rc + "Solución particular del sistema:" + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + RutinaEdicionComplejos(xx(i, 1), xx(i, 2))
Next i
Else
sol = sol + "El sistema es compatible determinado." + rc
sol = sol + "Solución del sistema:" + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + RutinaEdicionComplejos(xx(i, 1), xx(i, 2))
Next i
End If
res(1) = sol ' res(1) contiene la Solución del sistema.
res(2) = VerSistemaC(cc(), t()) ' res(2) contien el sistema reducido.
MGSCEG3 = res()
End Function
' – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function CSDSEC2(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 = UBound(c(), 2) – 1
For i = 1 To p
ReDim t(p): caracter = ""
For j = 1 To q + 1
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 + 1
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
CSDSEC2 = c()
End Function
' – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function RutinaEdicionComplejos(ByVal z1 As String, ByVal z2 As String) As String
Dim s As String, rc As String
rc = Chr$(13) + Chr$(10)
If z1 <> "0" And z2 <> "0" Then
s = s + z1
If Left$(z2, 1) = "-" Then
If z2 = "-1" Then
s = s + "- i" + rc
Else
s = s + " – " + Mid$(z2, 2) + " i" + rc
End If
Else
If z2 = "1" Then
s = s + "+ i" + rc
Else
s = s + " + " + z2 + " i" + rc
End If
End If
End If
If z1 = "0" And z2 <> "0" Then
If Left$(z2, 1) = "-" Then
If z2 = "-1" Then
s = s + "- i" + rc
Else
s = s + " – " + Mid$(z2, 2) + " i" + rc
End If
Else
If z2 = "1" Then
s = s + "+ i" + rc
Else
s = s + " + " + z2 + " i" + rc
End If
End If
End If
If z1 <> "0" And z2 = "0" Then
s = s + z1 + rc
End If
If z1 = "0" And z2 = "0" Then
s = s + "0" + rc
End If
RutinaEdicionComplejos = s
End Function
' – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function VerSistemaC(ByRef c() As String, ByRef t() As Integer) 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, t(j), 1) <> "0" And c(i, t(j), 2) <> "0" Then
If t(j) = 1 Then
sist = sist + "( "
Else
sist = sist + " + ( "
End If
pr = c(i, t(j), 1): pi = c(i, t(j), 2)
r = FormatoComplejo(pr, pi)
sist = sist + r + " ) "
End If
If c(i, t(j), 1) <> "0" And c(i, t(j), 2) = "0" Then
If Left$(c(i, t(j), 1), 1) = "-" Then
If c(i, t(j), 1) <> "-1" Then
pr = c(i, t(j), 1): pi = c(i, t(j), 2)
r = FormatoComplejo(pr, pi)
sist = sist + r
Else
sist = sist + " – "
End If
Else
If t(j) <> 1 Then sist = sist + " + "
If c(i, t(j), 1) <> "1" Then
pr = c(i, t(j), 1): pi = c(i, t(j), 2)
r = FormatoComplejo(pr, pi)
sist = sist + r
Else
sist = sist + " i "
End If
End If
End If
If c(i, t(j), 2) <> "0" And c(i, t(j), 1) = "0" Then
If Left$(c(i, t(j), 2), 1) = "-" Then
If c(i, t(j), 2) <> "-1" Then
pr = c(i, t(j), 1): pi = c(i, t(j), 2)
r = FormatoComplejo(pr, pi)
sist = sist + r
Else
sist = sist + " -i "
End If
Else
If c(i, t(j), 2) <> "1" Then
pr = c(i, t(j), 1): pi = c(i, t(j), 2)
r = FormatoComplejo(pr, pi)
If t(j) <> 1 Then sist = sist + " + "
sist = sist + r
Else
sist = sist + " +i "
End If
End If
End If
If c(i, t(j), 1) = "0" And c(i, t(j), 2) = "0" Then
If j = 1 Then sist = sist + " 0" Else sist = sist + " + 0"
End If
sist = sist + " " + p(t(j))
Next j
pr = c(i, m + 1, 1): pi = c(i, m + 1, 2)
r = FormatoComplejo(pr, pi)
sist = sist + " = " + r + rc
VerSistemaC = sist
Next i
VerSistemaC = 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
Observación 3.1: Las operaciones utilizadas en esta función ya se han expuesto después de la función MGSCEG2.
En un módulo, tiene que ser presente también el código necesario para los enteros y decimales extra-largos (Ver en [5] y [6].
Ejemplo 3.1:
Ejemplo 3.2:
Ejemplo 3.3:Considerando el sistema
Ejemplo 3.4: Considerando el sistema
Puesto que la última ecuación del sistema (3.9) es imposible, el sistema es incompatible.
Ejemplo 3.4: Dado el sistema
Observación 3.2 Si los coeficientes de un sistema no se pueden introducir de manera exacta en el ordenador, el sistema inicial y el introducido ya no serán equivalentes y por tanto el sistema reducido del sistema introducido tampoco será equivalente con el sistema inicial. Los resultados obtenidos son siempre ciertos para el sistema introducido pero podría no ser así para el sistema inicial.. En caso de los sistemas de tipo Cramer, si el sistema introducido difiere muy poco del sistema inicial, el sistema reducido será también de tipo Cramer y la solución del sistema introducido podría ser una buena aproximación de la solución del sistema inicial.
Propiedades del módulo de un número complejo
Definición 4.1:
Propiedades del módulo de un número complejo:
, y así, según (1) la propiedad 5) queda demostrado.
6)
Según el lema 4.3, la propiedad 6) queda demostrada.
Error absoluto y relativo de un número complejo
Definición 5.1:
Definición 5.2:
Definición 5.4:
Observación 5.1: El error absoluto y relativo de un número real es un caso particular del error absoluto y relativo de un número complejo, respectivamente.
Error absoluto de la suma y de la diferencia
Teorema 6.1:
Teorema 6.2:
Error absoluto del producto o del cociente
Lema 7.1:
Teorema: 7.1:
Error relativo del producto y del cociente
Lema 8.1:
Teorema 8.1:
Error absoluto y relativo de una potencia
Teorema 9.1:
Teorema 9.2:
Teorema 9.3:
Resolución de sistemas lineales cualquiera
En este caso, junto a la matriz C de los coeficientes del sistema (cuyas columnas son los coeficientes de las incógnitas y los términos libres situados a la derecha del símbolo de igualdad de cada ecuación), se considerará también la matriz real E, relacionado con los errores absolutos de los elementos de C.
Aplicando el método de Gauss para la matriz C, para cada cambio en la matriz C corresponderá un cambio en la matriz E. Por ejemplo, al cambiar dos filas entre ellas en la matriz C, lo mismo hay que hacer en la matriz E. También, cuando de los elementos de una fila p se restan los elementos correspondientes de una fila q multiplicados por un número, los elementos de la fila p de la matriz E se cambiarán de manera oportuna. Por ejemplo, si en cierto momento del cálculo, la matriz C tiene la forma:
Para evaluar EO1, supongamos que el producto se alojó en la variable XP de precisión doble. El producto puede aparecer en punto fijo o en punto flotante. Si en punto fijo
Public Function ResSELCE(ByRef cc0() As Double, ByRef ei0() As Double) As Variant
'Método de Gauss para sistemas con coeficientes aproximados. Autor: Aladar Peter Santha.
Dim i As Integer, i0 As Integer, j As Integer, k As Integer, rc As String
Dim cc() As Double, e() As Double, y As Double, cn() As Double, sol As String
Dim r As Integer, sw As Integer, en As Double, j0 As Integer, nm As String
Dim ep As Double, eo1 As Double, eo2 As Double, eo3 As Double, xp() As Double
Dim x() As Double, res(3) As String, sp() As Double, sistema As String
Dim n As Integer, m As Integer, rr() As Double, ei() As Double, zz() As Double
Dim u As Double, v As Double, z1 As Double, z2 As Double, y1 As Double
Dim t() As Integer, tn() As Integer, kk As Integer, y2 As Double, xc() As Double
Dim k0 As Integer, yi As Integer
rc = Chr$(13) + Chr$(10): cc() = cc0()
n = UBound(cc(), 1): m = UBound(cc(), 2) – 1
ReDim e(n, m + 1), ei(n, m + 1), t(m), tn(m)
For i = 1 To n
For j = 1 To m + 1
ei(i, j) = nrm(ei0(i, j, 1), ei0(i, j, 2))
Next j
Next i
For i = 1 To m: t(i) = i: Next i
e() = ei()
res(3) = VerSistemaC1(cc0(), t()) ' res(3) = sistema inicial
If n < m Then nm = n Else nm = m
' – – – – – – Obtención del sistema reducido (método de Gauss)
For j = 1 To nm
'— Sustitución de un elemeto nulo cc(j,j) por uno no nulo
If cc(j, j, 1) = 0 And cc(j, j, 2) = 0 Then
k0 = j: i0 = j
If n >= m Then
For i = j To m
For k = j To n
If cc(k, i, 1) <> 0 Or cc(k, i, 2) <> 0 Then
k0 = k: i0 = i
sw = 1: Exit For
End If
Next k
If sw = 1 Then sw = 0
Exit For
Next i
Else
For k = j To n
For i = j To m
If cc(k, i, 1) <> 0 Or cc(k, i, 2) <> 0 Then
k0 = k: i0 = i
sw = 1: Exit For
End If
Next i
If sw = 1 Then sw = 0
Exit For
Next k
End If
If k0 <> j Then
For i = 1 To m + 1
y = cc(j, i, 1): cc(j, i, 1) = cc(k0, i, 1): cc(k0, i, 1) = y
y = cc(j, i, 2): cc(j, i, 2) = cc(k0, i, 2): cc(k0, i, 2) = y
y = e(j, i): e(j, i) = e(k, i): e(k, i) = y
Next i
End If
If i0 <> j Then
For i = 1 To n
y = cc(i, j, 1): cc(i, j, 1) = cc(i, i0, 1): cc(i, i0, 1) = y
y = cc(i, j, 2): cc(i, j, 2) = cc(i, i0, 2): cc(i, i0, 2) = y
y = e(i, j): e(i, j) = e(i, i0): e(i, i0) = y
Next i
yi = t(j): t(j) = t(i0): t(i0) = yi
End If
End If
If cc(j, j, 1) <> 0 Or cc(j, j, 2) <> 0 Then
For i = j + 1 To n
For k = j + 1 To m + 1
xp() = MultNC(cc(i, j, 1), cc(i, j, 2), cc(j, k, 1), cc(j, k, 2))
u = RutinaError(xp(1)): v = RutinaError(xp(2)): eo1 = nrm(u, v) '''''''
If xp(1) <> 0 Or xp(2) <> 0 Then
xc() = DivNC(xp(1), xp(2), cc(j, j, 1), cc(j, j, 2))
u = RutinaError(xc(1)): v = RutinaError(xc(2)): eo2 = nrm(u, v) '''''''
zz() = ResNC(cc(i, k, 1), cc(i, k, 2), xc(1), xc(2))
cc(i, k, 1) = zz(1): cc(i, k, 2) = zz(2)
u = RutinaError(zz(1)): v = RutinaError(zz(2)): eo3 = nrm(u, v) ''''''''''
ep = nrm(cc(i, j, 1), cc(i, j, 2)) * e(j, k) + nrm(cc(j, k, 1), cc(j, k, 2)) * e(i, j) + eo1
en = nrm(xp(1), xp(2)) * e(j, j) + nrm(cc(j, j, 1), cc(j, j, 2)) * ep
u = nrm(cc(j, j, 1), cc(j, j, 2))
e(i, k) = e(i, k) + en / (u * u) + eo2 + eo3
If nrm(cc(i, k, 1), cc(i, k, 2)) <= e(i, k) Then
cc(i, k, 1) = 0: cc(i, k, 2) = 0
End If
End If
Next k
cc(i, j, 1) = 0: cc(i, j, 2) = 0
Next i
End If
Next j
' – – – – El rango de la matriz del sistema
For i = n To 1 Step -1
For j0 = 1 To m
If cc(i, j0, 1) <> 0 Or cc(i, j0, 2) <> 0 Then
r = i: sw = 1: Exit For
End If
Next j0
If sw = 1 Then Exit For
Next i
' – – – – – – – Compatibilidad
For i = r + 1 To n
If cc(i, m + 1, 1) <> 0 Or cc(i, m + 1, 2) <> 0 Then
res(1) = "El sistema es incompatible"
res(2) = VerSistemaC1(cc(), t())
ResSELCE = res()
Form2.Command21.Enabled = True
Exit Function
End If
Next i
'- – – – – – – – – Resolución del sistema reducido
ReDim sp(m – r + 1, m, 2), cn(r, r + 1, 2), x(m, 2)
For k = r + 1 To m + 1
If k < m + 1 Then
For kk = r + 1 To m
If kk = k Then
x(kk, 1) = 1: x(kk, 2) = 0
Else
x(kk, 1) = 0: x(kk, 2) = 0
End If
Next kk
Else
For kk = r + 1 To m: x(kk, 1) = 0: x(kk, 2) = 0: Next kk
End If
For i = 1 To r
For j = 1 To r
cn(i, j, 1) = cc(i, j, 1): cn(i, j, 2) = cc(i, j, 2)
Next j
Next i
For i = 1 To r
If k <= m Then
zz() = MultNC(cc(i, k, 1), cc(i, k, 2), -1, 0)
cn(i, r + 1, 1) = zz(1): cn(i, r + 1, 2) = zz(2)
Else
cn(i, r + 1, 1) = cc(i, k, 1): cn(i, r + 1, 2) = cc(i, k, 2)
End If
Next i
' – – – – – – – – – – – – –
For i = r To 1 Step -1
x(i, 1) = cn(i, r + 1, 1): x(i, 2) = cn(i, r + 1, 2)
For j = r To i + 1 Step -1
zz() = MultNC(cn(i, j, 1), cn(i, j, 2), x(j, 1), x(j, 2))
rr() = ResNC(x(i, 1), x(i, 2), zz(1), zz(2))
x(i, 1) = rr(1): x(i, 2) = rr(2)
Next j
rr() = DivNC(x(i, 1), x(i, 2), cn(i, i, 1), cn(i, i, 2))
x(i, 1) = rr(1): x(i, 2) = rr(2)
Next i
For i = 1 To m: tn(i) = t(i): Next i
For i = 1 To m – 1
For j = i + 1 To m
If tn(i) > tn(j) Then
yi = tn(i): tn(i) = tn(j): tn(j) = yi
yi = x(i, 1): x(i, 1) = x(j, 1): x(j, 1) = yi
yi = x(i, 2): x(i, 2) = x(j, 2): x(j, 2) = yi
End If
Next j
Next i
If k < m + 1 Then
For j = 1 To m
sp(k – r, j, 1) = x(j, 1): sp(k – r, j, 2) = x(j, 2)
Next j
End If
Next k
'- – – – – – – – – – Edición de los resultados
sol = "": i = 0: j = 0
If r < m Then
sol = sol + "El sistema es compatible indeterminado." + rc
sol = sol + "Grado de indeterminación: " + Str$(m – r) + rc + rc
sol = sol + "Un sistema fundamental de soluciones" + rc + "del sistema omogeneo:" + rc + rc
For j = 1 To m – r
sol = sol + "Solución nº:" + Str$(j) + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + Format$(sp(j, i, 1), "###0.###########0")
If sp(j, i, 2) >= 0 Then sol = sol + "+"
sol = sol + Format$(sp(j, i, 2), "###0.###########0") + " i" + rc
Next i
Next j
sol = sol + rc
sol = sol + "Solución particular del sistema:" + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + Format$(x(i, 1), "###0.###########0")
If x(i, 2) >= 0 Then sol = sol + "+"
sol = sol + Format$(x(i, 2), "###0.###########0") + " i" + rc
Next i
Else
sol = sol + "El sistema es compatible determinado." + rc
sol = sol + "Solución del sistema:" + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + Format$(x(i, 1), "###0.###########0")
If x(i, 2) >= 0 Then sol = sol + "+"
sol = sol + Format$(x(i, 2), "###0.###########0") + " i" + rc
Next i
End If
res(1) = sol ' res(1)= Solución del sistema.
res(2) = VerSistemaC1(cc(), t()) ' res(2) = sistema reducido
ResSELCE = res()
End Function
' – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function VerSistemaC1(ByRef c() As Double, t() As Integer) As String
Dim sist As String, n As Integer, m As Integer, i As Integer, j As Integer, r As String
Dim pr As Double, pi As Double, 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, t(j), 1) <> 0 And c(i, t(j), 2) <> 0 Then
If j = 1 Then
sist = sist + "( "
Else
sist = sist + " + ( "
End If
pr = c(i, t(j), 1): pi = c(i, t(j), 2)
r = FormatoComplejo(pr, pi)
sist = sist + r + " ) "
End If
If c(i, t(j), 1) <> 0 And c(i, t(j), 2) = 0 Then
If c(i, t(j), 1) < 0 Then
If c(i, t(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, t(j), 1) > 0 Then
If c(i, t(j), 1) <> 1 Then
pr = c(i, j, 1): pi = c(i, j, 2)
r = FormatoComplejo(pr, pi)
If t(j) <> 1 Then sist = sist + " + "
sist = sist + r
Else
If t(j) <> 1 Then sist = sist + " + "
End If
End If
End If
If c(i, t(j), 2) <> 0 And c(i, t(j), 1) = 0 Then
If c(i, t(j), 2) < 0 Then
If c(i, t(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, t(j), 2) > 0 Then
If c(i, t(j), 2) <> 1 Then
pr = c(i, t(j), 1): pi = c(i, t(j), 2)
r = FormatoComplejo(pr, pi)
If t(j) <> 1 Then sist = sist + " + "
sist = sist + r
Else
If t(j) <> 1 Then sist = sist + " +i "
End If
End If
End If
If c(i, t(j), 1) = 0 And c(i, t(j), 2) = 0 Then
If j = 1 Then sist = sist + "0 " Else sist = sist + " + 0"
End If
sist = sist + " " + p(t(j))
Next j
pr = c(i, m + 1, 1): pi = c(i, m + 1, 2)
r = FormatoComplejo(pr, pi)
sist = sist + " = " + r + rc
VerSistemaC1 = sist
Next i
VerSistemaC1 = sist
End Function
' – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – – –
Public Function RutinaError(xpc As Double) As Double
Dim p As String, pia As String, xpa As String, eo As Double
Dim pi As Integer, pd As Double
Dim t As Integer
If xpc <> 0 Then
xpa = Str$(xpc)
p = Right$(xpa, 4): pia = Left$(p, 1)
If pia = "E" Then
eo = 0.000000000000001 * Val("1" + p)
Else
pi = Int(Log(Abs(xpc)) * Log(10)) + 1
If pi <= 0 Then
eo = 1E-16
Else
pd = 16 – pi – 1: eo = 1
For t = 1 To pd
eo = eo / 10
Next t
End If
End If
Else
eo = 0
End If
RutinaError = eo
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 nrm(ByVal x As Double, ByVal y As Double) As Double
nrm = Sqr(x * x + y * y)
End Function
Ejemplo 10.1: Dado el sistema
Trabajando con pivotes, hay que utilizar el código siguiente:
Public Function ResSELCP(ByRef cc0() As Double, ei0() As Double) As Variant
'Método de Gauss y de los pivotes. Autor:Aladar Peter Santha
Dim i As Integer, i0 As Integer, j As Integer, k As Integer, k0 As Integer, kk As Integer
Dim cc() As Double, e() As Double, y As Double, yi As Integer, y1 As Double, y0 As Double
Dim cn() As Double, r As Integer, sw As Integer, en As Double, j0 As Integer, nm As String
Dim ep As Double, eo As Double, xp() As Double, xc() As Double, sol As String, rc As String
Dim x() As Double, res(3) As String, sp() As Double, sistema As String, z1 As Double, z2 As Double
Dim n As Integer, m As Integer, swp As Integer, rr() As Double, zz() As Double
Dim u As Double, v As Double, t() As Integer, ei() As Double, tn() As Integer
Dim eo1 As Double, eo2 As Double, eo3 As Double, y2 As Double
rc = Chr$(13) + Chr$(10): cc() = cc0()
n = UBound(cc(), 1): m = UBound(cc(), 2) – 1
ReDim e(n, m + 1), ei(n, m + 1), t(m), tn(m), t0(m)
For i = 1 To n
For j = 1 To m + 1
ei(i, j) = nrm(ei0(i, j, 1), ei0(i, j, 2))
Next j
Next i
e() = ei()
If n < m Then nm = n Else nm = m
For i = 1 To m: t(i) = i: Next i
res(3) = VerSistemaC1(cc0(), t()) ' Sistema inicial
'— Elección del los pivotes
For j = 1 To nm
y0 = nrm(cc(j, j, 1), cc(j, j, 2)): k0 = j: i0 = j
If n <= m Then
For k = j To n
For i = j To m
y1 = nrm(cc(k, i, 1), cc(k, i, 2))
If y0 < y1 Then
y0 = y1: k0 = k: i0 = i
End If
Next i
Next k
Else
For i = j To m
For k = j To n
y1 = nrm(cc(k, i, 1), cc(k, i, 2))
If y0 < y1 Then
y0 = y1: k0 = k: i0 = i
End If
Next k
Next i
End If
If k0 <> j Then
For i = j To m + 1
z1 = cc(j, i, 1): z2 = cc(j, i, 2)
cc(j, i, 1) = cc(k0, i, 1): cc(j, i, 2) = cc(k0, i, 2)
cc(k0, i, 1) = z1: cc(k0, i, 2) = z2
y = e(j, i): e(j, i) = e(k0, i): e(k0, i) = y
Next i
End If
If i0 <> j Then
For i = 1 To n
z1 = cc(i, j, 1): z2 = cc(i, j, 2)
cc(i, j, 1) = cc(i, i0, 1): cc(i, j, 2) = cc(i, i0, 2)
cc(i, i0, 1) = z1: cc(i, i0, 2) = z2
y = e(i, j): e(i, j) = e(i, i0): e(i, i0) = y
Next i
yi = t(j): t(j) = t(i0): t(i0) = yi
End If
' – – – – – – – -Obtención del sistema reducido (método de Gauss)
If cc(j, j, 1) <> 0 Or cc(j, j, 2) <> 0 Then
For i = j + 1 To n
For k = j + 1 To m + 1
xp() = MultNC(cc(i, j, 1), cc(i, j, 2), cc(j, k, 1), cc(j, k, 2))
u = RutinaError(xp(1)): v = RutinaError(xp(2)): eo1 = nrm(u, v)
If xp(1) <> 0 Or xp(2) <> 0 Then
xc() = DivNC(xp(1), xp(2), cc(j, j, 1), cc(j, j, 2))
u = RutinaError(xc(1)): v = RutinaError(xc(2)): eo2 = nrm(u, v)
zz() = ResNC(cc(i, k, 1), cc(i, k, 2), xc(1), xc(2))
cc(i, k, 1) = zz(1): cc(i, k, 2) = zz(2)
u = RutinaError(zz(1)): v = RutinaError(zz(2)): eo3 = nrm(u, v)
ep = nrm(cc(i, j, 1), cc(i, j, 2)) * e(j, k) + nrm(cc(j, k, 1), cc(j, k, 2)) * e(i, j) + eo1
en = nrm(xp(1), xp(2)) * e(j, j) + nrm(cc(j, j, 1), cc(j, j, 2)) * ep
u = nrm(cc(j, j, 1), cc(j, j, 2))
e(i, k) = e(i, k) + en / (u * u) + eo2 + eo3
If nrm(cc(i, k, 1), cc(i, k, 2)) <= e(i, k) Then
cc(i, k, 1) = 0: cc(i, k, 2) = 0
End If
End If
Next k
cc(i, j, 1) = 0: cc(i, j, 2) = 0
Next i
End If
Next j
' – – – – – – – – – – – – – – Rango de la matriz del sistema
For i = n To 1 Step -1
For j0 = 1 To m
If cc(i, j0, 1) <> 0 Or cc(i, j0, 2) <> 0 Then
r = i: sw = 1: Exit For
End If
Next j0
If sw = 1 Then Exit For
Next i
' – – – – – – -Compatibilidad del sistema
For i = r + 1 To n
If cc(i, m + 1, 1) <> 0 Or cc(i, m + 1, 2) <> 0 Then
res(1) = "El sistema es incompatible."
res(2) = VerSistemaC1(cc(), t())
Form2.Command21.Enabled = True
ResSELCP = res()
Exit Function
End If
Next i
' – – – – – – – – Resolucion del sistema reducido compatible.
ReDim sp(m – r + 1, m, 2), cn(r, r + 1, 2), x(m, 2)
For k = r + 1 To m + 1
If k < m + 1 Then
For kk = r + 1 To m
If kk = k Then
x(kk, 1) = 1: x(kk, 2) = 0
Else
x(kk, 1) = 0: x(kk, 2) = 0
End If
Next kk
Else
For kk = r + 1 To m: x(kk, 1) = 0: x(kk, 2) = 0: Next kk
End If
For i = 1 To r
For j = 1 To r
cn(i, j, 1) = cc(i, j, 1): cn(i, j, 2) = cc(i, j, 2)
Next j
Next i
For i = 1 To r
If k <= m Then
zz() = MultNC(cc(i, k, 1), cc(i, k, 2), -1, 0)
cn(i, r + 1, 1) = zz(1): cn(i, r + 1, 2) = zz(2)
Else
cn(i, r + 1, 1) = cc(i, k, 1): cn(i, r + 1, 2) = cc(i, k, 2)
End If
Next i
For i = r To 1 Step -1
x(i, 1) = cn(i, r + 1, 1): x(i, 2) = cn(i, r + 1, 2)
For j = r To i + 1 Step -1
zz() = MultNC(cn(i, j, 1), cn(i, j, 2), x(j, 1), x(j, 2))
rr() = ResNC(x(i, 1), x(i, 2), zz(1), zz(2))
x(i, 1) = rr(1): x(i, 2) = rr(2)
Next j
rr() = DivNC(x(i, 1), x(i, 2), cn(i, i, 1), cn(i, i, 2))
x(i, 1) = rr(1): x(i, 2) = rr(2)
Next i
For i = 1 To m: tn(i) = t(i): Next i
For i = 1 To m – 1
For j = i + 1 To m
If tn(i) > tn(j) Then
yi = tn(i): tn(i) = tn(j): tn(j) = yi
y1 = x(i, 1): x(i, 1) = x(j, 1): x(j, 1) = y1
y2 = x(i, 2): x(i, 2) = x(j, 2): x(j, 2) = y2
End If
Next j
Next i
For j = 1 To m
sp(k – r, j, 1) = x(j, 1): sp(k – r, j, 2) = x(j, 2)
Next j
Next k
'- – – – – – – – – – Edición de los resultados
sol = "": i = 0: j = 0
If r < m Then
sol = sol + "El sistema es compatible indeterminado." + rc
sol = sol + "Grado de indeterminación: " + Str$(m – r) + rc + rc
sol = sol + "Un sistema fundamental de soluciones" + rc + "del sistema omogeneo:" + rc + rc
For j = 1 To m – r
sol = sol + "Solución nº:" + Str$(j) + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + Format$(sp(j, i, 1), "###0.###########0")
If sp(j, i, 2) >= 0 Then sol = sol + "+"
sol = sol + Format$(sp(j, i, 2), "###0.###########0") + " i" + rc
Next i
Next j
sol = sol + rc
sol = sol + "Solución particular del sistema:" + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + Format$(x(i, 1), "###0.###########0")
If x(i, 2) >= 0 Then sol = sol + "+"
sol = sol + Format$(x(i, 2), "###0.###########0") + " i" + rc
Next i
Else
sol = sol + "El sistema es compatible determinado." + rc
sol = sol + "Solución del sistema:" + rc
For i = 1 To m
sol = sol + "x (" + Str$(i) + ") = "
sol = sol + Format$(x(i, 1), "###0.###########0")
If x(i, 2) >= 0 Then sol = sol + "+"
sol = sol + Format$(x(i, 2), "###0.###########0") + " i" + rc
Next i
End If
res(1) = sol
res(2) = VerSistemaC1(cc(), t()) ' Sistema reducido
ResSELCP = res()
End Function
La función ResSELCP tiene que estar acompañada de todo el código expuesto después de la función función ResSELCE.
Resolviendo el sistema (10.1) utilizando la función ResSELCP se obtiene el resultado
Se observa que la diferencia entre las soluciones (10.1) y (10.2) obtenidas para el mismo sistema (10.1) son mínimas. Incluso si se consideran que los coeficientes del sistema tienen el mismo error absoluto 0.00000005, solo aparecerán cambios en las últimas cifras del resultado.
Ejemplo 10.2: Para no complicar la escritura, se considera el sistema simple siguiente:
En general, para la seguridad de los cálculos, a los elementos del sistema y a los elementos de la matriz de los errores hay que introducir con la precisión conveniente, tal como exige la validez de las fórmulas de los párrafos 5 a 9.
Utilizando la función ResSELCE se obtiene que el sistema es compatible indeterminado de grado 1 y que sus soluciones son:
Public Function RutinaCoeficientes(t0 As String) As Variant
Dim t3 As String, nco As Integer, i As Integer, j As Integer, k As Integer
Dim i0 As Integer, px() As String, p00() As String
t3 = t0
'—- Número de las comas en la cadena t0
If Right$(t3, 1) <> "," Then t3 = t3 + ","
k = 1: lt = Len(t3): nco = 0
Do
bbb = Right$(Left$(t3, k), 1)
If bbb = "," Then
nco = nco + 1
End If
k = k + 1
If k > lt Then Exit Do
Loop
If nco <= 1 Then
MsgBox "Tiene que haber más que un coeficiente", 48
Exit Function
End If
gp = nco – 1
'— Separación de los coeficientes
ReDim px(gp + 1), p00(gp + 1)
k = 1: i = 1: i0 = 1: j = 0
Do
bbb = Right$(Left$(t3, k), 1)
If bbb = "," Then
j = j + 1
p00(i0) = Left$(t3, k – 1): px(i0) = Val(p00(i0))
' En el caso de matriz alfanumerico, ) px(i0) = p00(i0)
i = i + 1: i0 = i0 + 1
t3 = Mid$(t3, k + 1)
k = 1
Else
k = k + 1
End If
If j = nco Then Exit Do
Loop
RutinaCoeficientes = px()
End Function
[0] B. DÉMIDOVITCH y MARON, ÉLÉMENTS DE CALCUL NUMERIQUE,
EDITION MIR, MOSCOU. 1973
[1] A.?.K?P?? KYPC B???E? ??????, ?????, MOCKBA, 1968.
[2] E. ARGHIRIADE CURS DE ALGEBRA SUPERIOARA, I-II, Editura Didactica si
Pedagogica, Bucuresti, 1963.
[3] L.I Golovina Algebra Lineal y Algunas de sus aplicaciones, Editorial Mir, Moscú, 1980.
[4] F.R. Gantmacher, MATRIZENRECHNUNG, I – II, Berlin 1965.
[5] Aladar Peter Santha, Cálculos con números enteros largos, en ordenadores,
Monografias.com, 31/01/2012.
[6] Aladar Peter Santha, Cálculos con números decimales largos, en ordenadores,
Monografias.com, 23/05/2012
[7] Aladar Peter Santha, Resolución de los sistemas de ecuaciones lineales reales por el
método de Gauss, edu.red, 22/02/ 2016. Actualizado.
[8] Aladar Peter Santha Divisibilidad en semigrupos y anillos, Monografías.com
Autor:
Aladar Peter Santha
| Página siguiente |