/* guess.mac -*- mode: Maxima; -*- 
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 *                                                                       *
 * Copyright (C) 2002 Martin Rubey <Martin.Rubey at LaBRI.fr>            *
 *                                                                       *
 * This file is part of GNU Maxima.                                      *
 *                                                                       *
 * This program is free software; you can redistribute it and/or         *
 * modify it under the terms of the GNU General Public License as        *
 * published by the Free Software Foundation; either version 2 of        *
 * the License, or (at your option) any later version.                   *
 *                                                                       *
 * This program 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 General Public License for more details.         *
 *                                                                       *
 * History:                                                              *
 * This is a translation of the Mathematica package Rate.m               *
 * by Christian Krattenthaler <Kratt at pap.univie.ac.at>.               *
 * The translation to Maple was done by Jean-Francois Beraud             *
 * <Jean-Francois.Beraud at sic.sp2mi.univ-poitiers.fr> and Bruno Gauthier
 * <Bruno.Gauthier at univ-mlv.fr>                                       *
 *                                                                       *
 * All features of this package are due to C. Krattenthaler              *
 * The help text is due to Jean-Francois Beraud and Bruno Gauthier       *
 *                                                                       *
 * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
 */

/*
 * Rational Interpolation
 * Gives the rational interpolant to f (a function), 
 * where m and k are respectively 
 * the degrees of the numerator and denominator, 
 * and xlist is a list of m+k+1 abscissas of the
 * interpolation points
 */

rationalinterpolation(f, x, m, k, xlist) := 
block([fx : map(f, xlist),                 /* values of f at given points */
       tempvec : makelist(1, i, 1, m+k+1), /* contains the new row of mat */
       rowlist,                               /* first set of rows of mat */
       mat,            /* matrix that describes the interpolation problem */
       varlist : makelist('x[i], i, 1, m+k+2)], 

  if max(m, k) > 0
  then rowlist : cons(tempvec, 
                      makelist(tempvec : tempvec * xlist, i, 1, max(m, k)))
  else rowlist : [tempvec],

  mat : transpose(apply(matrix, 
                        append(rest(rowlist, -(max(m, k) - m) ), 
                               -1 * makelist(rowlist[i] * fx, i, 1, k + 1)))),
  mat : ev(mat . varlist, scalarmatrixp : false), 

/* not sure whether it is save to modify xlist... */
  xlist : linsolve(makelist(mat[i, 1], i, 1, m+k+1), varlist), 
  if length(xlist) = 0 
/* something went wrong */
  then NULL
/* use the solution to define the interpolating rational function */ 
  else factor(subst(xlist, sum('x[i+1]*x^i, i, 0, m)
                           /sum('x[i+m+2]*x^i, i, 0, k))));


/* Intermediate function */
guesscons(l, t) := 
block([lsize : length(l), res : [], x, ri], 

  for i : 0 thru lsize-2 do 
     (ri : rationalinterpolation(lambda([x], l[x]), x, 
                                 (lsize-2)-i, i, 
                                 makelist(k, k, 1, lsize-1)),
      if ri # NULL
      then if (subst(x=lsize, denom(ri)) # 0)
              and
              (subst(x=lsize, ri)-last(l) = 0)
              and 
              not member(subst(x=t, ri), res)
           then res : cons(subst(x=t, ri), res)), 
  res);

/*
 * Main function of the package
 * it tries to find a closed form  for a sequence 
 * within the hierarchy of expressions of the 
 * form <rational function>, <product of rational functions>, 
 * <product of product of rational functions>, etc. It may 
 * give several answers
 */
guess(l, [optargs]) := 
block([lsize : length(l), 
       tempres, maxlevel, 
       maxlevellist : sublist(optargs, numberp), 
       res : [], 
       onep : member("one", optargs), 
       unevp : member("nogamma", optargs), g], 

      optargs : delete("nogamma", delete("one", optargs, 1), 1),
      if length(maxlevellist) > 1 or length(optargs)-length(maxlevellist) > 0
      then error("Wrong number of optional arguments: ", optargs)
      else maxlevel : apply(min, cons(lsize-1, maxlevellist)) - 1, 
       
      g : make_array('flonum, maxlevel + 1), 

      for k : 0 thru maxlevel do
         (g[k] : l, 
          l : makelist(l[i+1]/l[i], i, 1, lsize-k-1),

          tempres : guesscons(g[k], concat('i, k)),
          if tempres # []
          then (if k > 0 
                then for i : 1 thru k do
                         if unevp
                         then tempres : 
                                  subst('j = concat('i, (k-i)+1),
                                        map(lambda([expr], 
                                                   g[k-i][1] *
                                                   'product(expr, j, 1, 
                                                            concat('i, k-i)-1)),
                                            tempres))
                         else tempres : 
                                  subst('j = concat('i, (k-i)+1),
                                        map(lambda([expr],
                                                   g[k-i][1] *
                                                   product(expr, j, 1, 
                                                           concat('i, k-i)-1)),
                                            tempres)),
                res : append(res, tempres), 
                if onep then return())),
      res);
