share/simplification/facex1.mac

   1 /* -*- MACSYMA -*- */
   2 eval_when(batch,ttyoff:true)$
   3 /*ASB;FACEX1 1
   4 4:19pm  Monday, 7 February 1983
   5   Split off from FACEXP 15
   6 */
   7 /*
   8 eval_when([translate,batch,loadfile],
   9           if get('facexp,'version)=false
  10           then (load('[facexp,fasl]),
  11                 load('[gndecl,fasl])))$
  12 */
  13 eval_when(translate,
  14           define_variable:'mode,
  15           modedeclare(function(nulllistp,freeofl),boolean))$
  16
  17 put('facex1,1,'version)$
  18
  19 /* GNU Maxima */
  20
  21 /* Commented out all local SPECIAL declarations.  For other changes,
  22    search for `Maxima:' below.
  23
  24    TODO: This file contains seemingly newer versions of some functions
  25    in facexp.  So merge these files. -wj */
  26
  27 /* This was done on 2002-09-26.  This file is now obsolete,
  28   so don't use it.  Use facexp instead. */
  29
  30 eval_when([batch,loadfile],
  31   if get('gnauto,'diageval_version)=false
  32   then load("genut"))$
  33
  34 collectten(exp):=collecttermsl(exp,listoftens(exp))$
  35
  36 collectterms(exp,[varlist]):=collecttermsl(exp,varlist)$
  37
  38 collecttermsl(exp,varlist):=block(
  39   [partswitch:true,inflag:true,piece],
  40   apply('collectterms0,cons(exp,argsplit(exp,varlist))))$
  41
  42 collectterms0(exp,thisleveldum,nextleveldum):=block(
  43   [iforp:true,splitdum1,splitdum2,splitdum3,anslist:[],fdum,
  44    prevdum,lsplit3,ansdum,lastdumsave,prevlastdum,
  45    rthisleveldum,fthisleveldum],
  46   modedeclare(lsplit3,fixnum),
  47   /* DECLARE([FDUM,SPLITDUM3,ANSDUM],SPECIAL), */
  48   if exp=0 then return(0),
  49   if nulllistp(thisleveldum) or freeofl(thisleveldum,exp)
  50   then if nulllistp(nextleveldum)
  51        then return(exp)
  52        else (splitdum1:orpartitionl(exp,"+",nextleveldum),
  53              return(collecttermsl(first(splitdum1),nextleveldum)
  54                     +iflopmap("+",
  55                               lambda([termdum],
  56                                      collecttermsl(termdum,nextleveldum)),
  57                               last(splitdum1)))),
  58   rthisleveldum:rest(thisleveldum),
  59   if freeof(fthisleveldum:first(thisleveldum),exp)
  60   then return(collectterms0(exp,rthisleveldum,nextleveldum)),
  61   splitdum1:orpartitionl(exp,"+",thisleveldum),
  62   splitdum2:orpartitionl(last(splitdum1),"+",[fthisleveldum]),
  63   ansdum:collecttermsl(first(splitdum1),nextleveldum)
  64          +collectterms0(first(splitdum2),rthisleveldum,nextleveldum),
  65   if inpart(splitdum3:last(splitdum2),0)#"+"
  66   then return(ansdum+collecttermsl(splitdum3,nextleveldum)),
  67   splitdum3:sort(maplist(lambda([term],orpartitionl(term,"*",[fthisleveldum])),
  68                  splitdum3),
  69                  'orderlastp),
  70   lsplit3:length(splitdum3)-1,
  71   prevlastdum:inpart(splitdum3,1,2),
  72   prevdum:inpart(splitdum3,1,1),
  73   splitdum3:rest(splitdum3),
  74   for idum thru lsplit3 do
  75        (if (lastdumsave:inpart(splitdum3,idum,2))=prevlastdum
  76         then prevdum:prevdum+inpart(splitdum3,idum,1)
  77         else (anslist:endcons([prevdum,prevlastdum],anslist),
  78               prevdum:inpart(splitdum3,idum,1),
  79               prevlastdum:lastdumsave),
  80         if idum=lsplit3
  81         then anslist:endcons([prevdum,prevlastdum],anslist)),
  82   listtosum(maplist('lambda([dum], /* Maxima: quoted the lambda expression */
  83                            if freeofl(rthisleveldum,fdum:first(dum))
  84                            then collecttermsl(fdum,nextleveldum)
  85                                     *last(dum)
  86                            else multthrusplit(last(dum),
  87                                               collectterms0(fdum,rthisleveldum,
  88                                                             nextleveldum),
  89                                               rthisleveldum)),
  90                     anslist))+ansdum)$
  91
  92 orderlastp(exp1,exp2):=orderlessp(last(exp1),last(exp2))$
  93
  94
  95 multthrusplit(factordum,sumdum,rthisleveldum):=block(
  96   [splitdum1:orpartitionl(sumdum,"+",rthisleveldum)],
  97   multthru(factordum,last(splitdum1))+factordum*first(splitdum1))$
  98
  99 eval_when(batch,ttyoff:false)$