'***************************************************** '* This program calculates R(x) = P(Q(x)), * '* P(x), Q(x) and R(x) being polynomials. * '* ------------------------------------------------- * '* Ref.: "Mathematiques en Turbo-Pascal By M. Ducamp * '* and A. Reverchon (vol 2), Eyrolles, Paris, 1988" * '* [BIBLI 05]. * '* ------------------------------------------------- * '* SAMPLE RUN: * '* * '* SUBSTITUTION OF TWO POLYNOMIALS: * '* * '* P(x) = -5x2 +3 * '* Q(x) = 2x3 -x +5 * '* * '* * '* - 20 X6 + 20 X4 - 100 X3 - 5 X2 + 50 X - 122 * '* * '* * '* SUBSTITUTION OF TWO POLYNOMIALS: * '* * '* P(x) = x4 * '* Q(x) = 2x2 -3 * '* * '* * '* 16 X8 - 96 X6 + 216 X4 - 216 X2 + 81 * '* * '* * '* BASIC version by J-P Moreau. * '* (www.jpmoreau.fr) * '***************************************************** defdbl a-h,o-z defint i-n MAXINT = 32767 'Maximum integer number MAXPOL = 20 'Maximum degree for a polynomial SMALL = 1e-20 'small real number ' number zz (real, integer or fractional) ' isrzz=1: zz is real (double precision) ' isrzz=0: zz is integer or fractional ' zzv: value of zz if real ' ipzz: integer value of zz if integer (or numerator value if fractional) ' iqzz: denominator value if fractional (=1 if integer) 'a polynomial P is defined by: 'integer ipdeg (degree of polynomial) 'number cp(MAXPOL) (coefficients of polynomial, real, integer or fractional) 'predefine 3 polynomials P,Q,R DIM isrcp(MAXPOL),cpv(MAXPOL),ipcp(MAXPOL),iqcp(MAXPOL) DIM isrcq(MAXPOL),cqv(MAXPOL),ipcq(MAXPOL),iqcq(MAXPOL) DIM isrcr(MAXPOL),crv(MAXPOL),ipcr(MAXPOL),iqcr(MAXPOL) 'define 2 temporary polynomials V,W DIM isrcv(MAXPOL),cvv(MAXPOL),ipcv(MAXPOL),iqcv(MAXPOL) DIM isrcw(MAXPOL),cwv(MAXPOL),ipcw(MAXPOL),iqcw(MAXPOL) cls print print " SUBSTITUTION OF TWO POLYNOMIALS:" print tx\$=" P(x) = ": gosub 4000 'Enter P(x) 'save P(x) in R(x) irdeg=ipdeg for i=0 to irdeg isrcr(i)=isrcp(i) crv(i)=cpv(i) ipcr(i)=ipcp(i) iqcr(i)=iqcp(i) next i tx\$=" Q(x) = ": gosub 4000 'Enter P(x) 'put P(x) in Q(x) iqdeg=ipdeg for i=0 to iqdeg isrcq(i)=isrcp(i) cqv(i)=cpv(i) ipcq(i)=ipcp(i) iqcq(i)=iqcp(i) next i 'restore P(x) from R(x) ipdeg=irdeg for i=0 to ipdeg isrcp(i)=isrcr(i) cpv(i)=crv(i) ipcp(i)=ipcr(i) iqcp(i)=iqcr(i) next i print gosub 700 'call SubstPolynom(P,Q,R) if IERROR<>0 then print " Error in substitution." else 'put R(x) in P(x) for printing ipdeg=irdeg for i=0 to ipdeg isrcp(i)=isrcr(i) cpv(i)=crv(i) ipcp(i)=ipcr(i) iqcp(i)=iqcr(i) next i print gosub 5000 'display P(x) end if END 'of main program 'MultPolynom: V(X) * Q(X) = W(X) 500 IERROR=0 'set W polynomial to zero iwdeg=0 for i=0 to MAXPOL isrcw(i)=0 cwv(i)=0# ipcw(i)=0 iqcw(i)=1 next i 'verify that V and Q are not void if ivdeg=0 and cvv(0)=0 then IERROR=1 return end if if iqdeg=0 and cqv(0)=0 then IERROR=1 return end if iwdeg=ivdeg+iqdeg if iwdeg > MAXPOL then 'W degree is too big IERROR=1 return end if for n=0 to iwdeg 'set W coeff(n) to zero isrcw(n)=0:cwv(n)=0#:ipcw(n)=0:iqcw(n)=1 for i=0 to ivdeg j=n-i if j>=0 and j<=iqdeg then isrxx=isrcv(i):xxv=cvv(i):ipxx=ipcv(i):iqxx=iqcv(i) 'xx=V coeff(i) isryy=isrcq(j):yyv=cqv(j):ipyy=ipcq(j):iqyy=iqcq(j) 'yy=Q coeff(j) gosub 3100 'zz=xx*yy gosub 803 'yy=zz isrxx=isrcw(n):xxv=cwv(n):ipxx=ipcw(n):iqxx=iqcw(n) 'xx=W coeff(n) gosub 3000 'zz=xx+yy isrcw(n)=isrzz:cwv(n)=zzv:ipcw(n)=ipzz:iqcw(n)=iqzz 'W coeff(n)=zz end if next i next n return 'CombiPolynom: a R(X) + b V(X) = W(X) 'u,v: NUMBER 600 IERROR=0 if ivdeg > irdeg then iwdeg=ivdeg else iwdeg=irdeg end if if iwdeg > MAXPOL then IERROR=1 return 'degree of W(x) is too big end if for i=0 to iwdeg 'set u and v to zero isru=0:uv=0#:ipu=0:iqu=1 isrv=0:vv=0#:ipv=0:iqv=1 if i<=irdeg then 'MultNumber(a,R.coeff[i], u) isrxx=isra:xxv=av:ipxx=ipa:iqxx=iqa 'xx=a isryy=isrcr(i):yyv=crv(i):ipyy=ipcr(i):iqyy=iqcr(i) 'yy=R coeff(i) gosub 3100 'zz=xx*yy isru=isrzz:uv=zzv:ipu=ipzz:iqu=iqzz 'u=zz end if if i<=ivdeg then 'MultNumber(b,V.coeff[i], v) isrxx=isrb:xxv=bv:ipxx=ipb:iqxx=iqb 'xx=b isryy=isrcv(i):yyv=cvv(i):ipyy=ipcv(i):iqyy=iqcv(i) 'yy=V coeff(i) gosub 3100 'zz=xx*yy isrv=isrzz:vv=zzv:ipv=ipzz:iqv=iqzz 'v=zz end if 'AddNumber(u,v,W.coeff[i]) isrxx=isru:xxv=uv:ipxx=ipu:iqxx=iqu 'xx=u isryy=isrv:yyv=vv:ipyy=ipv:iqyy=iqv 'yy=v gosub 3000 'zz=xx+yy isrcw(i)=isrzz:cwv(i)=zzv:ipcw(i)=ipzz:iqcw(i)=iqzz 'W coeff(i)=zz next i 610 if iwdeg<=0 or abs(cwv(iwdeg))>SMALL then goto 620 iwdeg=iwdeg-1 goto 610 620 return ' SubstPolynom: R(X) = P(Q(X)) ' a: NUMBER; 700 IERROR=0 'set R polynomial to zero irdeg=0 for i=0 to MAXPOL isrcr(i)=0 crv(i)=0# ipcr(i)=0 iqcr(i)=1 next i irdeg=ipdeg * iqdeg if irdeg > MAXPOL then IERROR=1 return 'degree of R(x) is too big end if isrcr(0)=isrcp(0):crv(0)=cpv(0):ipcr(0)=ipcp(0):iqcr(0)=iqcp(0) 'R coeff(0) = P coeff(0) ivdeg=0 'V degree = 0 isrcv(0)=0:cvv(0)=1#:ipcv(0)=1:iqcv(0)=1 'V coeff(0) = 1 isra=0:av=1#:ipa=1:iqa=1 'a=1 for ideg=1 to ipdeg 'MultPolynom(Q,V,V) gosub 500 'W=Q*V ivdeg=iwdeg 'V=W for k=0 to ivdeg isrcv(k)=isrcw(k) cvv(k)=cwv(k) ipcv(k)=ipcw(k) iqcv(k)=iqcw(k) next k 'CombiPolynom(R,V,a,P.coeff(ideg),R) isrb=isrcp(ideg):bv=cpv(ideg):ipb=ipcp(ideg):iqb=iqcp(ideg)'b=P coeff(ideg) gosub 600 'W=aR+bV irdeg=iwdeg 'R=W for k=0 to irdeg isrcr(k)=isrcw(k) crv(k)=cwv(k) ipcr(k)=ipcw(k) iqcr(k)=iqcw(k) next k next ideg return \$INCLUDE "numeric\polynoms\polynoms.bas" 'end of file substpol.bas