1 REM Ins{nd av Guido Petz <1098>    1987-03-30 15.53.06 (SEND)
10 REM Guido Petz 08/193523 (1098)
20 REM ABC802 och BASICII-KORTET 1986
30 REM Programmet ber{knar ett polynoms reella och komplexa nollst{llen
40 REM vidare evalueras polynomet f|r reella och komplexa argument
50 REM Bairstow's metod
60 FLOAT : WIDTH 80 : OPEN 'v24:vsa29c72.1' AS FILE 1 : ; CHR$(12)
70 ; 'Polynom!' : ; STRING$(8,45) : IF PEEK(-226)=4% F=.000001 ELSE F=1.E-14
80 RANDOMIZE : B=10 : C=5 : INPUT 'Grad: 'N% : IF INT(N%/2%)*2%<>N% S%=-1%
90 DIM A(1%,N%),B(N%),S(N%) : N1%=N% : ; 'Test med slumptal(j)'; : GET F$ : ;
100 IF F$='j' 150
110 FOR I%=N% TO 0% STEP -1%
120   ON ERROR GOTO 130 : ; 'A' I%; : INPUT A$ : A=VAL(A$) : GOTO 140
130   IF LEN(A$)<>0% 120 ELSE A=0
140 A(0%,N%-I%)=A : NEXT I% : GOTO 180
150 ; 'Koefficienter:'; : A(0%,N%)=INT(RND*B)+1 : A(0%,0%)=1 : ; 1 ' ';
160 FOR I%=1% TO N%-1% : A=RND-.5
170 A=INT(A*B) : A(0%,I%)=A : ; A ' '; : NEXT I% : ; A(0%,N%)
180 FOR I%=0% TO N% : A(1%,I%)=A(0%,I%) : NEXT I% : ; 'Evaluera(j)'; : GET F$
190 ; : IF F$<>'j' 220
200 ON ERROR GOTO 220 : ; 'X='; : INPUT X : ; 'Y='; : INPUT Y : R=FNE(X,Y)
210 GOTO 200
220 POKE -14,0,0,0 : GOTO 280
230 ; CHR$(12) CUR(10,35) N% : I0%=0% : E=1 : WHILE E>F AND I0%<1000%
240 R=FNA : I0%=I0%+1% : WEND : D%=1% : D1%=N% : N%=N1%
250 E=1 : I1%=0% : WHILE E>F AND I1%<10% : R=FNA : I1%=I1%+1% : WEND
260 N%=D1% : D%=0% : R=FNA : A(0%,N%)=P : A(0%,N%-1%)=S : N%=N%-2%
270 FOR I%=1% TO N% : A(0%,I%)=B(I%) : NEXT I%
280 IF N%>2% 230 ELSE IF N%=2% 300
290 A(0%,1%)=-A(0%,1%)/A(0%,0%) : GOTO 310
300 A(0%,1%)=-A(0%,1%)/A(0%,0%) : A(0%,2%)=A(0%,2%)/A(0%,0%)
310 ; CHR$(12) : A$='Tid:'+RIGHT$(TIME$,12)
320 ; #P% : ; #P% 'Koefficienter:'; : FOR I%=0% TO N1% : ; #P% A(1%,I%);
330 NEXT I% : ; #P%
340 ; #P% : ; #P% TAB(30) 'Nollst[llen!' : ; #P% TAB(30) STRING$(12,45)
350 ; #P% TAB(7) 'X' TAB(21) '+/-' TAB(35) 'iY' TAB(56) 'P(X+I*Y)'
360 ; #P% STRING$(72,45) : IF S% D%=2% ELSE D%=1%
370 R%=FNV%(D%,N1%,P%) : IF S% X=A(0%,1%) : Y=0 : ; #P% X;TAB(52); : DIGITS 3
380 R=FNE(X,Y) : DIGITS 17
390 ; #P% A$ : ; 'Visa igen(n)'; : GET F$ : ; : P%=0% : IF F$<>'n' 320
400 ; 'Printer(j)'; : GET F$ : ; : IF F$='j' P%=1% : GOTO 320
410 END
420 DEF FNV%(D2%,N2%,P1%)
430   FOR I%=D2% TO N2% STEP 2% : S=A(0%,I%) : P=A(0%,I%+1%) : R=FNQ(S,P)
440   NEXT I% : RETURN 0
450 FNEND
460 DEF FNA
470   I3%=0% : I2%=0% : WHILE (I2%<50% AND D%=0%) OR (I3%<5% AND D%=1%)
480     ON ERROR GOTO 570 : B(0%)=A(D%,0%) : B(1%)=A(D%,1%)+S*B(0%)
490     B(2%)=A(D%,2%)+S*B(1%)-P*B(0%)
500     S(0%)=0 : S(1%)=B(0%) : S(2%)=B(1%)+S*S(1%) : FOR K%=3% TO N%
510       B(K%)=A(D%,K%)+S*B(K%-1%)-P*B(K%-2%)
520     S(K%)=B(K%-1%)+S*S(K%-1%)-P*S(K%-2%) : NEXT K%
530     D=S(N%)*S(N%-2%)-S(N%-1%)^2% : IF D=0 D=.01
540     D1=(B(N%-1%)*S(N%-1%)-B(N%)*S(N%-2%))/D
550     D2=(B(N%-1%)*S(N%)-B(N%)*S(N%-1%))/D : S1=S+D1 : P1=P+D2
560     E=(ABS(S1-S)+ABS(P1-P))/(ABS(S1)+ABS(P1)) : S=S1 : P=P1 : GOTO 600
570     IF D%=0% S=(RND-.5)*C : P=(RND-.5)*C : I2%=I2%+1% : GOTO 590
580     D1=D1/2 : S=S-D1 : D2=D2/2 : P=P-D2 : I3%=I3%+1%
590   WEND
600   RETURN 0
610 FNEND
620 DEF FNQ(S,P)
630   T=S*S-4*P : IF T<0 THEN 680
640   X=.5*(S+SQR(T)) : Y=0 : ; #P% X;TAB(52); : DIGITS 3 : R=FNE(X,Y)
650   DIGITS 17
660   X=X-SQR(T) : ; #P% X;TAB(52); : DIGITS 3 : R=FNE(X,Y) : DIGITS 17
670   GOTO 700
680   X=S/2 : Y=SQR(-T)/2 : ; #P% X;TAB(26) Y;TAB(52); : DIGITS 3 : R=FNE(X,Y)
690   DIGITS 17
700   RETURN 0
710 FNEND
720 DEF FNE(X,Y)
730   P=-2*X : Q=X*X+Y*Y : A1=A(1%,0%) : A2=A(1%,1%)-A1*P
740   FOR J%=2% TO N1%-1%
750     ON ERROR GOTO 770 : A3=A(1%,J%)-A2*P-A1*Q : A1=A2 : A2=A3
760     A3=A(1%,N1%)-A1*Q : R=A2*X+A3 : I=A2*Y : GOTO 780
770     ; #P% 'OVERFLOW!!' : GOTO 800
780   NEXT J%
790   ; #P% R;I
800   RETURN 0
810 FNEND