El algoritmo de Ruffini (Horner) y su generalización para ordenadores (página 2)

Partes: 1, 2

) > 0 Then
cd = cd + " + " + f1(Mid$(Str$(z2(i)), 2)) + " e"

4
3
2
25

End If
End If
Else
If z2(i) = 1 Then
cd = cd + " + e"
Else
cd = cd + " – e"
End If
End If
End If
Else
If z1(i) > 0 Then
cd = cd + " + " + f1(Mid$(Str$(z1(i)), 2))
Else
If z1(i) < 0 Then
cd = cd + " – " + f1(Mid$(Str$(z1(i)), 2))
End If
End If
If Abs(z2(i)) 1 Then
If z2(i) > 0 Then
cd = cd + " + " + f1(Mid$(Str$(z2(i)), 2)) + " e"
Else
If z2(i) < 0 Then
cd = cd + " – " + f1(Mid$(Str$(z2(i)), 2)) + " e"
End If
End If
Else
If z2(i) = 1 Then
cd = cd + " + e"
Else
cd = cd + " – e"
End If
End If
End If
Else
If Abs(z1(i)) 0 Then
If Abs(z1(i)) 1 Then
If z1(i) < 0 Then
cd = cd + " – " + f1(Mid$(Str$(z1(i)), 2))
Else
cd = cd + " + " + f1(Mid$(Str$(z1(i)), 2))
End If
Else
If z1(i) = 1 Then
cd = cd + " + "
Else
cd = cd + " – "
End If
End If
End If
End If
If gx > 1 Then
If i < gx – 1 Then
cd = cd + " X^" + Mid$(Str$(gx – i), 2)
Else
If i = gx – 1 Then
cd = cd + " X "
End If
End If
End If
cm = cm + cd: cd = ""
End If
End If
Next i
FPolD = cm
End Function

Ejemplo12 : Si
A X
4 7 X 5
3 4 X 3
1 5 X 2
3 X
5 7
y P X
X 2
2 9 X
3 4
, entonces
Q X
4 7 X 3
8 50 X 2
25 181 X
75 700 y R X
225 2521 X
230 1793
Ejemplo13 : Si A X
3 4 X
5 2 X
5 X
y P X
4 X
8 3 X 12 5

26

, entonces
Q X
0.75 0.25 X 2
0.25 1.5625 X 1.75 1.625
y R X
12 12.25 X
21 11.75
Se sabe que los ceros enteros de un polinomio real se encuentran entre los divisores del
término libre. Luego, el numerador de un cero fraccionario es divisor del término libre y
el denominador es divisor del coeficiente director. El código necesario para calcular los
ceros enteros y fraccionarios de un polinomio real se basa también en la regla de
Ruffini y es la siguiente:

Public Function CERuf(ByRef p0() As Double) As String
Dim i As Integer, res As String, rc As String, gp0 As Integer
Dim gp As Integer, cr() As Double, j As Integer, p() As Double
Dim Era As Double, c As Double, c0 As Double, pc0 As Double
rc = Chr$(13) + Chr$(10)
gp0 = UBound(p0())
If p0(gp0) = 0 Then
res = "0, ": i = 1
Do
If p0(gp0 – i) = 0 Then
i=i+1
Else
Exit Do
End If
Loop
gp = gp0 – i
ReDim p(gp)
For j = 0 To gp: p(j) = p0(j): Next j
Else
p() = p0(): gp = gp0
End If
cr() = CotasCerosPR2(p())
If p(gp) = 0 Then res = "0, "
For i = Int(cr(2) – 1) To Int(cr(1) + 1)
If i 0 Then
c = p(gp) / i
If c = Int(c) Then
c = ValPolR(p(), i)
If c = 0 Then
res = res + Str$(i) + " , "
End If
End If
End If
Next i
For j = 2 To Abs(p(0))
c0 = p(0) / j
If c0 = Int(c0) Then
For i = Int(cr(2) – 1) To Int(cr(1) + 1)
If i 0 Then
c0 = p(gp) / i
If c0 = Int(c0) Then
If MaxComDiv2(i, j) = 1 Then
c0 = i / j
pc0 = ValPolR(p(), c0)
Era = Errpa(p(), c0)
If pc0 = 0 Or Abs(pc0) < Era Then
res = res + Str$(i) + "/" + Str$(j) + " , "
End If
End If
End If
End If
Next i
End If
Next j
If Right$(res, 2) = ", " Then res = Left$(res, Len(res) – 2)
If res = "" Then res = " ¡No hay ceros enteros ni racionales!"
CERuf = res
End Function
‘ ————————————————-
Public Function Errpa(ByRef p() As Double, ByVal a As Double) As Double
Dim i As Integer, er As Double, ie As Double, gx As Integer
Dim pd() As Double, epa As Double, rr As Double

27

gx = UBound(p()): ie = 0.000000000000001
ReDim pd(gx – 1), ed(gx – 1)
' – – – – – Polinomio derivado
For i = 0 To gx – 1: pd(i) = p(i) * (gx – i): Next i
' – – – – – Valor absoluto de los coeficientes de pd()
For i = 0 To gx – 1: pd(i) = Abs(p(i)): Next i
' – – – – – Cota superior del error absoluto de pa
er = ValPolR(pd(), Abs(a))
Errpa = er * ie
End Function
‘ ————————————————-
Public Function MaxComDiv2(ByVal a As Long, ByVal b As Long) As Long
Dim ax As Long, bx As Long, x As Long, qx As Long, rx As Long
ax = Abs(a): bx = Abs(b)
If ax < bx Then
x = ax: ax = bx: bx = x
End If
Do
rx = ax Mod bx
If rx = 0 Then Exit Do
ax = bx: bx = rx
Loop
MaxComDiv2 = bx
End Function
‘ ————————————————
Public Function CotasCerosPR2(ByRef p() As Double) As Variant
' MÉTODO ÁNÓNIMO
Dim a As Double, b As Double, gp As Integer, x(2) As Double
gp = UBound(p())
a = Abs(p(1))
For i = 2 To gp
If Abs(p(i)) > a Then
a = Abs(p(i))
End If
Next i
b = Abs(p(0))
For i = 1 To gp – 1
If Abs(p(i)) > b Then
b = Abs(p(i))
End If
Next i
x(1) = 1 + a / Abs(p(0)): x(2) = -x(1)
' x(1) Cota superior ceros positivos
' x(2) Cota inferior ceros negativos
x(1) = (Int(x(1) * 100) + 1) / 100
x(2) = (Int(x(2) * 100) – 1) / 100
If x(2) < 0 Then x(2) = 0
CotasCerosPR2 = x()
End Function

Ejemplo 14: Si se considera el polinomio
P X
24 X 5
54 X 4
5 X 3 135 X 2 119 X
21
, el código anterior devuelve en la variable res los ceros enteros y fraccionarios
siguientes: -3, 1/2 y 1/4.
Para calcular los ceros (que son enteros de Gauss) de un polinomio cuyos coeficientes
son enteros de Gauss se puede utilizar el código siguiente:

Public Function CEGRuf(ByRef p10() As Double, ByRef p20() As Double) As String
Dim i As Long, j As Long, res As String, rc As String, gp0 As Integer
Dim gp As Integer, cr() As Double, c0 As Double, c As Double, mo As Double
Dim a(2) As Double, val() As Double, cc(2) As Double, p1() As Double, p2() As Double
rc = Chr$(13) + Chr$(10): gp0 = UBound(p10())
If p10(gp0) = 0 And p20(gp0) = 0 Then
res = "0, ": i = 1
Do
If p10(gp0 – i) = 0 And p20(gp0 – i) = 0 Then
i=i+1
Else
Exit Do
End If
Loop

28
gp = gp0 – i
ReDim p(gp)
For j = 0 To gp: p1(j) = p10(j): p2(j) = p20(j): Next j
Else
p1() = p10(): p2() = p20(): gp = gp0
End If
cr() = CotasCerosPC2(p1(), p2())
cc(1) = Int(cr(1)) + 1
cc(2) = Int(cr(2) – 1)
If cc(2) < 0 Then cc(2) = 0
For i = -cc(1) To cc(1)
For j = -cc(1) To cc(1)
a(1) = i: a(2) = j
mo = Sqr(a(1) * a(1) + a(2) * a(2))
If mo < cc(1) And mo > cc(2) Then
val = ValPolC(p1(), p2(), a())
If val(1) = 0 And val(2) = 0 Then
res = res + FormatoNumeroComplejo(a(1), a(2)) + " , "
End If
End If
Next j
Next i
If Right$(res, 2) = ", " Then res = Left$(res, Len(res) – 2)
If res = "" Then res = "No hay ceros que sean enteros de Gauss"
CEGRuf = res
End Function
‘ ————————————————-
Public Function ValPolC(ByRef p1() As Double, ByRef p2() As Double, ByRef a() As Double) As Variant
Dim i As Integer, gx As Integer, coci As String, r As String, rc As String
Dim q() As Double, x() As Double, rt() As Double, ra As String, resto(2) As Double
gx = UBound(p1()): rc = Chr$(13) + Chr$(10)
ReDim q(gx, 2), x(2)
q(0, 1) = p1(0): q(0, 2) = p2(0)
For i = 1 To gx
x(1) = q(i – 1, 1): x(2) = q(i – 1, 2)
rt() = ProdNC(x(), a())
q(i, 1) = rt(1) + p1(i): q(i, 2) = rt(2) + p2(i)
Next i
ReDim q1(gx – 1), q2(gx – 1)
For i = 0 To gx – 1
q1(i) = q(i, 1): q2(i) = q(i, 2)
Next i
resto(1) = q(gx, 1): resto(2) = q(gx, 2)
ValPolC = resto()
End Function
‘ ————————————————-
Public Function CotasCerosPC2(ByRef p1() As Double, p2() As Double) As Variant
' TRANSFORMACIONES DEL POLINOMIO
Dim i As Integer, z As Integer, e As Integer, gq As Integer
Dim a As Double, b As Double, r(2) As Double, md() As Double
gp = UBound(p1())
ReDim md(gp) As Double
For i = 0 To gp
md(i) = Sqr(p1(i) * p1(i) + p2(i) * p2(i))
Next i
' Método Anónimo
' r(1) cota superior de los módulos de lo ceros
' r(2) cota inferior de los módulos de los ceros
'For i = 0 To gp
a = md(1)
For i = 2 To gp
If md(i) > a Then a = md(i)
Next i
b = md(0)
For i = 1 To gp – 1
If md(i) > b Then b = md(i)
Next i
r(1) = 1 + a / md(0)
r(2) = md(gp) / (b + md(gp))
r(1) = (Int(r(1) * 100) + 1) / 100
r(2) = (Int(r(2) * 100) – 1) / 100
If r(2) < 0 Then r(2) = 0
CotasCerosPC2 = r()
End Function
‘ ————————————————-
Public Function ProdNC(ByRef x() As Double, ByRef a() As Double) As Variant

29

Dim pr() As Double
ReDim pr(2)
pr(1) = x(1) * a(1) – x(2) * a(2)
pr(2) = x(1) * a(2) + a(1) * x(2)
ProdNC = pr()
End Function

Ejemplo 15: Dado el polinomio
P Z Z 4
1 8i Z 3
16, 7i Z 2
1 8i Z 17 7i
Según el código anterior resulta que sus ceros enteros de Gauss son: i –i, -1-5i y 2-3i.

En el caso de los polinomios con coeficientes duales enteros la búsqueda de los ceros enteros
duales se hace de la misma manera que la búsqueda de los ceros enteros de Gauss de los
polinomios con coeficientes enteros de Gauss y el código para estos cálculos es muy parecido:

Public Function CEDRuf(ByRef p10() As Double, ByRef p20() As Double, Radio As Double) As String
Dim i As Long, j As Long, res As String, rc As String, gp0 As Integer, r As Integer
Dim gp As Integer, cr() As Double, c0 As Double, c As Double, mo As Double
Dim a(2) As Double, val() As Double, cc(2) As Double, p1() As Double, p2() As Double
rc = Chr$(13) + Chr$(10): gp0 = UBound(p10())
r = Abs(Radio): r = Int(r)
If p10(gp0) = 0 And p20(gp0) = 0 Then
res = "0, ": i = 1
Do
If p10(gp0 – i) = 0 And p20(gp0 – i) = 0 Then
i=i+1
Else
Exit Do
End If
Loop
gp = gp0 – i
ReDim p(gp)
For j = 0 To gp: p1(j) = p10(j): p2(j) = p20(j): Next j
Else
p1() = p10(): p2() = p20(): gp = gp0
End If
For i = -r To r
For j = -r To r
a(1) = i: a(2) = j
mo = Sqr(a(1) * a(1) + a(2) * a(2))
If mo < Radio Then
val() = ValPolD(p1(), p2(), a())
If val(1) = 0 And val(2) = 0 Then
res = res + FormatoNumeroDual(a(1), a(2)) + " , "
End If
End If
Next j
Next i
If Right$(res, 2) = ", " Then res = Left$(res, Len(res) – 2)
If res = "" Then
res = "No hay ceros que sean enteros duales de módulo