********************************************************************************
*
*   \         (c) Thomas Antoni, 23.12.2005 
*    \ /\           Mailto:thomas@antonis.de
*    ( )            Downloaded from www.antonis.de --- www.qbasic.de   
*  .( o ).
*                        ----==== Hottest QBasic Stuff on Earth !!! ====----
*
********************************************************************************

********************************************************************************
*
* .----------------.
* | ENGLISH  INFO  |  (Deutsche Info: Siehe unten)
* '----------------'
*
* Download File  : POLYMNUL.BAS = Calculates the roots of a polynominal using
*                                 the Lin-Bairstow method
*                  ==========================================================
* Prog. Language : QBasic, QuickBasic
* Author         : Thomas Antoni
*   - E-Mail     : thomas@antonis.de
*   - Website    : www.qbasic.de , www.antonis.de
*
********************************************************************************

*** Short Description
POLYMNUL.BAS solves all real and complex roots of a polynomial with real 
coeffients. The Lin-Bairstow method is used. The solution is returned using the 
RealRoot#() and ImagRoot#() arrays. The first stores the real components of the 
roots. The second the imaginary parts. When the subroutine finds a real root, it 
stores zero in the corresponding imaginary part. Thus, the application program 
should test each member of the ImagRoot#() array to determine whether or not the 
obtained root is real or complex. An n-th order polynominal has n roots which 
are stored into the array elements RealRoot#(1...n) and ImagRoot#(1...n).

The solution may be hampered by high accuracy requirements and supplying 
coefficients of an unstable polynominal. If the programm freezes, try other 
initial guesses of ALFA1# and BETA1#.



*** Rating
++    (in a range of + to +++)


********************************************************************************
*
* .---------------.
* | DEUTSCHE INFO |
* '---------------'
*
* Download-Datei: POLYMNUL.BAS = Berechnet die Nullstellen eines Polynoms nach
*                 dem Lin-Bairstow-Verfahrenh
*                 =============================================================
* Progr.sprache : QBasic, QuickBasic
* Autor         : Thomas Antoni
*   - E-Mail    : thomas@antonis.de
*   - Webseite  : www.qbasic.de , www.antonis.de
*
********************************************************************************

Kurzbeschreibung
================================================================================
Dieses Q(uick)Basic-Programm berechnet alle reellen und komplexen
Nullstellen einer ganzrationalen Funktion, die als Polynom dargestellt
wird. Das Programm verwendet das Lin-Bairstow-Nherungsverfahren.


Bewertung
================================================================================
++   (in einer Skala von + bis +++)


Ausfhrliche Beschreibung
================================================================================
(Aus meinem Beitrag in der QB-MonsterFAQ auf www.qbasic.de)

*** Was ist ein Polynom?
--------------------------------------------
Ein Polynom ist eine spezielle Darstellung einer ganzrationalen Funktion.
Ein Polynom n-ter Ordnung hat die allgemeine Form

y = a_n*x^n + a_n-1*x^(n-1) ... + a_1*x + + a_0

Dabei sind die Konstanten a_n ... a_0 die so genannten Koeffizienten
des Polynoms.

Beispiel fr ein Polynom 2. Ordung:

y = x^2 - 5x + 6

Die Koeffizienten dieses Polynoms sind
a2 = 1   (Koeffizent 2. Ordnung)
a1 = -5  (Koeffizent erster Ordnung)
a0 = 6   (Koeffizent nullter Ordnung)

Das Polynom 2. Ordnung ist identisch mit der Quadratischen Gleichung (siehe den
Eintrag "Wie lse ich die Quadratische Gleichung mit der "Mitternachtsformel?"


*** Was sind die Nullstellen eines Polynoms?
-----------------------------------------------
Nullstellen sind x-Werte, bei denen der Funktionswert y des Polynoms den Wert 
Null annimmt. Ein Polynom n-ter Ordnung hat immer n Nullstellen. Die Nullstellen 
knnen reelle oder (konjugiert) komplexe Zahlen sein (siehe unter "Was sind 
Komplexe Zahlen und wie rechne ich damit?"). Die reellen Nullstellen eines 
Polynoms sind Schnittpunkte oder Berhrpunkte des Funktionsgraphen mit der x-
Achse.

Ein Polynom kann auch mehrfache Nullstellen x_0 haben. Dies ist der Fall, wenn 
sich das Polynom durch ein Produkt der Form

y = f(x) = (x - x_0)^k * g(x)   ;k>1

darstellen lsst, wobei g(x) wiederum ein Polynom ist. Wenn k eine gerade Zahl 
ist, berhrt der Funktionsgraph bei x_0 die Gerade und es gibt dort keinen 
Vorzeichenwechsel. Ist k ungerade, so gibt es bei x_0 einen Vorzeichenwechsel und 
die x-Achse stellt dort eine Tangente an den Graphen dar.


Das obenstehende Polynom hat die Nullstellen x_01 = 2 und x_02 = 3. Wie Du 
leicht durch Einsetzen dieser x-Werte in die Polynomgleichung berprfen kannst, 
Ergibt sich hierfr jeweils der Funktionswert y = 0. Bei solchen einfachen 
Polynomen, wie sie im Schulunterricht oft vorkommen, kommt man oft schon durch 
Ausprobieren zu der Lsung.



*** QBasic-Programm fr ganzzahlige Nullstellen
------------------------------------------------
Wenn alle Koeffizienten des Polynoms ganzzahlig sind und weiterhin bekannt ist, 
dass auch alle Nullstellen ganze Zahlen sind, kann man sie einfach ganz primitiv 
durch Ausprobieren ermitteln. Dazu setzt man alle ganzzahligen x-Werte vom 
kleinsten bis zum grten Koeffizienten in die Polynomgleichung ein und schaut 
nach, ob ihr Funktionswert "0" ergibt.
 
Bei der Berechnung der Nullstellen eines Polynoms muss man beachten, dass 
QBasic x^y intern als EXP(LOG(x) * y) rechnet.  

Jeder, der etwas von hherer Mathematik versteht, wird sofort erkennen knnen, 
dass die Berechnung der Potenz via Logarithmen ber Gleitpunktberechnungen 
numerisch Probleme gibt, so dass bei einem nominellen Ertgebnis von 50 Ergebnis-
Werte wie 48.99999 und 55.000001 bereits vorprogrammiert sind. Siehe dazu auch 
den Eintrag "Warum kommt es bei Gleitpunktoperationen zu Rundungsfehlern?"

Mein Tipp: Berechne ein Polynom 4. Grades der Form

y = a4*x^4 + a3*x^3 + a2*x^2 + a1*x + a0

am besten als

y = (((a4 * x + a3) * x + a2) * x + a1) * x + a0

was numerisch keine Genauigkeits- Probleme mehr geben sollte. Wie das im Prinzip 
geht, zeigt das folgende Programm:

'*************************************
' POLYNUL.BAS = Nullstellen eines
' ===========   Polynoms berechnen
'
' Es werden die Nullstellen des fol-
' genden Polynoms 4. Grades berechnet
' x^4-7*x^3+8*x^2+28*x-48 .
' Das Programm ist leicht fuer andere
' Polynome beliebiger Grades
' erweiterbar.
'
' (c) Andreas Meile 18.1.2004
'*************************************
DECLARE FUNCTION Poly! (x!, koeff!())
DIM pk!(4)
FOR i% = 4 TO 0 STEP -1
  READ pk!(i%)
NEXT i%
'Hier stehen die Koeffizenten
'a4, a3, a2, a1 und a0:
DATA 1!, -7!, 8!, 28!, -48!
'
FOR x! = -10! TO 48! STEP .5
  IF Poly!(x!, pk!()) = 0! THEN
    PRINT x!
  END IF
NEXT x!
'
FUNCTION Poly! (x!, koeff!())
  w! = 0!
  FOR i% = UBOUND(koeff!) TO LBOUND(koeff!) STEP -1
    w! = x! * w! + koeff!(i%)
  NEXT i%
  Poly! = w!
END FUNCTION

((POLYNUL.BAS bereits in /progs/neu))


*** Ergnzung von Xaero und MisterD
Das mit dem "primitiven Probieren" kann man noch weiter verbessern, indem man 
die Vorzeichen mit rein nimmt. Als erstes speichert man das Vorzeichen des 
ersten y-Wertes in dem Bereich, den man untersuchen mchte. Danach vergrssert 
man x und berechnet den neuen y-Wert. Anstatt diesen nun nur mit Null zu 
vergleichen testet man, ob das Vorzeichen gleich ist wie das Vorherige. Wenn 
beide gleich sind, ist zwischen den Punkten keine Nullstelle. Falls sie 
unterschiedlich sind, muss zwischen den beiden x-Werten eine Nullstelle liegen. 
Falls sie =Null ist, hat man sie genau getroffen. Das gute ist, dass man nicht 
nur die ganzzahligen Lsungen trifft. Wenn man weiss, dass zwischen zwei x-
Werten eine Nullstelle liegt, kann man diesen Bereich (ev. Rekursiv) nochmals 
untersuchen. Das einzige Problem ist, dass so die Nullstelle von y=x^2-0.000001 
nicht gefunden wird, da das Vorzeichen "zu schnell" wechselt

Eins ist dabei noch zu beachten: Wenn die Vorzeichen nicht wechseln kann es 
brigens auch eine Nullstelle geben. Bestes Beispiel dafr ist die 
Normalparabel. Sie wechselt nie das Vorzeichen und hat aber bei 0 eine 
Nullstelle da 0 ^ 2 = 0 ist.



*** Wie berechne ich die Nullstelleneines beliebigen Polynoms?
---------------------------------------------------------------
Die Nullstellen eines beliebigen Polynoms zu berechnen, kann sehr aufwndig 
werden und gehrt schon zur hheren Mathematik. Es gibt hierfr eine Reihe von 
Verfahren.

Die bekanntesten Verfahren zur Nullstellenberechnung sind:
- das Newtonsche Verfahren
- die Regula Falsi
- das Verfahren von Steffensen
- das Einschlussverfahren
- das Bisektionsverfahren
- das Pegasus-Verfahren
- das Verfahren von Andersen-Bjrk
- das Verfahren von King
- das Illinois-Verfahren

Fr alle diese Verfahren gibt es QuickBASIC-Programme, z.B. in dem sehr guten 
Buch "Formelsammlung zur Numerischen Mathematik mit QuickBASIC-Programmen" von 
G.Engeln-Mllges und F-Reutter (ISBN 3-411-14312-6).

Einen netten Online-Nullstellenrechner, der sich der Polynom-Divisions-Methode 
und der Newtonschen Methode bedient, findest Du unter

http://home.t-online.de/home/arndt.bruenner/mathe/scripts/polynome.htm .

Dort gibt es auch viele Interessante Infos zu Polynomen und deren 
Nullstellenberechnungen.


*** QBasic-Programm nach dem Verfahren von Lin-Bairstow
Ich will Euch nun hier ein QBasic- Beispielprogramm zur Berechnung der 
Nullstellen eines beliebigen Polynoms vorstellen, das ein weniger bekanntes 
Verfahren verwendet, und zwar das von Lin-Bairstow. 

Das Programm POLYMNUL basiert auf einer QBasic- Subroutine, die ich im Buch "The 
New BASICs" von Namir Clement Shammas fand. Die darin gefundenen Programmfehler 
habe ich bereinigt und einen kleinen Testrahmen drumherum gebaut.

Das Programm berechnet alle realen und komplexen Nullstellen eines Polynoms, 
dessen Koeffizienten reelle Zahlen sein muessen. Die Subroutine verwendet das 
Lin-Bairstow-Naeherungsverfahren.

Bei dem Nherungsverfahren von Lin-Bairstow werden in einer Iteration 
quadratische Faktoren x2 + alfa*x + beta des Polynoms gesucht und abgespaltet. 
Anschliessend kann man die Ordnung des Polynoms um zwei reduzieren. Diesen 
Algorithmus durchluft man so lange, bis das Restpolynom vom Grade 0 oder 1 ist.

Das Programm sucht in einer Iteration quadratische Faktoren x2 + alfa*x + beta 
des Polynoms und spaltet sie ab. Anschliessend kann man die Ordnung des Polynoms 
um zwei reduzieren. Diesen Algorithmus durchlaeuft das Programm so lange, bis 
das Restpolynom vom Grade 0 oder 1 ist.

Die Realteile der ermittelten Nullstellen werden im Feld RealRoot#() 
zurckgeliefert, die Imaginaerteile im Feld ImagRoot#(). Bei realen Nullstellen 
wird in ImagRoot#() eine Null eingetragen. Das aufrufende Programm sollte fuer 
jede Nullstelle das entsprechende Feldelement von ImagRoot#() abpruefen, um 
festzustellen, ob die Nullstelle reel oder komplex ist. Ein Polynom n-ter 
Ordnung hat n Nullstellen, die die Subroutine in die Feldelemente 
RealRoot#(1...n) und ImagRoot#(1...n) eintraegt.

Bei hohen Genauigkeitsanforderungen (kleiner Wert in Accuracy#) und bei 
"instabilen" Polynomen kann es zu extrem langen Rechenzeiten kommen. Wenn sich 
das Orogramm aufhaengen sollte, muss man andere Startwerte ("initial guesses") 
fuer ALFA1# und BETA1# verwenden. Das war bei meinen Tests aber nie 
erforderlich.

                                   Thomas Antoni
                                   

***********************************************************************************
***********************************************************************************
**
** Internet-Quellen zum Bairstow-Verfahren z.Berechnung der Polynom-Nullstellen
** ===============================================================================
** (Google-Suchbegriffe "Bairstow Polnomial (Q)Basic"
**
**  Gesammelt von Thomas Antoni, 28.2.2005
**
***********************************************************************************
***********************************************************************************
 
***********************************************************************************
* Von www.und.edu/instruct/uherka/bairstow.bas 
***********************************************************************************
(Programm  BAIRSTOW.BAS bereits in neu/PolymNul/Bairstow.bas)

10 REM           BAIRSTOW.BAS       (IN OLD BASIC , BY DJU)
REM      (Revised Sept. 1997 to work in QBASIC, DJU:  It still
REM      seems to work OK but should be modernized.)
20 REM   LIN-BAIRSTOW METHOD FOR FINDING POLYNOMIAL ROOTS.
30 REM   PLACE THE DEGREE (>=2) IN 1ST DATA STATEMENT BELOW.
40 REM   PLACE THE COEFFS IN 2ND DATA STATEMENT, HIGH DEG 1ST.
50 REM   YOU WILL NEED TO INPUT INITIAL R,S AND THE NUMBER
60 REM   OF ITERATIONS DURING EXECUTION.  WHEN ONE PAIR OF ROOTS
62 REM   IS FOUND, THE QUADRATIC X^2+RX+S IS DIVIDED OUT AND
64 REM   THE METHOD IS RESTARTED WITH THE DEFLATED POLYNOMIAL
66 REM   OF DEGREE 2 LESS.
70 REM   THE INITIAL GUESSES FOR R,S MAY BE HARD TO FIND.  JUST
80 REM   TRY A WILD GUESS.
90 REM
100 DATA 4
110 DATA 1,1,2,1,1
120 DIM A(11), B(11), C(11)
130 READ N
140 FOR I = 1 TO N + 1
150 READ A(I)
160 NEXT I
170 IF N = 2 THEN GOTO 410
180 PRINT "INITIAL R,S:"
190 INPUT R, S
200 PRINT "NO. OF ITERATIONS:"
210 INPUT M
220 IF M = 0 THEN GOTO 440
230 FOR I = 1 TO M
240 B(1) = A(1)
250 C(1) = B(1)
260 B(2) = A(2) - R * B(1)
270 C(2) = B(2) - R * C(1)
280 FOR K = 3 TO N + 1
290 B(K) = A(K) - R * B(K - 1) - S * B(K - 2)
300 C(K) = B(K) - R * C(K - 1) - S * C(K - 2)
310 NEXT K
320 D = C(N - 1) ^ 2 - C(N - 2) * (C(N) - B(N))
330 IF D <> 0 THEN GOTO 360
340 PRINT "D=0.  GIVE NEW R,S."
350 GOTO 170
360 R = R + (B(N) * C(N - 1) - B(N + 1) * C(N - 2)) / D
370 S = S + (B(N + 1) * C(N - 1) - B(N) * (C(N) - B(N))) / D
380 PRINT "R="; R, " S="; S
390 NEXT I
400 GOTO 200
410 R = A(2) / A(1)
420 S = A(3) / A(1)
430 PRINT "  LAST TWO ROOTS ARE"
440 D = R * R - 4 * S
450 P = -R / 2
460 Q = SQR(ABS(D)) / 2
470 IF D < 0 THEN PRINT "COMPLEX ROOTS ="; P; " +-"; Q; " * i"
480 IF D >= 0 THEN PRINT "REAL ROOTS ="; P + Q; "  AND  "; P - Q
490 PRINT
500 IF N = 2 THEN GOTO 590
510 FOR I = 1 TO N - 1
520 A(I) = B(I)
530 PRINT B(I);
540 NEXT I
550 PRINT "  = COEFFS OF QUOTIENT.  FIND MORE ROOTS."
560 N = N - 2
570 IF N > 1 THEN GOTO 170
580 PRINT "LAST ROOT ="; -A(2) / A(1)
590 END



***********************************************************************************
* Von http://smallbasic.sourceforge.net/scode/vsrc.php?show=95
***********************************************************************************
   
Bairstow

Author: Adolfo leon Sepulveda
E-Mail: adoleon2000@yahoo.com.mx

--------------------------------------------------------------------------------
ID #95
Version: 1.0
Date: Aug-01-2004
Require SB Version: 

Description:


This program will display the real and imaginary roots for a polynomial of the 
form f(x)=A0 + A1*x + A2*x^2 +... Spagetti code in 
http://www3.sympatico.ca/ltoms/html/bairstow_s_method.html modified Download  
Download the file: [BAS][BAS.GZ] 
 
Source Code  
'This program will display the real and imaginary roots for a polynomial
'of the form f(x)=A0 + A1*x + A2*x^2 +...
'spagetti code in http://www3.sympatico.ca/ltoms/html/bairstow_s_method.html
'modified by:
'Adolfo Leon Sepulveda
'Aug-01-2004
'Version 1.0

'Test case:

'real and imaginary roots of polynomials
'using bairstow's method
'form is y = A0 + A1*x + A2*x^2 + A3*x^3 +....

'degree of polynomial: 4

'coefficent of A(0)=  12
'coefficent of A(1)=  -19
'coefficent of A(2)=  12
'coefficent of A(3)=  -6
'coefficent of A(4)=  1

'Roots:

'0.5 + 1.6583124 i
'0.5 - 1.6583124 i

'4.0
'1.0

 
rem roots of polynomials - bairstow's method
cls
print
print "real and imaginary roots of polynomials"
print "using bairstow's method"
print "form is y = A0 + A1*x + A2*x^2 + A3*x^3 +...."
print

dim a(22)
Const err=.0001
Const cero=1e-19
Const iter=100

InputData a,n
print
print "Roots:"
Bairstow a,n,err,iter
End


sub InputData( ByRef a(), ByRef n)
local i,xa
input "degree of polynomial: ";n
print
for i=0 to n
 print "coefficent of A(";i;")= ";
 input " ";xa
 rem stored in array a in reverse order
 a(n-i+1)=xa
next i
end


Sub Bairstow(a,n,err,iter)
dim b(22)
dim e(22)
local p, q, p1, q1, r0, r1, v0, v1, s0, s1, d0, d1, d2, s, t
local m1, n1, k, i, h, j
local const cero = 1e-19

rem branch for special treatment of 1st and 2nd degree equations
if n<=2 then 
	OrderLessThan2 a, n
	Exit Sub
endif	
a(n+2)=0
n1=2*int((n+1)/2)
m1 = 1
While true
 If  m1 >= n1 / 2 Then 	Exit loop
 p=1
 q=1
 For k=1 to iter
  while true
   rem store coefficients in array b
    for i=1 to n1+1
     b(i)=a(i)
    next i
    for j=n1-2 to n1-4 step -2
     for i=1 to j+1
      b(i+1) = b(i+1) - p*b(i)
      b(i+2) = b(i+2) - q*b(i)
     next i
    next j
    r0 = b(n1+1)
    r1 = b(n1)
    s0 = b(n1-1)
    s1 = b(n1-2)
    v0 = -q*s1
    v1 = s0 - s1*p
    d0 = v1*s0 - v0*s1
    if abs(d0) >= cero then Exit loop
    p=p+5
    q=q+5
  wend
  
  d1 = s0*r1 - s1*r0
  d2 = r0*v1 - v0*r1
  p1=d1/d0
  q1=d2/d0
  p=p+p1
  q=q+q1
  if !(Abs(r0)>=err or abs(r1)>=err) then
    e(m1)=1
    Exit For
  endif  
  
  
  if !(abs(p1)>=err or abs(q1)>=err) then
    e(m1)=2
    Exit For
  endif  
  
  if p=0 then 
    if !(q=0) Then
     if !(abs(q1/q)>=err) Then
      e(m1)=3
      Exit For   
     endif  
    endif
  Else
    if !(abs(p1/p)>=err) Then 
  	  if !(q=0) Then
        if !(abs(q1/q)>=err) Then
         e(m1)=3
         Exit For 
        endif  
      endif
    endif	
  endif  
 Next k
 If k > iter Then
   e(m1) = 4  'Is Order 2
 endif  
 
 While true
   s = -p/2
   t = s^2 - q
   if !(t<0) then 
     t=Sqr(t)
     PrintReal s,t
   Else
     t=Sqr(-1*t)
     PrintImag s,t
   endif
 
   If e(m1) = 4 then Exit Sub
   for j=1 to n1-1
    a(j+1) = a(j+1) - p*a(j)
    a(j+2) = a(j+2) - q*a(j)
   next j
   n1 = n1 - 2
   if !(n1>1) Then Exit Sub
 
   if n1>3 then Exit loop
   
   m1 = m1 + 1
   e(m1)=1
   p=a(2)/a(1)
   q=a(3)/a(1)
 Wend
Wend 'm1

end


Sub OrderLessThan2(a(),n)
  If n = 2 Then
   Order2 a
  Else	
   print -a(2)/a(1)
  Endif 
End

sub order2(a())
local s,t
 a(3) = a(2)*a(2) - 4*a(1)*a(3)
 s = -a(2) / (2*a(1))
 t=Sqr(abs(a(3))) / (2*a(1))

 if sgn(a(3))<0 then 
   PrintImag s,t
 Else
   PrintReal s,t
 endif	
End


Sub PrintImag(s,t)
 Print
 If Abs(s) > cero
   print s;" + ";t;" i"
   print s;" - ";t;" i"
 Else
   Print 0;" + ";t;" i"
   print 0;" - ";t;" i"
endif  
End 


Sub PrintReal(s,t)
 print
 If Abs(s+t) > cero
    print s+t
 endif   
 If Abs(s-t) > cero
    print s-t
 endif   
End 

 
Hits: [138]
since 15 Jan 2001  Nicholas Christopoulos 
Created: 15 Jan 2001, Updated: 02/28/2005 18:54:03  


***************************************************************************
* von http://perso.wanadoo.fr/jean-pierre.moreau/Basic/bairstow_bas.txt
***************************************************************************



'*****************************************************
'*  Program to demonstrate the BAIRSTOW subroutine   *
'* ------------------------------------------------- *
'* Reference: BASIC Scientific Subroutines, Vol. II  *
'* by F.R. Ruckdeschel, BYTE/McGRAWW-HILL, 1981.     *
'* ------------------------------------------------- *
'* Example: Find two complex roots of polynomial:    *
'*            f(x) = x^5-10x^4+35x^3-50x^2+24x       *
'*                                                   *
'* SAMPLE RUN:                                       *
'*                                                   *
'* Input order of polynomial: 5                      *
'*                                                   *
'* Input the polynomial coefficients:                *
'*                                                   *
'*    A(0) = ? 0                                     *
'*    A(1) = ? 24                                    *
'*    A(2) = ? -50                                   *
'*    A(3) = ? 35                                    *
'*    A(4) = ? -10                                   *
'*    A(5) = ? 1                                     *
'*                                                   *
'* Convergence factor: 1e-8                          *
'* Maximum number of iterations: 20                  *
'*                                                   *
'* The roots found are:                              *
'*                                                   *
'*      X1 = 1                                       *
'*      Y1 = 0                                       *
'*                                                   *
'*      X2 = 0                                       *
'*      Y2 = 0                                       *
'*                                                   *
'* The number of iterations was: 15                  *
'*                                                   *
'*****************************************************
defint i-n
defdbl a-h,o-z
cls
dim A(10),B(10),C(10),D(10)
print
input " Order of polynomial: ", m
print
print " Input the polynomial coefficients:"
print
for i=0 to m
  print "     A(";i;") = "; : input A(i)
next
print
input " Convergence factor: ", e
input " Maximum number of iterations: ",n
aa=3.1415926535# : bb=SQR(2#)

gosub 1000   'Call BAIRSTOW subroutine

print
print " The roots found are:"
print
print "      X1 = "; x1
print "      Y1 = "; y1
print
print "      X2 = "; x2
print "      Y2 = "; y2
print
print " The number of iterations was: "; k
print
end

'**************************************************
'*       Bairstow complex root subroutine         *
'* ---------------------------------------------- *
'* This routine finds the complex conjugate roots *
'* of a polynomial having real coefficients.      *
'* ---------------------------------------------- *
'* Reference: Computer Methods for Science and    *
'*            Engineering by R.L. Lafara.         *
'* ---------------------------------------------- *
'* INPUTS:                                        *
'*  Polynomial coefficients      : A(0) to A(m)   *
'*  Order of polynomial (>=4)    : m              *
'*  Initial guess                : a and b        *
'*  Convergence factor           : e              *
'*  Maximum number of iterations : n              *
'* OUTPUTS:                                       *
'*  Two conjugate complex roots  : x1,y1  x2,y2   *
'*  Number of iterations         : k              *
'**************************************************
1000 'Normalize the A(i) series
  for i=0 to m
    C(i)=A(i)/A(m)
  next
  'Take initial estimates for aa and bb
  k=0 : B(m)=1#
  'Start iteration sequence
1100 B(m-1)=C(m-1)-aa
  for j=2 to m-1
    B(m-j)=C(m-j)-aa*B(m+1-j)-bb*B(m+2-j)
  next
  B(0)=C(0)-bb*B(2)
  D(m-1)=-1# : D(m-2)=-B(m-1)+aa
  for j=3 to m-1
    D(m-j)=-B(m+1-j)-aa*D(m+1-j)-bb*D(m+2-j)
  next
  D(0)=-bb*D(2)
  d2=-B(2)-bb*D(3)
  dd=D(1)*d2-D(0)*D(2)
  a1=-B(1)*d2+B(0)*D(2) : a1=a1/dd
  b1=-D(1)*B(0)+D(0)*B(1) : b1=b1/dd
  aa=aa+a1 : bb=bb+b1 : k=k+1
  'Test for the number of iterations
  if k>=n then goto 1200
  'Test for convergence
  if ABS(a1)+ABS(b1)>e*e then goto 1100
  'Extract roots from quadratic equation
1200 cc=aa*aa-4#*bb
  'Test to see if a complex root
  if cc>0 then goto 1300
  x1=-aa : x2=x1 : y1=SQR(-cc) : y2=-y1
  goto 1400
1300 x1=-aa+SQR(cc)
  x2=-aa-SQR(cc) : y1=0 : y2=y1
1400 x1=x1/2# : x2=x2/2# : y1=y1/2# : y2=y2/2#
return

'End of file Bairstow.bas
 

********************************************************************************
*  von http://www.ma.utexas.edu/CNA/NA/sample.html
*
********************************************************************************
c
c     Second Edition
c     Numerical Analysis:
c     The Mathematics of Scientific Computing
c     D.R. Kincaid & E.W. Cheney
c     Brooks/Cole Publ., 1996
c     ISBN 0-534-33892-5
c     COPYRIGHT (c) 1996
c
c     Section 3.5
c
c     Example of Bairstow's method
c     applied to a polynomial of degree n
c
c   
c     file: ex7s35.f
c
      parameter (n=4,m=10)
      double precision a(0:n),b(0:n),c(0:n),u,v,xj
      data (a(j),j=0,n)/-2.0,-5.0,7.0,-4.0,1.0/
      data u/3.0/
      data v/-4.0/
c
      print *
      print *,' Bairstow''s Method example'
      print *,' Section 3.5, Kincaid-Cheney'
      print *
      print 10
c
      b(n) = a(n)
      c(n) = 0.0
      c(n-1) = a(n)
c
      do 3 j=1,M
         b(n-1) = a(n-1) + u*b(n) 
c
         do 2 k=n-2,0,-1
            b(k) = a(k) + u*b(k+1) + v*b(k+2)
            c(k) = b(k+1) + u*c(k+1) + v*c(k+2)
 2       continue  
c
         xj = c(0)*c(2) - c(1)**2 
         u = u+(c(1)*b(1) - c(2)*b(0))/xj
         v = v + (c(1)*b(0) - c(0)*b(1))/xj
         print 11,j,u,v,b(0),b(1)
 3    continue
c
 10   format(1x,'n',12x,'u',23x,'v',17x,'b(0)',11x,'b(1)')
 11   format(i2,1x,2(d22.15,2x),2(e13.6,2x))
      stop
      end


********************************************************************************
* von http://www.students.uwosh.edu/~piehld88/na_ex2.htm
********************************************************************************
Numerical Analysis Problem #2 (QBasic program from Feb. 1993) 


' Assignment #1  Problem # 2
'
'  This program attempts to find the value of R and S for an expression
'  in the form :  X^2 - R*X -S which is a factor of the given 4th
'  degree polynomial:
'                      X^4 + 2*X^3 - 7*X^2 + 3 .
'
'Bairstow's Method will be used to refine a guess for the values of R
'and S, and the coefficients of the remaining quotient terms will be
'displayed.  Various initial guesses will be attempted to illustrate
'the different program outputs that may result.

PRINT
N = 4             '4th degree polynomial
A(3) = 1          'Coefficients of initial polynomial
A(4) = 2
A(5) = -7
A(6) = 0
A(7) = 3
B(1) = 0: B(2) = 0: C(1) = 0: C(2) = 0      'Causes unnecessary terms to be disregarded
INPUT "Enter initial guess (R,S) :"; R, S   'Prompt user for initial guess
PRINT
DR = 100: DS = 100                          'Makes certain to fail tolerances
Tolerance = .000001                         'Set tolerance
PRINT "   R            S          delta-R        delta-S" 'Heading
DO WHILE ABS(DR) >= Tolerance OR ABS(DS) >= Tolerance     'Continue if tolerance not satisfied
Retry:   FOR I = 3 TO N + 3                               'Loop thru subscripts
            B(I) = A(I) + R * B(I - 1) + S * B(I - 2)     'Set the B's
            C(I) = B(I) + R * C(I - 1) + S * C(I - 2)     'Set the C's
         NEXT I
         PRINT USING " ###.####### "; R; S; DR; DS            'Print Values
         Denominator = C(N + 1) * C(N + 1) - C(N + 2) * C(N)  'Calculate Denom.of Remainder
         IF Denominator = 0 THEN                              'Compare to zero
            R = R + 1                                         'Increment R
            S = S + 1                                         'Increment S
            GOTO Retry                            'Retry with the new guess
         END IF
        
         'Calculate delta-R & delta-S
         DR = (B(N + 3) * C(N) - B(N + 2) * C(N + 1)) / Denominator
         DS = (C(N + 2) * B(N + 2) - C(N + 1) * B(N + 3)) / Denominator
        
         R = R + DR    'Effect changes
         S = S + DS
LOOP                   'Continue the tolerance loop
PRINT
PRINT "One quadratic factor is ";    'Display a quadratic factor
PRINT "X^2 + "; -R; " X + "; -S
PRINT
PRINT "The remaining factor has coefficients:";  'Display what's left-over
FOR I = 3 TO 5
   PRINT USING " ##.###### "; B(I);
NEXT I
END

*****  Program output (run #1):

Enter initial guess (R,S) :? 0,0

   R            S          delta-R        delta-S
   0.0000000    0.0000000  100.0000000  100.0000000 
   0.1224490    0.4285714    0.1224490    0.4285714 
   0.1705088    0.4877028    0.0480599    0.0591313 
   0.1732498    0.4890449    0.0027410    0.0013422 
   0.1732538    0.4890428    0.0000040   -0.0000022 

One quadratic factor is X^2 + -.1732538  X + -.4890428 

The remaining factor has coefficients:  1.000000   2.173254  -6.134433 

*****  Program output (run #2):

Enter initial guess (R,S) :? 1,1

   R            S          delta-R        delta-S
   1.0000000    1.0000000  100.0000000  100.0000000 

One quadratic factor is X^2 + -1  X + -1 

The remaining factor has coefficients:  1.000000   3.000000  -3.000000 

***** Program output (run #3):

Enter initial guess (R,S) :? 2,2

   R            S          delta-R        delta-S
   2.0000000    2.0000000  100.0000000  100.0000000 
   2.2253520   -0.9718311    0.2253521   -2.9718311 
   2.4284804   -1.2954395    0.2031282   -0.3236085 
   2.4091680   -1.2795196   -0.0193123    0.0159200 
   2.4093218   -1.2803308    0.0001538   -0.0008112 

One quadratic factor is X^2 + -2.409322  X +  1.280331 

The remaining factor has coefficients:  1.000000   4.409322   2.343144 


Summary :

This polynomial can be factored into quadratic factors in several ways.
The second run of the program indicates integer value for the coefficients
and therefore will provide the easiest route:
X^4 + 2*X^3 - 7*X^2 + 3 = ( X^2 - X - 1 )( X^2 + 3*X -3 )

The quadratic formula can be used to factor into:
( X-(1+sqr 5)/2 )( X-(1-sqr 5)/2 )( X+(3+sqr 21)/2 )( X+(3+sqr 21)/2 )

Because real quadratic polynomial factors can be formed in 3 different ways,
the program output showing several possibilities is explained.
This will generally occur in all 4th degree polynomials with all real roots.

--------------------------------------------------------------------------------
Return to Dan's Home Page
Last Update: September 3, 2003

