share/simplification/rncomb.mac

   1 /* -*-Macsyma-*- */
   2 eval_when(batch,ttyoff:true)$
   3 /*ASB;RNCOMB 2
   4 12:32pm  Friday, 14 January 1983
   5   Created.
   6 12:00pm  Saturday, 15 January 1983
   7   At JPG's suggestion, removed dependence on GENUT by bringing in copies of
   8     PREDPARTITION and RLOIEWL.
   9 10:02am  Sunday, 16 January 1983
  10   LCM name changed to LCM_L to avoid name conflict with LCM in SHARE;FUNCTS >
  11 */
  12
  13 eval_when(translate,
  14           define_variable:'mode)$
  15
  16 put('rncomb,2,'version)$
  17
  18 rncombine(exp):=block(
  19   [partswitch:true,inflag:true,piece,pfeformat:true],
  20   exp:rloiewl("+",combine(exp)),
  21   pfeformat:false,
  22   rncombine1(exp))$
  23
  24 lcm_l(list):=
  25   if list=[]
  26   then 1
  27   else block([rlist:rest(list),flist:first(list),frlist,
  28               partswitch:true,inflag:true,piece],
  29              if rlist=[]
  30              then flist
  31              else lcm_l(cons(flist*(frlist:first(rlist))/gcd(flist,frlist),
  32                              rest(rlist))))$
  33
  34 rncombine1(list):=block(
  35   [flist,splitdum,lsplitdum,flist_denom],
  36   if list=[] then return(0),
  37   flist:first(list),
  38   if length(list)=1
  39   then return(if inpart(num(flist),0)="+"
  40               then rncombine1(args(num(flist)))/denom(flist)
  41               else flist),
  42   flist_denom:(flist_denom:denom(flist))/numfactor(flist_denom),
  43   splitdum:predpartition(rest(list),
  44                          lambda([dum],numberp(denom(dum)/flist_denom))),
  45   if (lsplitdum:last(splitdum))#[]
  46   then flist:denomthru(cons(flist*flist_denom,lsplitdum*flist_denom))/flist_denom,
  47   flist+rncombine1(first(splitdum)))$
  48
  49 denomthru(exp):=block(
  50   [lcmdum:lcm_l(maplist('denom,exp))],
  51   apply("+",lcmdum*exp)/lcmdum)$
  52
  53 /* Functions from DGVAL;GENUT FASL: */
  54
  55 rloiewl(op,exp):=block(
  56   [partswitch:true,inflag:true,piece],
  57   if inpart(exp,0)=op
  58   then args(exp)
  59   else [exp])$
  60
  61 predpartition(list,predicate):=block(
  62   [nolist:[],yeslist:[]],
  63   for idum in reverse(list) do
  64       if mode_identity(boolean,apply(predicate,[idum]))
  65       then yeslist:cons(idum,yeslist)
  66       else nolist:cons(idum,nolist),
  67   [nolist,yeslist])$
  68
  69 eval_when(batch,ttyoff:false)$