Sindbad~EG File Manager

/*
M. Beeson, for Mathpert
Implement the operation "put solution in periodic form"
Original date 7.10.96
last modified 1.29.98
*/

#include <string.h>
#include <math.h>
#include <assert.h>
#define PROVER_DLL
#include "globals.h"
#include "ops.h"
#include "trig.h"
#include "cancel.h"
#include "prover.h"
#include "probtype.h"
#include "symbols.h"
#include "errbuf.h"
#include "ssolve.h"    /* solved       */
#include "islinear.h"  /* is_linear_in */
#include "algaux.h"    /* topflatten   */
#include "deval.h"     /* deval        */
#include "pvalaux.h"   /* topflatten, twoparts  */

/*__________________________________________________________________________*/
MEXPORT_PROVER int period_aux(term t, term x, term period,term *ans, term *next)
/* x is an atom.  Some unspecified function is periodic with period 'period'.
t is an equation x = c, or an OR or AND of such equations, possibly containing
an existential variable.  Example:  period = 2 pi, and t = (2m+1)pi/2.
Then we want *ans = [x = pi/2, x = 3pi/2] and *next to be
[x = pi/2 + 2m pi, x = 3pi/2 + 2m pi].  In general, *ans will be a list of
equations x = c, where the c are seminumerical terms giving all the possible
values of t in one period, and *next will be a corresponding list of
parametrized equations giving all values of t, but such that for each value of
the integer variable m, there values in *next give all the values of t in
one period.  The functor of *ans will be OR if it's a list.
   Return 0 for success, nonzero for failure.  For it to be successful, it must
work on ALL the args of t.  If 1 is returned, *ans and *next are garbage.
   It is possible that equals(*next,t); this is useful when what we really
want are the numerical values in *ans.  If this is not desired, the calling
function must specifically check whether equals(*next,t) or not.
   Return value 2 means that t did not contain an integer parameter.
*/
{ unsigned short n;
  int i,j,err,retval,nvariables;
  unsigned short k;
  term u,m,right,mperiod,temp,aa,b,c,tempans,p,q;
  term *varlist;
  double a,z,dperiod;
  if(FUNCTOR(t) == MULTIPLICITY)
     t = ARG(0,t);
  if(FUNCTOR(t) != '=' && FUNCTOR(t) != OR && FUNCTOR(t) != AND)
     return 1;
  n = ARITY(t);
  if(FUNCTOR(t) == OR || FUNCTOR(t) == AND)
     { temp = make_term(OR,n);
       tempans = make_term(OR,n);
       retval = 1;
       for(i=0;i<n;i++)
          { err = period_aux(ARG(i,t),x,period, ARGPTR(tempans) + i,ARGPTR(temp)+i);
            if(err == 2)
               { ARGREP(tempans,i,ARG(i,t));
                 ARGREP(temp,i,ARG(i,t));
               }
            else if(err)
               return 1;
            else
               retval = 0;
          }
       if(retval == 1)
          return 1;
       *next = topflatten(temp);
       *ans = topflatten(tempans);
       return 0;
     }
  if(FUNCTOR(t) != '=')
     assert(0);
  right = equals(ARG(0,t),x) ? ARG(1,t) : ARG(0,t);
  /* Does t contain an existential integer variable ? */
  nvariables = get_nvariables();
  varlist = get_varlist();
  for(i=0;i<nvariables;i++)
     { m = varlist[i];
       if(ISEXISTENTIALVAR(m) &&
          TYPE(m) == INTEGER &&
          contains(right,FUNCTOR(m))
         )
          break;
     }
  if(i==nvariables)
     return 2;  /* no integer parameter */

  /* OK, it's periodic. Express the solution in the form c + m*period */
  /* find all the integers k such that c = right[m:=k] is in [a,a+period),
     where a is right[m:=0]-period/2 if this is defined,
     or right[m:=j]-period/2 for some j.
     The answer is the OR of terms c + m * period for these values of k.
  */
  /* For now this will only work when c(m) is linear in m */
  if(FRACTION(right) || FUNCTOR(right) == '*')
     { twoparts(right,m,&p,&q);
       if(!islinear(q,m,&aa,&b))
          return 1;
       polyval(product(p,aa),&q);
       aa = q;
     }
  else if(!islinear(right,m,&aa,&b))
     return 1;
  /* if period is already larger than the coefficient of m in right,
     there is nothing to do.  We could of course continue, e.g. expressing
     things in period pi instead of 2pi if the original equation were periodic
     with period pi, but there's no way in Mathpert to combine e.g. four
     roots to two, and this function isn't written to do it, so we just don't
     handle that case.  Besides it's a mysterious step if we DO perform it.
  */
  polyval(make_fraction(aa,period),&c);
  /* Not just cancel, because if aa = pi and period = pi/2, it won't cancel. */
  /* take m=0,1,.. until c(m)-c(0) >= period */
  /* or, if m==0 won't do, try m = 1, ...m = 10 before giving up */
  for(j=0;j<=10;j++)
     { SETVALUE(m,(double) j);
       deval(right,&a);
       if(a != BADVAL)
          break;
     }
  if(j==11)
     return 1;
  deval(period,&dperiod);
  if(dperiod == BADVAL)
     return 1;
  for(k=0;k < 100; k++)
     { SETVALUE(m, (double)(j+k));
       deval(right,&z);
       if(z == BADVAL)
          return 1;
       if(fabs(z-a) > dperiod-VERYSMALL)
          break;
     }
  if(k==100)
     return 1;  /* something's badly wrong, or else this is just
                   a very strange equation. */
  polyval(product(m,period),&mperiod);
  if(k==1)
     { subst(zero,m,right,&temp);
       polyval(temp,&u);
       *ans = equation(x,u);
       *next = equation(x,sum(u, mperiod));
       SETORDERED(ARG(1,*next));  /* prevent reordering -pi/3 + 4n pi */
     }
  else
     { *next = make_term(OR,k);
       *ans = make_term(OR,k);
       for(i=0;i<k;i++)
          { subst(make_int(i),m,right,&temp);
            polyval(temp,&u);
            ARGREP(*ans,i,equation(x,u));
            ARGREP(*next,i,equation(x,sum(u,mperiod)));
            SETORDERED(ARG(1,ARG(i,*next)));  /* prevent reordering -pi/3 + 4n pi */
            SET_ALREADY(ARG(1,ARG(i,*next)));
            SET_ALREADY(ARG(i,*next));
            /* prevent 2m pi + pi/3 =>  (6mpi + pi)/3 */
          }
     }
  return 0;
}
/*_______________________________________________________________________*/
MEXPORT_PROVER int periodic_in(term t, term x, term *period)
/* If t is a function of trig functions of x, all of whose
arguments are multiples of x, return in *period the gcd of
all those multiples, multiplied by 2 pi for trig functions except
TAN and COT, which use pi instead.  Examples:
   if t = sin(2x)/cos(3x) return *period = 2 pi
   if t = sin(2x)/cos(4x) return *period = 4 pi
   if t = sin(x/2)/cos(x/3) return *period = 2 pi *(1/6) = 1/3 pi
   if t = sin(x) / tan(x) return *period = pi
Return 0 for success, 1 for not-periodic, 2 for doesn't contain x.
*/
{ unsigned short n,f;
  int i,err,flag = 0;
  term temp,ans,u,c,s;
  if(ATOMIC(t))
     return contains(t,FUNCTOR(x)) ? 1 : 2;
  f = FUNCTOR(t);
  n = ARITY(t);
  if(n == 1)
     { u = ARG(0,t);
       switch(f)
          { case SIN:
            case COS:
            case CSC:
            case SEC:
               if(equals(u,x))
                  { *period = product(two,pi);
                    return 0;
                  }
               twoparts(u,x,&c,&s);
               if(!equals(s,x))
                  return 1;
               if(FRACTION(c))
                  polyval(product3(two,pi,reciprocal(c)),period);
               else
                  polyval(make_fraction(product(two,pi),c),period);
               return 0;
            case TAN:
            case COT:
               if(equals(u,x))
                  { *period = pi;
                    return 0;
                  }
               twoparts(u,x,&c,&s);
               if(!equals(s,x))
                  return 1;
               if(FRACTION(c))
                  polyval(product(reciprocal(c),pi),period);
               else
                  polyval(make_fraction(pi,c),period);
               return 0;
          }
     }
  for(i=0;i<n;i++)
     { err = periodic_in(ARG(i,t),x,&temp);
       if(err == 2)
          continue;
       if(err == 1)
          return 1;
       if(!flag)
          { ans = temp;
            flag = 1;
          }
       else
          naive_lcm(ans,temp,&ans);
     }
  if(!flag)
     return 2;
  *period = ans;
  return 0;
}