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

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