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           transcompile:true,
  15           define_variable:'mode)$
  16
  17 put('rncomb,2,'version)$
  18
  19 rncombine(exp):=block(
  20   [partswitch:true,inflag:true,piece,pfeformat:true],
  21   exp:rloiewl("+",combine(exp)),
  22   pfeformat:false,
  23   rncombine1(exp))$
  24
  25 lcm_l(list):=
  26   if list=[]
  27   then 1
  28   else block([rlist:rest(list),flist:first(list),frlist,
  29               partswitch:true,inflag:true,piece],
  30              if rlist=[]
  31              then flist
  32              else lcm_l(cons(flist*(frlist:first(rlist))/gcd(flist,frlist),
  33                              rest(rlist))))$
  34
  35 rncombine1(list):=block(
  36   [flist,splitdum,lsplitdum,flist_denom],
  37   if list=[] then return(0),
  38   flist:first(list),
  39   if length(list)=1
  40   then return(if inpart(num(flist),0)="+"
  41               then rncombine1(args(num(flist)))/denom(flist)
  42               else flist),
  43   flist_denom:(flist_denom:denom(flist))/numfactor(flist_denom),
  44   splitdum:predpartition(rest(list),
  45                          lambda([dum],numberp(denom(dum)/flist_denom))),
  46   if (lsplitdum:last(splitdum))#[]
  47   then flist:denomthru(cons(flist*flist_denom,lsplitdum*flist_denom))/flist_denom,
  48   flist+rncombine1(first(splitdum)))$
  49
  50 denomthru(exp):=block(
  51   [lcmdum:lcm_l(maplist('denom,exp))],
  52   apply("+",lcmdum*exp)/lcmdum)$
  53
  54 /* Functions from DGVAL;GENUT FASL: */
  55
  56 rloiewl(op,exp):=block(
  57   [partswitch:true,inflag:true,piece],
  58   if inpart(exp,0)=op
  59   then args(exp)
  60   else [exp])$
  61
  62 predpartition(list,predicate):=block(
  63   [nolist:[],yeslist:[]],
  64   for idum in reverse(list) do
  65       if mode_identity(boolean,apply(predicate,[idum]))
  66       then yeslist:cons(idum,yeslist)
  67       else nolist:cons(idum,nolist),
  68   [nolist,yeslist])$
  69
  70 eval_when(batch,ttyoff:false)$