Monografias.com > Sin categoría
Descargar Imprimir Comentar Ver trabajos relacionados

Resolución de los sistemas de ecuaciones lineales complejos con ordenadores (página 2)




Enviado por Aladar Peter Santha



Partes: 1, 2

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:

Monografias.com

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]).

Monografias.com

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:

Monografias.com

Ejemplo 3.2:

Monografias.com

Ejemplo 3.3:Considerando el sistema

Monografias.com

Ejemplo 3.4: Considerando el sistema

Monografias.com

Puesto que la última ecuación del sistema (3.9) es imposible, el sistema es incompatible.

Ejemplo 3.4: Dado el sistema

Monografias.com

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:

Monografias.com

Propiedades del módulo de un número complejo:

Monografias.com

, y así, según (1) la propiedad 5) queda demostrado.

6)

Monografias.com

Según el lema 4.3, la propiedad 6) queda demostrada.

Error absoluto y relativo de un número complejo

Monografias.com

Definición 5.1:

Monografias.com

Definición 5.2:

Monografias.com

Definición 5.4:

Monografias.com

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.

Monografias.com

Error absoluto de la suma y de la diferencia

Teorema 6.1:

Monografias.com

Teorema 6.2:

Monografias.com

Error absoluto del producto o del cociente

Lema 7.1:

Monografias.com

Teorema: 7.1:

Monografias.com

Error relativo del producto y del cociente

Lema 8.1:

Monografias.com

Teorema 8.1:

Monografias.com

Error absoluto y relativo de una potencia

Teorema 9.1:

Monografias.com

Teorema 9.2:

Monografias.com

Teorema 9.3:

Monografias.com

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.

Monografias.com

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

Bibliografía

[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, Monografias.com, 22/02/ 2016. Actualizado.

[8] Aladar Peter Santha Divisibilidad en semigrupos y anillos, Monografías.com

 

 

Autor:

Aladar Peter Santha

 

Partes: 1, 2
 Página anterior Volver al principio del trabajoPágina siguiente 

Nota al lector: es posible que esta página no contenga todos los componentes del trabajo original (pies de página, avanzadas formulas matemáticas, esquemas o tablas complejas, etc.). Recuerde que para ver el trabajo en su versión original completa, puede descargarlo desde el menú superior.

Todos los documentos disponibles en este sitio expresan los puntos de vista de sus respectivos autores y no de Monografias.com. El objetivo de Monografias.com es poner el conocimiento a disposición de toda su comunidad. Queda bajo la responsabilidad de cada lector el eventual uso que se le de a esta información. Asimismo, es obligatoria la cita del autor del contenido y de Monografias.com como fuentes de información.

Categorias
Newsletter