/*
 * poly - calculate with polynomials of one variable
 *
 * Copyright (C) 1999,2021  Ernest Bowen
 *
 * Calc is open software; you can redistribute it and/or modify it under
 * the terms of the version 2.1 of the GNU Lesser General Public License
 * as published by the Free Software Foundation.
 *
 * Calc is distributed in the hope that it will be useful, but WITHOUT
 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
 * or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General
 * Public License for more details.
 *
 * A copy of version 2.1 of the GNU Lesser General Public License is
 * distributed with calc under the filename COPYING-LGPL.  You should have
 * received a copy with calc; if not, write to Free Software Foundation, Inc.
 * 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
 *
 * Under source code control:   1990/02/15 01:50:35
 * File existed as early as:    before 1990
 *
 * Share and enjoy!  :-)        http://www.isthe.com/chongo/tech/comp/calc/
 */

/*
 * A collection of functions designed for calculations involving
 *      polynomials in one variable (by Ernest W. Bowen).
 *
 * On starting the program the independent variable has identifier x
 *      and name "x", i.e. the user can refer to it as x, the
 *      computer displays it as "x".  The name of the independent
 *      variable is stored as varname, so, for example, varname = "alpha"
 *      will change its name to "alpha".  At any time, the independent
 *      variable has only one name.  For some purposes, a name like
 *      "sin(t)" or "(a + b)" or "\lambda" might be useful;
 *      names like "*" or "-27" are legal but might give expressions
 *      that are difficult to interpret.
 *
 * Polynomial expressions may be constructed from numbers and the
 *      independent variable and other polynomials by the algebraic
 *      operations +, -, *, ^, and if the result is a polynomial /.
 *      The operations // and % are defined to have the quotient and
 *      remainder meanings as usually defined for polynomials.
 *
 * When polynomials are assigned to identifiers, it is convenient to
 *      think of the polynomials as values.  For example, p = (x - 1)^2
 *      assigns to p a polynomial value in the same way as q = (7 - 1)^2
 *      would assign to q a number value.  As with number expressions
 *      involving operations, the expression used to define the
 *      polynomial is usually lost; in the above example, the normal
 *      computer display for p will be  x^2 - 2x + 1.  Different
 *      identifiers may of course have the same polynomial value.
 *
 * The polynomial we think of as a_0 + a_1 * x + ... + a_n * x^n,
 *      for number coefficients a_0, a_1, ... a_n may also be
 *      constructed as pol(a_0, a_1, ..., a_n).  Note that here the
 *      coefficients are to be in ascending power order.  The independent
 *      variable is pol(0,1), so to use t, say, as an identifier for
 *      this, one may assign  t = pol(0,1).  To simultaneously specify
 *      an identifier and a name for the independent variable, there is
 *      the instruction var, used as in identifier = var(name).  For
 *      example, to use "t" in the way "x" is initially, one may give
 *      the instruction  t = var("t").
 *
 * There are four parameters pmode, order, iod and ims for controlling
 *      the format in which polynomials are displayed.
 *      The parameter pmode may have values "alg" or "list": the
 *      former gives a display as an algebraic formula, while
 *      the latter only lists the coefficients.  Whether the terms or
 *      coefficients are in ascending or descending power order is
 *      controlled by order being "up" or "down".  If the
 *      parameter iod (for integer-only display), the polynomial
 *      is expressed in terms of a polynomial whose coefficients are
 *      integers with gcd = 1, the leading coefficient having positive
 *      real part, with where necessary a leading multiplying integer,
 *      a Gaussian integer multiplier if the coefficients are complex
 *      with a common complex factor, and a trailing divisor integer.
 *      If a non-zero value is assigned to the parameter ims,
 *      multiplication signs will be inserted where appropriate;
 *      this may be useful if the expression is to be copied to a
 *      program or a string to be used with eval.
 *
 * For evaluation of polynomials the standard function is ev(p, t).
 *      If p is a polynomial and t anything for which the relevant
 *      operations can be performed, this returns the value of p
 *      at t.  The function ev(p, t) also accepts lists or matrices
 *      as possible values for p; each element of p is then evaluated
 *      at t.  For other p, t is ignored and the value of p is returned.
 *      If an identifier, a, say, is used for the polynomial, list or
 *      matrix p, the definition
 *                      define a(t) = ev(a, t);
 *      permits a(t) to be used for the value of a at t as if the
 *      polynomial, list or matrix were a function.  For example,
 *      if a = 1 + x^2, a(2) will return the value 5, just as if
 *                      define a(t) = 1 + t^2;
 *      had been used.   However, when the polynomial definition is
 *      used, changing the polynomial a will change a(t) to the value
 *      of the new polynomial at t.  For example,
 *      after
 *              L = list(x, x^2, x^3, x^4);
                define a(t) = ev(a, t);
 *      the loop
 *              for (i = 0; i < 4; i++)
 *                      print ev(L[[i]], 5);
 *      may be replaced by
 *              for (i = 0; i < 4; i++) {
 *                      a = L[[i]];
 *                      print a(5);
 *              }
 *
 * Matrices with polynomial elements may be added, subtracted and
 *      multiplied as long as the usual rules for compatibility are
 *      observed.  Also, matrices may be multiplied by polynomials,
 *      i.e. if p is a  polynomial and A a matrix whose elements
 *      may be numbers or polynomials, p * A returns the matrix of
 *      the same shape as A with each element multiplied by p.
 *      Square matrices may also be 'substituted for the variable' in
 *      polynomials, e.g. if A is an m x m matrix, and
 *      p = x^2 + 3 * x + 2, ev(p, A) returns the same as
 *      A^2 + 3 * A + 2 * I, where I is the unit m x m matrix.
 *
 * On starting this program, three demonstration polynomials a, b, c
 *      have been defined.  The functions a(t), b(t), c(t) corresponding
 *      to a, b, c, and x(t) corresponding to x, have also been
 *      defined, so the usual function notation can be used for
 *      evaluations of a, b, c and x.  For x, as long as x identifies
 *      the independent variable, x(t) should return the value of t,
 *      i.e. it acts as an identity function.
 *
 * Functions defined include:
 *
 *      monic(a) returns the monic multiple of a, i.e., if a != 0,
 *              the multiple of a with leading coefficient 1
 *      conj(a) returns the complex conjugate of a
 *      ispmult(a,b) returns 1 or 0 according as a is or is not
 *              a polynomial multiple of b
 *      pgcd(a,b) returns the monic gcd of a and b
 *      pfgcd(a,b) returns a list of three polynomials (g, u, v)
 *              where g = pgcd(a,b) and g = u * a + v * b.
 *      plcm(a,b) returns the monic lcm of a and b
 *
 *      interp(X,Y,t) returns the value at t of the polynomial given
 *              by Newtonian divided difference interpolation, where
 *              X is a list of x-values, Y a list of corresponding
 *              y-values.  If t is omitted, the interpolating
 *              polynomial is returned.  A y-value may be replaced by
 *              list (y, y_1, y_2, ...), where y_1, y_2, ... are
 *              the reduced derivatives at the corresponding x;
 *              i.e. y_r is the r-th derivative divided by fact(r).
 *      mdet(A) returns the determinant of the square matrix A,
 *              computed by an algorithm that does not require
 *              inverses;  the built-in det function usually fails
 *              for matrices with polynomial elements.
 *      D(a,n) returns the n-th derivative of a; if n is omitted,
 *              the first derivative is returned.
 *
 * A first-time user can see what the initially defined polynomials
 *      a, b and c are, and experiment with the algebraic operations
 *      and other functions that have been defined by giving
 *      instructions like:
 *                      a
 *                      b
 *                      c
 *                      (x^2 + 1) * a
 *                      a^27
 *                      a * b
 *                      a % b
 *                      a // b
 *                      a(1 + x)
 *                      a(b)
 *                      conj(c)
 *                      g = pgcd(a, b)
 *                      g
 *                      a / g
 *                      D(a)
 *                      mat A[2,2] = {1 + x, x^2, 3, 4*x}
 *                      mdet(A)
 *                      D(A)
 *                      A^2
 *                      define A(t) = ev(A, t)
 *                      A(2)
 *                      A(1 + x)
 *                      define L(t) = ev(L, t)
 *                      L = list(x, x^2, x^3, x^4)
 *                      L(5)
 *                      a(L)
 *                      interp(list(0,1,2,3), list(2,3,5,7))
 *                      interp(list(0,1,2), list(0,list(1,0),2))
 *
 * One check on some of the functions is provided by the Cayley-Hamilton
 *      theorem:  if A is any m x m matrix and I the m x m unit matrix,
 *      and x is pol(0,1),
 *                      ev(mdet(x * I - A), A)
 *      should return the zero m x m matrix.
 */


obj poly {p};

define pol() {
        local u,i,s;
        obj poly u;
        s = list();
        for (i=1; i<= param(0); i++) append (s,param(i));
        i=size(s) -1;
        while (i>=0 && s[[i]]==0) {i--; remove(s)}
        u.p = s;
        return u;
}

define ispoly(a) {
        local y;
        obj poly y;
        return istype(a,y);
}

define findlist(a) {
        if (ispoly(a)) return a.p;
        if (a) return list(a);
        return list();
}

pmode = "alg";  /* The other acceptable pmode is "list" */
ims = 0;        /* To be non-zero if multiplication signs to be inserted */
iod = 0;        /* To be non-zero for integer-only display */
order = "down"  /* Determines order in which coefficients displayed */

define poly_print(a) {
        local f, g, t;
        if (size(a.p) == 0) {
                print 0:;
                return;
        }
        if (iod) {
                g = gcdcoeffs(a);
                t = a.p[[size(a.p) - 1]] / g;
                if (re(t) < 0) { t = -t; g = -g;}
                if (g != 1) {
                        if (!isreal(t)) {
                                if (im(t) > re(t)) g *= 1i;
                                else if (im(t) <= -re(t)) g *= -1i;
                        }
                        if (isreal(g)) f = g;
                        else f = gcd(re(g), im(g));
                        if (num(f) != 1) {
                                print num(f):;
                                if (ims) print"*":;
                        }
                        if (!isreal(g)) {
                                printf("(%d)", g/f);
                                if (ims) print"*":;
                        }
                        if (pmode == "alg") print"(":;
                        polyprint(1/g * a);
                        if (pmode == "alg") print")":;
                        if (den(f) > 1) print "/":den(f):;
                        return;
                }
        }
        polyprint(a);
}

define polyprint(a) {
        local s,n,i,c;
        s = a.p;
        n=size(s) - 1;
        if (pmode=="alg") {
                if (order == "up") {
                        i = 0;
                        while (!s[[i]]) i++;
                        pterm (s[[i]], i);
                        for (i++ ; i <= n; i++) {
                                c = s[[i]];
                                if (c) {
                                        if (isreal(c)) {
                                                if (c > 0) print" + ":;
                                                else {
                                                        print" - ":;
                                                        c = -c;
                                                }
                                        }
                                        else print " + ":;
                                        pterm(c,i);
                                }
                        }
                        return;
                }
                if (order == "down") {
                        pterm(s[[n]],n);
                        for (i=n-1; i>=0; i--) {
                                c = s[[i]];
                                if (c) {
                                        if (isreal(c)) {
                                                if (c > 0) print" + ":;
                                                else {
                                                        print" - ":;
                                                        c = -c;
                                                }
                                        }
                                        else print " + ":;
                                        pterm(c,i);
                                }
                        }
                        return;
                }
                quit "order to be up or down";
        }
        if (pmode=="list") {
                plist(s);
                return;
        }
        print pmode,:"is unknown mode";
}


define poly_neg(a) {
        local s,i,y;
        obj poly y;
        s = a.p;
        for (i=0; i< size(s); i++) s[[i]] = -s[[i]];
        y.p = s;
        return y;
}

define poly_conj(a) {
        local s,i,y;
        obj poly y;
        s = a.p;
        for (i=0; i < size(s); i++) s[[i]] = conj(s[[i]]);
        y.p = s;
        return y;
}

define poly_inv(a) = pol(1)/a;  /* This exists only for a of zero degree */

define poly_add(a,b) {
        local sa, sb, i, y;
        obj poly y;
        sa=findlist(a); sb=findlist(b);
        if (size(sa) > size(sb)) swap(sa,sb);
        for (i=0; i< size(sa); i++) sa[[i]] += sb[[i]];
        while (i < size(sb)) append (sa, sb[[i++]]);
        while (i > 0 && sa[[--i]]==0) remove (sa);
        y.p = sa;
        return y;
}

define poly_sub(a,b) {
         return a + (-b);
}

define poly_cmp(a,b) {
        local sa, sb;
        sa = findlist(a);
        sb=findlist(b);
        return  (sa != sb);
}

define poly_mul(a,b) {
        local sa,sb,i, j, y;
        if (ismat(a)) swap(a,b);
        if (ismat(b)) {
                y = b;
                for (i=matmin(b,1); i <= matmax(b,1); i++)
                        for (j = matmin(b,2); j<= matmax(b,2); j++)
                                y[i,j] = a * b[i,j];
                return y;
        }
        obj poly y;
        sa=findlist(a); sb=findlist(b);
        y.p = listmul(sa,sb);
        return y;
}

define listmul(a,b) {
        local da,db, s, i, j, u;
        da=size(a)-1; db=size(b)-1;
        s=list();
        if (da >= 0 && db >= 0) {
                for (i=0; i<= da+db; i++) { u=0;
                        for (j = max(0,i-db); j <= min(i, da); j++)
                        u += a[[j]]*b[[i-j]]; append (s,u);}}
        return s;
}

define ev(a,t) {
        local v, i, j;
        if (ismat(a)) {
                v = a;
                for (i = matmin(a,1); i <= matmax(a,1); i++)
                        for (j = matmin(a,2); j <= matmax(a,2); j++)
                                v[i,j] = ev(a[i,j], t);
                return v;
        }
        if (islist(a)) {
                v = list();
                for (i = 0; i < size(a); i++)
                        append(v, ev(a[[i]], t));
                return v;
        }
        if (!ispoly(a)) return a;
        if (islist(t)) {
                v = list();
                for (i = 0; i < size(t); i++)
                        append(v, ev(a, t[[i]]));
                return v;
        }
        if (ismat(t)) return evpm(a.p, t);
        return evp(a.p, t);
}

define evp(s,t) {
        local n,v,i;
        n = size(s);
        if (!n) return 0;
        v = s[[n-1]];
        for (i = n - 2; i >= 0; i--) v=t * v +s[[i]];
        return v;
}

define evpm(s,t) {
        local m, n, V, i, I;
        n = size(s);
        m = matmax(t,1) - matmin(t,1);
        if (matmax(t,2) - matmin(t,2) != m) quit "Non-square matrix";
        mat V[m+1, m+1];
        if (!n) return V;
        mat I[m+1, m+1];
        matfill(I, 0, 1);
        V = s[[n-1]] * I;
        for (i = n - 2; i >= 0; i--) V = t * V + s[[i]] * I;
        return V;
}
pzero = pol(0);
x = pol(0,1);
varname = "x";
define x(t) = ev(x, t);

define iszero(a) {
        if (ispoly(a))
                return !size(a.p);
        return a == 0;
}

define isstring(a) = istype(a, " ");

define var(name) {
        if (!isstring(name)) quit "Argument of var is to be a string";
        varname = name;
        return pol(0,1);
}

define pcoeff(a) {
                if (isreal(a)) print a:;
                else print "(":a:")":;
}

define pterm(a,n) {
        if (n==0) {
                pcoeff(a);
                return;
        }
        if (n==1) {
                if (a!=1) {
                        pcoeff(a);
                        if (ims) print"*":;
                }
                print varname:;
                return;
        }
        if (a!=1) {
                pcoeff(a);
                if (ims) print"*":;
        }
        print varname:"^":n:;
}

define plist(s) {
        local i, n;
        n = size(s);
        print "( ":;
        if (order == "up") {
                for (i=0; i< n-1 ; i++)
                        print s[[i]]:",",:;
                if (n) print s[[i]],")":;
                else print "0 )":;
        }
        else {
                if (n) print s[[n-1]]:;
                for (i = n - 2; i >= 0; i--)
                        print ", ":s[[i]]:;
                print " )":;
        }
}

define deg(a) = size(a.p) - 1;

define polydiv(a,b) {
        local d, u, i, m, n, sa, sb, sq;
        local obj poly q;
        local obj poly r;
        sa=findlist(a); sb = findlist(b); sq = list();
        m=size(sa)-1; n=size(sb)-1;
        if (n<0) quit "Zero divisor";
        if (m<n) return list(pzero, a);
        d = sb[[n]];
        while ( m >= n) { u = sa[[m]]/d;
                for (i = 0; i< n; i++) sa[[m-n+i]] -= u*sb[[i]];
                push(sq,u); remove(sa); m--;
                while (m>=n && sa[[m]]==0) { m--; remove(sa); push(sq,0)}}
        while (m>=0 && sa[[m]]==0) { m--; remove(sa);}
        q.p = sq;  r.p = sa;
        return list(q, r);}

define poly_mod(a,b)  {
        local u;
        u=polydiv(a,b);
        return u[[1]];
}

define poly_quo(a,b) {
        local p;
        p = polydiv(a,b);
        return p[[0]];
}

define ispmult(a,b) = iszero(a % b);

define poly_div(a,b) {
        if (!ispmult(a,b)) quit "Result not a polynomial";
        return poly_quo(a,b);
}

define pgcd(a,b) {
        local r;
        if (iszero(a) && iszero(b)) return pzero;
        while (!iszero(b)) {
                r = a % b;
                a = b;
                b = r;
        }
        return monic(a);
}

define plcm(a,b) = monic( a * b // pgcd(a,b));

define pfgcd(a,b) {
        local u, v, u1, v1, s, q, r, d, w;
        u = v1 = pol(1); v = u1 = pol(0);
        while (size(b.p) > 0) {s = polydiv(a,b);
                q = s[[0]];
                a = b; b = s[[1]]; u -= q*u1; v -= -q*v1;
                swap(u,u1); swap(v,v1);}
        d=size(a.p)-1; if (d>=0 && (w= 1/a.p[[d]]) !=1)
                 { a *= w; u *= w; v *= w;}
        return list(a,u,v);
}

define monic(a) {
        local s, c, i, d, y;
        if (iszero(a)) return pzero;
        obj poly y;
        s = findlist(a);
        d = size(s)-1;
        for (i=0; i<=d; i++) s[[i]] /= s[[d]];
        y.p = s;
        return y;
}

define coefficient(a,n) = (n < size(a.p)) ? a.p[[n]] : 0;

define D(a, n) {
        local i,j,v;
        if (isnull(n)) n = 1;
        if (!isint(n) || n < 1) quit "Bad order for derivative";
        if (ismat(a)) {
                v = a;
                for (i = matmin(a,1); i <= matmax(a,1); i++)
                        for (j = matmin(a,2); j <= matmax(a,2); j++)
                                v[i,j] = D(a[i,j], n);
                return v;
        }
        if (!ispoly(a)) return 0;
        return Dp(a,n);
}

define Dp(a,n) {
        local i, v;
        if (n > 1) return Dp(Dp(a, n-1), 1);
        obj poly v;
        v.p=list();
        for (i=1; i<size(a.p); i++) append (v.p, i*a.p[[i]]);
        return v;
}


define cgcd(a,b) {
        if (isreal(a) && isreal(b)) return gcd(a,b);
        while (a) {
                b -= bround(b/a) * a;
                swap(a,b);
        }
        if (re(b) < 0) b = -b;
        if (im(b) > re(b)) b *= -1i;
        else if (im(b) <= -re(b)) b *= 1i;
        return b;
}

define gcdcoeffs(a) {
        local s,i,g, c;
        s = a.p;
        g=0;
        for (i=0; i < size(s) && g != 1; i++)
                if (c = s[[i]]) g = cgcd(g, c);
        return g;
}

define interp(X, Y, t) = evalfd(makediffs(X,Y), t);

define makediffs(X,Y) {
        local U, D, d, x, y, i, j, k, m, n, s;
        U = D = list();
        n = size(X);
        if (size(Y) != n) quit"Arguments to be lists of same size";
        for (i = n-1; i >= 0; i--) {
                x = X[[i]];
                y = Y[[i]];
                m = size(U);
                if (isnum(y)) {
                        d = y;
                        for (j = 0; j < m; j++) {
                                d = D[[j]] = (D[[j]]-d)/(U[[j]] - x);
                        }
                        push(U, x);
                        push(D, y);
                }
                else {
                        s = size(y);
                        for (k = 0; k < s ; k++) {
                                d = y[[k]];
                                for (j = 0; j < m; j++) {
                                        d = D[[j]] = (D[[j]] - d)/(U[[j]] - x);
                                }
                        }
                        for (j=s-1; j >=0; j--) {
                                push(U,x);
                                push(D, y[[j]]);
                        }
                }
        }
        return list(U, D);
}

define evalfd(T, t) {
        local U, D, n, i, v;
        if (isnull(t)) t = pol(0,1);
        U = T[[0]];
        D = T[[1]];
        n = size(U);
        v = D[[n-1]];
        for (i = n-2; i >= 0; i--)
                v = v * (t - U[[i]]) + D[[i]];
        return v;
}


define mdet(A) {
        local n, i, j, k, I, J;
        n = matmax(A,1) - (i = matmin(A,1));
        if (matmax(A,2) - (j = matmin(A,2)) != n)
                quit "Non-square matrix for mdet";
        I = J = list();
        k = n + 1;
        while (k--) {
                append(I,i++);
                append(J,j++);
        }
        return M(A, n+1, I, J);
}

define M(A, n, I, J) {
        local v, J0, i, j, j1;
        if (n == 1) return A[ I[[0]], J[[0]] ];
        v = 0;
        i = remove(I);
        for (j = 0; j < n; j++) {
                J0 = J;
                j1 = delete(J0, j);
                v += (-1)^(n-1+j) * A[i, j1] * M(A, n-1, I, J0);
        }
        return v;
}

define mprint(A) {
        local i,j;
        if (!ismat(A)) quit "Argument to be a matrix";
        for (i = matmin(A,1); i <= matmax(A,1); i++) {
                for (j = matmin(A,2); j <= matmax(A,2); j++)
                        printf("%8.4d ", A[i,j]);
                printf("\n");
        }
}

obj poly a;
obj poly b;
obj poly c;

define a(t) = ev(a,t);
define b(t) = ev(b,t);
define c(t) = ev(c,t);

a=pol(1,4,4,2,3,1);
b=pol(5,16,8,1);
c=pol(1+2i,3+4i,5+6i);

if (config("resource_debug") & 3) {
        print "obj poly {p} defined";
}
