'*****************************************************
'*  This program multiplies a polynomial P(x) by a   *
'*  polynomial Q(x)                                  *
'* ------------------------------------------------- *
'* Ref.: "Mathematiques en Turbo-Pascal By M. Ducamp *
'* and A. Reverchon (vol 2), Eyrolles, Paris, 1988"  *
'* [BIBLI 05].                                       *
'* ------------------------------------------------- *
'* SAMPLE RUN:                                       *
'*                                                   *
'* MULTIPLY TWO POLYNOMIALS:                         *
'*                                                   *
'* P(X) = x3 - 6x + 7                                *
'* Q(x) = 5x5 -3x4 +x2 -3                            *
'*                                                   *
'*                                                   *
'* 5 X8 - 3 X7 - 30 X6 + 54 X5 - 21 X4 - 9 X3 + 7 X2 *
'* + 18 X - 21                                       *
'*                                                   *
'*                                                   *
'*                     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)

cls
print
print " MULTIPLY TWO POLYNOMIALS:"
print
tx$=" P(x) = ": gosub 4000        'Enter polynomial P(x)
'save first polynomial in Q(x)
iqdeg=ipdeg
for i=0 to ipdeg
  isrcq(i)=isrcp(i)
  cqv(i)=cpv(i)
  ipcq(i)=ipcp(i)
  iqcq(i)=iqcp(i)
next i
tx$=" Q(x) = ": gosub 4000        'Enter polynomial P(x)
'second polynomial is now in P(x)

gosub 500  'call multiplication routine R(x)=P(x)*Q(x)

if IERROR<>0 then
  print " Error in multiplication."
else
  'put R(x) in P(x) for printing
  ipdeg=irdeg
  for i=0 to irdeg
    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

'Function MultPolynom P(X) * Q(X) = R(X)
500 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
  'verify that P and Q are not void
  if ipdeg=0 and cpv(0)=0 then
    IERROR=1
    return
  end if
  if iqdeg=0 and cqv(0)=0 then
    IERROR=1
    return
  end if
  irdeg=ipdeg+iqdeg
  if irdeg > MAXPOL then 'R degree is too big
    IERROR=1
    return
  end if
  for n=0 to irdeg
    'set R coeff(n) to zero
    isrcr(n)=0:crv(n)=0#:ipcr(n)=0:iqcr(n)=1
    for i=0 to ipdeg
      j=n-i
      if j>=0 and j<=iqdeg then
        isrxx=isrcp(i):xxv=cpv(i):ipxx=ipcp(i):iqxx=iqcp(i)   'xx=P 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=isrcr(n):xxv=crv(n):ipxx=ipcr(n):iqxx=iqcr(n)   'xx=R coeff(n)
        gosub 3000                                            'zz=xx+yy
        isrcr(n)=isrzz:crv(n)=zzv:ipcr(n)=ipzz:iqcr(n)=iqzz   'R coeff(n)=zz
      end if
    next i
  next n
return


$INCLUDE "Numeric\Polynoms\Polynoms.bas"

'end of file Multpol.bas