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
5.5.13 added include periodic.h
8.8.24 changed math.h to sincos.h
2.18.25 and back again
*/

#include <string.h>
#include <math.h>
#include <assert.h>
#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  */
#include "periodic.h" 

/*__________________________________________________________________________*/
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_term, and t = (2m+1)pi/2.
Then we want *ans = [x = pi_term/2, x = 3pi/2] and *next to be
[x = pi_term/2 + 2m pi_term, 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  = 0.0,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_term, 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_term and period = pi_term/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_term)/3 */
          }
     }
  return 0;
}
/*_______________________________________________________________________*/
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_term
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_term);
                    return 0;
                  }
               twoparts(u,x,&c,&s);
               if(!equals(s,x))
                  return 1;
               if(FRACTION(c))
                  polyval(product3(two,pi_term,reciprocal(c)),period);
               else
                  polyval(make_fraction(product(two,pi_term),c),period);
               return 0;
            case TAN:
            case COT:
               if(equals(u,x))
                  { *period = pi_term;
                    return 0;
                  }
               twoparts(u,x,&c,&s);
               if(!equals(s,x))
                  return 1;
               if(FRACTION(c))
                  polyval(product(reciprocal(c),pi_term),period);
               else
                  polyval(make_fraction(pi_term,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;
}