/* -*- MACSYMA -*- */
EVAL_WHEN(BATCH,TTYOFF:TRUE)$
/*ASB;FACEXP 10
2:37pm  Wednesday, 4 November 1981
*/
/* commented out of DOE MACSYMA
EVAL_WHEN(TRANSLATE,
	  IF GRAPHLOAD#TRUE THEN LOAD(['GRAPH,'FASL,'DSK,'DGVAL]),
	  TRANSCOMPILE:TRUE,
	  DECLARE([ARGDUM,ARGDUM2,OP_FCN_LIST],SPECIAL),
	  MODEDECLARE(FUNCTION(NULLLISTP,FREEOFL),BOOLEAN))$

EVAL_WHEN(BATCH,IF DEBUGLOAD#TRUE THEN LOAD(['DEBUG,'FASL,'DSK,'DGVAL]))$
*/
/* Variable definitions */

DEFINE_VARIABLE(NEXTLAYERFACTOR,FALSE,BOOLEAN)$
DEFINE_VARIABLE(FACSUM_COMBINE,TRUE,BOOLEAN)$

/* Autoloads */
/* commented out of DOE MACSYMA
IF STATUS(FEATURE,ITS)=TRUE
THEN (SETUP_AUTOLOAD([GENUT,FASL,DSK,DGVAL],
		     OPMAP,INTERSECTION,LDELETE,IFLOPMAP,FREEOFL,ORPARTITION,
		     LISTOFOPS,ORPARTITIONL,RLOIEWL,IFNOTCONS,LISTTOSUM,
		     LISTOFOPS_NONRAT,NULLLISTP,SETLIST),
      SETUP_AUTOLOAD([INDEX,FASL,DSK,DGVAL],INDEX))$

IF STATUS(FEATURE,MULTICS)=TRUE
THEN (SETUP_AUTOLOAD(">udd>Mathlab>Brenner>genut",
		     OPMAP,INTERSECTION,LDELETE,IFLOPMAP,FREEOFL,ORPARTITION,
		     LISTOFOPS,ORPARTITIONL,RLOIEWL,IFNOTCONS,
		     LISTOFOPS_NONRAT,NULLLISTP,SETLIST),
      SETUP_AUTOLOAD(">udd>Mathlab>Brenner>index",INDEX))$
*/
/* Predicates */

LOPPLUSP(EXP):=IS(INPART(EXP,0)="+")$

OPERATOR0P(EXP):=BLOCK(
  [IP0DUM],
  IS((IP0DUM:INPART(EXP,0))='OPERATOR OR IP0DUM=NOUNIFY('OPERATOR)))$

ORDERLASTP(EXP1,EXP2):=ORDERLESSP(LAST(EXP1),LAST(EXP2))$

/* User accessible functions */

FACTENEXPAND(EXP,[ARGDUMLIST]):=BLOCK(
  [INDEXEXPAND_CANONICAL:FALSE,PARTSWITCH:TRUE,INFLAG:TRUE,PIECE],
  FACEXPTENL(CONS(INDEXEXPAND(EXP),ARGDUMLIST)))$

FACTORFACSUM(EXP,[ARGDUM]):=BLOCK(
  [EXPDUM,IP0DUM,PARTSWITCH:TRUE,INFLAG:TRUE,PIECE],
  IF ATOM(EXP) THEN RETURN(EXP),
  IF NULLLISTP(ARGDUM) THEN RETURN(AUTOFORM(EXP)),
  IF MATRIXP(EXP) OR LISTP(EXP) OR INPART(EXP,0)="="
  THEN RETURN(MAP(LAMBDA([ELEMDUM],APPLY('FACTORFACSUM,CONS(ELEMDUM,ARGDUM))),
		  EXP)),
  EXPDUM:AUTOFORM(EXP),
  IF (IP0DUM:INPART(EXPDUM,0))="^" OR IP0DUM="*"
  THEN MAP(LAMBDA([FACTDUM],APPLY('FACTORFACSUM,CONS(FACTDUM,ARGDUM))),
	   EXPDUM)
  ELSE FACSUML(CONS(EXPDUM,ARGDUM)))$


FACSUM([ARGLIST]):=FACSUML(ARGLIST)$

FACSUML(ARGLIST):=BLOCK(
  [FACTORFLAG:FALSE,PARTSWITCH:TRUE,INFLAG:TRUE,PIECE,
   FARGLIST:FIRST(ARGLIST)],
  IF MATRIXP(FARGLIST)
  THEN MATRIXMAP(LAMBDA([DUM],FACSUML(CONS(DUM,REST(ARGLIST)))),FARGLIST)
  ELSE IF LISTP(FARGLIST) OR INPART(FARGLIST,0)="="
       THEN MAP(LAMBDA([DUM],FACSUML(CONS(DUM,REST(ARGLIST)))),FARGLIST)
       ELSE BLOCK(
  [ARGDUM:REST(ARGLIST),ARGDUM2:[],RATFAC:FALSE],
  DECLARE([ARGDUM,ARGDUM2],SPECIAL),
  SETLIST(ARGSPLIT(FARGLIST,ARGDUM),'ARGDUM,'ARGDUM2),
  FACEXPL(CONS(APPLY('RATSIMP,CONS(FARGLIST,ARGDUM:RATSIMP(ARGDUM))),
	       ARGDUM))))$

/* Functions mainly for internal use */

FACEXP([ARGLIST]):=FACEXPL(ARGLIST)$

NEXTLAYER(EXP):=BLOCK(
  IF NOT NULLLISTP(ARGDUM2)
  THEN IFLOPMAP("*",
		LAMBDA([DUM],FACSUML(CONS(DUM,ARGDUM2))),
		IF NEXTLAYERFACTOR
		THEN AUTOFORM(EXP)
		ELSE EXP)
  ELSE AUTOFORM(EXP))$

FACEXPL(ARGLIST):=BLOCK(
  [EXPDUM:FIRST(ARGLIST),PARTITIONDUM,
   ARGDUM:REST(ARGLIST),NEXTLAYERFACTORSAVE:NEXTLAYERFACTOR,
   NEXTLAYERFACTOR:FALSE,NUMEXPDUM,DENEXPDUM],
  MODEDECLARE(NEXTLAYERFACTORSAVE,BOOLEAN),
  DECLARE([NUMEXPDUM,DENEXPDUM],SPECIAL),
  IF MEMBER('NEXTLAYERFACTOR,ARGLIST)
  THEN (ARGLIST:DELETE('NEXTLAYERFACTOR,ARGLIST),
	NEXTLAYERFACTOR:TRUE)
  ELSE NEXTLAYERFACTOR:NEXTLAYERFACTORSAVE,
  IF NULLLISTP(ARGDUM) OR LENGTH(ARGLIST)<2 OR FREEOFL(REST(ARGLIST),EXPDUM)
  THEN RETURN(NEXTLAYER(EXPDUM)),
  NUMEXPDUM:FACEXPFORM(NUM(EXPDUM)),
  IF (DENEXPDUM:DENOM(EXPDUM))#1 THEN DENEXPDUM:FACEXPFORM(DENOM(EXPDUM)),
  IF INPART(NUMEXPDUM,0)="+"
     AND NOT FREEOFL(ARGDUM,NUMEXPDUM)
     AND NOT FACSUM_COMBINE
  THEN IF DENEXPDUM#1
       THEN (PARTITIONDUM:ORPARTITIONL(NUMEXPDUM,"+",ARGDUM),
	     MULTTHRU(DENEXPDUM^-1,LAST(PARTITIONDUM))+
		DENEXPDUM^-1*FIRST(PARTITIONDUM))
       ELSE NUMEXPDUM
  ELSE NUMEXPDUM*DENEXPDUM^-1)$

FACEXPFORM(EXP):=(
  EXP:OPMAP(EXP,["+",'VPLUS,"*",'VSTAR]),
  IF INPART(EXP,0)="+"
  THEN FACEXPFORM1(EXP)
  ELSE EXP)$

FACEXPFORM1(EXPDUM):=BLOCK(
  [SUBDUM:ZEROSUBST(ARGDUM,EXPDUM)],
  DECLARE(SUBDUM,SPECIAL),
  EXPDUM-SUBDUM+NEXTLAYER(SUBDUM))$

FACEXPTEN([ARGLIST]):=FACEXPTENL(ARGLIST)$

FACTORFACEXPTEN(EXP,[ARGLIST]):=
  IFLOPMAP("*",
	   LAMBDA([FACDUM],FACEXPTENL(CONS(FACDUM,ARGLIST))),
	   AUTOFORM(EXP))$

FACEXPTENL(ARGLIST):=BLOCK(
  [FACEXPTENFLAG:TRUE],
  DECLARE(FACEXPTENFLAG,SPECIAL),
  MODEDECLARE(FACEXPTENFLAG,BOOLEAN),
  FACSUML(APPEND(ARGLIST,LISTOFTENS(FIRST(ARGLIST)))))$

VPLUS(EXP):=BLOCK(
  [VPSDUM:MAP(LAMBDA([TERM],
		     IF NULLLISTP(INTERSECTION(SHOWRATVARS(TERM),ARGDUM))
		     THEN NEXTLAYER(TERM)
		     ELSE OPMAP(TERM,OP_FCN_LIST)),
	      EXP)],
  DECLARE([OP_FCN_LIST,VPSDUM],SPECIAL),
  IF INPART(VPSDUM,0)="+"
  THEN FACEXPFORM1(VPSDUM)
  ELSE VPSDUM)$

VSTAR(EXP):=BLOCK(
  [ARGSEXPDUM:ARGS(EXP),PARTITIONDUM,EXPIARGDUM],
  FOR IARGDUM IN ARGSEXPDUM DO
    IF INPART(IARGDUM,0)="+"
    THEN IF NOT NULLLISTP(INTERSECTION(ARGDUM,SHOWRATVARS(IARGDUM)))
	 THEN (PARTITIONDUM:ORPARTITIONL(FACEXPFORM(IARGDUM),"+",ARGDUM),
	       EXPIARGDUM:IFMULTTHRU(1/IARGDUM,EXP),
	       EXP:IFMULTTHRU(EXPIARGDUM,LAST(PARTITIONDUM))+
			EXPIARGDUM*NEXTLAYER(FIRST(PARTITIONDUM)))
	 ELSE EXP:EXP/IARGDUM*NEXTLAYER(IARGDUM),
  IF INPART(EXP,0)="+"
  THEN FACEXPFORM1(EXP)
  ELSE EXP)$

FPLUS(EXP):=BLOCK(
  DECLARE([LIST,OP_FCN_LIST],SPECIAL),
  IFLOPMAP("+",
	   LAMBDA([DUM],OPMAP(DUM,OP_FCN_LIST)),
	   LISTTOSUM(LDELETE(LIST,ARGS(EXP)))))$

FEXPT(EXP):=BLOCK(
  [IP1EXP:ZEROSUBST(LIST,INPART(EXP,1))],
  DECLARE([LIST,IP1EXP],SPECIAL),
  IF IP1EXP=0
  THEN 0
  ELSE IP1EXP^ZEROSUBST(LIST,INPART(EXP,2)))$

FSTAR(EXP):=BLOCK(
  DECLARE(LIST,SPECIAL),
  IF LDELETE(LIST,ARGS(EXP))=ARGS(EXP)
  THEN MAP(LAMBDA([DUM],OPMAP(DUM,OP_FCN_LIST)),EXP)
  ELSE 0)$

ZEROSUBST(LIST,EXP):=
  IF MEMBER(EXP,LIST)
  THEN 0
  ELSE OPMAP(EXP,["*",'FSTAR,"+",'FPLUS,"^",'FEXPT])$

IFMULTTHRU(EXP1,EXP2):=
  IF INPART(EXP2,0)="+"
  THEN MULTTHRU(EXP1,EXP2)
  ELSE EXP1*EXP2$

Collect&&

COLLECTTEN(EXP):=COLLECTTERMSL(EXP,LISTOFTENS(EXP))$

COLLECTTERMS(EXP,[VARLIST]):=COLLECTTERMSL(EXP,VARLIST)$

COLLECTTERMSL(EXP,VARLIST):=BLOCK(
  [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE],
  APPLY('COLLECTTERMS0,CONS(EXP,ARGSPLIT(EXP,VARLIST))))$

COLLECTTERMS0(EXP,THISLEVELDUM,NEXTLEVELDUM):=BLOCK(
  [IFORP:TRUE,SPLITDUM1,SPLITDUM2,SPLITDUM3,ANSLIST:[],FDUM,
   PREVDUM,LSPLIT3,ANSDUM,LASTDUMSAVE,PREVLASTDUM,
   RTHISLEVELDUM,FTHISLEVELDUM],
  MODEDECLARE(LSPLIT3,FIXNUM),
  DECLARE([FDUM,SPLITDUM3,ANSDUM],SPECIAL),
  IF EXP=0 THEN RETURN(0),
  IF NULLLISTP(THISLEVELDUM) OR FREEOFL(THISLEVELDUM,EXP)
  THEN IF NULLLISTP(NEXTLEVELDUM)
       THEN RETURN(EXP)
       ELSE (SPLITDUM1:ORPARTITIONL(EXP,"+",NEXTLEVELDUM),
	     RETURN(APPLY('COLLECTTERMS,CONS(FIRST(SPLITDUM1),NEXTLEVELDUM))
		    +IFLOPMAP("+",
			      LAMBDA([TERMDUM],
				     APPLY('COLLECTTERMS,
					   CONS(TERMDUM,NEXTLEVELDUM))),
			      LAST(SPLITDUM1)))),
  RTHISLEVELDUM:REST(THISLEVELDUM),
  IF FREEOF(FTHISLEVELDUM:FIRST(THISLEVELDUM),EXP)
  THEN RETURN(COLLECTTERMS0(EXP,RTHISLEVELDUM,NEXTLEVELDUM)),
  SPLITDUM1:ORPARTITIONL(EXP,"+",THISLEVELDUM),
  SPLITDUM2:ORPARTITION(LAST(SPLITDUM1),"+",FTHISLEVELDUM),
  ANSDUM:APPLY('COLLECTTERMS,CONS(FIRST(SPLITDUM1),NEXTLEVELDUM))
	 +COLLECTTERMS0(FIRST(SPLITDUM2),RTHISLEVELDUM,NEXTLEVELDUM),
  IF NOT LOPPLUSP(SPLITDUM3:LAST(SPLITDUM2))
  THEN RETURN(ANSDUM+APPLY('COLLECTTERMS,CONS(SPLITDUM3,NEXTLEVELDUM))),
  SPLITDUM3:SORT(MAPLIST(LAMBDA([TERM],ORPARTITION(TERM,"*",FTHISLEVELDUM)),
		 SPLITDUM3),
		 'ORDERLASTP),
  LSPLIT3:LENGTH(SPLITDUM3)-1,
  PREVLASTDUM:INPART(SPLITDUM3,1,2),
  PREVDUM:INPART(SPLITDUM3,1,1),
  SPLITDUM3:REST(SPLITDUM3),
  FOR IDUM THRU LSPLIT3 DO
       (IF (LASTDUMSAVE:INPART(SPLITDUM3,IDUM,2))=PREVLASTDUM
	THEN PREVDUM:PREVDUM+INPART(SPLITDUM3,IDUM,1)
	ELSE (ANSLIST:ENDCONS([PREVDUM,PREVLASTDUM],ANSLIST),
	      PREVDUM:INPART(SPLITDUM3,IDUM,1),
	      PREVLASTDUM:LASTDUMSAVE),
	IF IDUM=LSPLIT3
	THEN ANSLIST:ENDCONS([PREVDUM,PREVLASTDUM],ANSLIST)),
  LISTTOSUM(MAPLIST(LAMBDA([DUM],
			   IF FREEOFL(RTHISLEVELDUM,FDUM:FIRST(DUM))
			   THEN APPLY('COLLECTTERMS,CONS(FDUM,NEXTLEVELDUM))
				    *LAST(DUM)
			   ELSE MULTTHRUSPLIT(LAST(DUM),
					      COLLECTTERMS0(FDUM,RTHISLEVELDUM,
							    NEXTLEVELDUM),
					      RTHISLEVELDUM)),
		    ANSLIST))+ANSDUM)$

ARGSPLIT(EXP,LIST):=BLOCK(
  [LISTARGSDUM:[],NEWLIST:[]],
  FOR ARG IN LIST DO
      IF LISTP(ARG)
      THEN LISTARGSDUM:APPEND(LISTARGSDUM,ARG)
      ELSE IF OPERATOR0P(ARG)
	   THEN NEWLIST:
		APPEND(NEWLIST,APPLY('LISTOFOPS_NONRAT,CONS(EXP,ARGS(ARG))))
	   ELSE NEWLIST:CONS(ARG,NEWLIST),
  [NEWLIST,LISTARGSDUM])$

MULTTHRUSPLIT(FACTORDUM,SUMDUM,RTHISLEVELDUM):=BLOCK(
  [SPLITDUM1:ORPARTITIONL(SUMDUM,"+",RTHISLEVELDUM)],
  MULTTHRU(FACTORDUM,LAST(SPLITDUM1))+FACTORDUM*FIRST(SPLITDUM1))$

AUTOFORM(EXP):=APPLY(GET('FACSUM,'AUTOMATIC),[EXP])$

IF GET('FACSUM,'AUTOMATIC)=FALSE
THEN PUT('FACSUM,'NONUMFACTOR,'AUTOMATIC)$

SQFRFACSUM([ARGLIST]):=BLOCK(
  [DUM,AUTODUM:GET('FACSUM,'AUTOMATIC)],
  DECLARE([AUTODUM,DUM],SPECIAL),
  PUT('FACSUM,'SQFR,'AUTOMATIC),
  DUM:FACSUML(ARGLIST),
  PUT('FACSUM,AUTODUM,'AUTOMATIC),
  DUM)$

EVAL_WHEN(BATCH,TTYOFF:FALSE)$