share/simplification/lrats.mac

   1 /* -*- mode: maxima -*- */
   2 eval_when(batch,ttyoff:true)$
   3 /*ASB;LRATS 3
   4 5:05pm  Tuesday, 14 July 1981
   5 7:53pm  Saturday, 29 May 1982
   6   Added a DIAGEVAL_VERSION for this file.
   7 1:43pm  Saturday, 12 June 1982
   8   Changed loadflags to getversions, DEFINE_VARIABLE:'MODE.
   9 */
  10
  11 eval_when(translate,
  12           define_variable:'mode)$
  13
  14 put('lrats,3,'diageval_version)$
  15
  16 define_variable(messlrats2,"Invalid argument to FULLRATSUBST:",any)$
  17
  18 define_variable(fullratsubstflag,false,boolean)$
  19
  20 lratsubst(listofeqns,expr):=block(
  21   [partswitch:true,inflag:true,piece],
  22   if not listp(listofeqns)
  23   then if inpart(listofeqns,0)="="
  24        then listofeqns:[listofeqns]
  25        else if fullratsubstflag=true
  26             then error(messlrats2,[listofeqns,expr])
  27             else error("Invalid argument to lratsubst:",[listofeqns,expr]),
  28   if listp(inpart(listofeqns,1)) then if length(listofeqns)>1 then error("lratsubst: improper argument:",listofeqns) else listofeqns:inpart(listofeqns,1),
  29   for idum in listofeqns do
  30       if inpart(idum,0)#"="
  31       then if fullratsubstflag=true
  32            then error(messlrats2,[listofeqns,expr])
  33            else error("Invalid argument to lratsubst:",[listofeqns,expr]),
  34   lratsubst1(listofeqns,expr))$
  35
  36 define_variable(lrats_max_iter,100000,integer)$
  37 qput(lrats_max_iter,lambda([v], if v<=0 then error("lrats_max_iter must be set to a positive integer.")),value_check);
  38
  39 lratsubst1(listofeqns,expr):=block([dum,lrats_iter:0,l],
  40   begin_outer_loop,
  41   l:listofeqns,
  42   while dum='dum do (
  43     dum:if l = [] then expr
  44     else (if rest(l) = []
  45       then ratsubst(inpart(l,1,2),inpart(l,1,1),expr)
  46       else 'dum),
  47     expr:if fullratsubstflag = true
  48     then fullratsubst1(inpart(l,1,2),inpart(l,1,1),expr)
  49     else ratsubst(inpart(l,1,2),inpart(l,1,1),expr),
  50     l:rest(l)),
  51   if fullratsubstflag = true and dum # expr and lrats_iter<lrats_max_iter then (lrats_iter:lrats_iter+1,go(begin_outer_loop))
  52   else (if dum # expr then dum else expr))$
  53
  54 fullratsubst1(substexpr,forexpr,expr):=block(
  55   [dum,lrats_iter:0],
  56   while lrats_iter<lrats_max_iter and dum#expr do (
  57     [dum,expr]:[expr,ratsubst(substexpr,forexpr,expr)],
  58     lrats_iter:1+lrats_iter),
  59   if lrats_iter>=lrats_max_iter then warning("fullratsubst1(substexpr,forexpr,expr): reached maximum iterations of",lrats_max_iter,". Increase `lrats_max_iter' to increase this limit."),
  60   expr)$
  61
  62
  63 fullratsubst([arglist]):=block(
  64   [fullratsubstflag:true,larglistdum:length(arglist),farglist,
  65    partswitch:true,inflag:true,piece],
  66   if larglistdum=2
  67   then if listp(farglist:first(arglist)) or inpart(farglist,0)="="
  68        then lratsubst(farglist,last(arglist))
  69        else error(messlrats2,arglist)
  70   else if larglistdum=3
  71        then apply('fullratsubst1,arglist)
  72        else error(messlrats2,arglist))$
  73
  74 eval_when(batch,ttyoff:false)$