Menu
▾
▴
[Maxima-commits] CVS: maxima/share/simplification facex1.mac,1.4,1.5 facexp.mac,1.5,1.6 genut.mac,1.4,1.5 lrats.mac,1.1.1.1,1.2 rncomb.mac,1.1.1.1,1.2 stopex.mac,1.4,1.5
|
From: Viktor T. <vt...@us...> - 2004-11-25 01:46:17
|
Update of /cvsroot/maxima/maxima/share/simplification In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv18815/simplification Modified Files: facex1.mac facexp.mac genut.mac lrats.mac rncomb.mac stopex.mac Log Message: Downcased files that were used by share/tensor Index: facex1.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/simplification/facex1.mac,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- facex1.mac 3 Mar 2004 01:59:11 -0000 1.4 +++ facex1.mac 25 Nov 2004 01:46:05 -0000 1.5 @@ -1,5 +1,5 @@ /* -*- MACSYMA -*- */ -EVAL_WHEN(BATCH,TTYOFF:TRUE)$ +eval_when(batch,ttyoff:true)$ /*ASB;FACEX1 1 4:19pm Monday, 7 February 1983 Split off from FACEXP 15 @@ -10,12 +10,12 @@ THEN (LOAD('[FACEXP,FASL]), LOAD('[GNDECL,FASL])))$ */ -EVAL_WHEN(TRANSLATE, - TRANSCOMPILE:TRUE, - DEFINE_VARIABLE:'MODE, - MODEDECLARE(FUNCTION(NULLLISTP,FREEOFL),BOOLEAN))$ +eval_when(translate, + transcompile:true, + define_variable:'mode, + modedeclare(function(nulllistp,freeofl),boolean))$ -PUT('FACEX1,1,'VERSION)$ +put('facex1,1,'version)$ /* GNU Maxima */ @@ -29,72 +29,72 @@ so don't use it. Use facexp instead. */ eval_when([batch,loadfile], - if get('GNAUTO,'DIAGEVAL_VERSION)=false + if get('gnauto,'diageval_version)=false then load("genut"))$ -COLLECTTEN(EXP):=COLLECTTERMSL(EXP,LISTOFTENS(EXP))$ +collectten(exp):=collecttermsl(exp,listoftens(exp))$ -COLLECTTERMS(EXP,[VARLIST]):=COLLECTTERMSL(EXP,VARLIST)$ +collectterms(exp,[varlist]):=collecttermsl(exp,varlist)$ -COLLECTTERMSL(EXP,VARLIST):=BLOCK( - [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - APPLY('COLLECTTERMS0,CONS(EXP,ARGSPLIT(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), +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(COLLECTTERMSL(FIRST(SPLITDUM1),NEXTLEVELDUM) - +IFLOPMAP("+", - LAMBDA([TERMDUM], - COLLECTTERMSL(TERMDUM,NEXTLEVELDUM)), - LAST(SPLITDUM1)))), - RTHISLEVELDUM:REST(THISLEVELDUM), - IF FREEOF(FTHISLEVELDUM:FIRST(THISLEVELDUM),EXP) - THEN RETURN(COLLECTTERMS0(EXP,RTHISLEVELDUM,NEXTLEVELDUM)), - SPLITDUM1:ORPARTITIONL(EXP,"+",THISLEVELDUM), - SPLITDUM2:ORPARTITIONL(LAST(SPLITDUM1),"+",[FTHISLEVELDUM]), - ANSDUM:COLLECTTERMSL(FIRST(SPLITDUM1),NEXTLEVELDUM) - +COLLECTTERMS0(FIRST(SPLITDUM2),RTHISLEVELDUM,NEXTLEVELDUM), - IF INPART(SPLITDUM3:LAST(SPLITDUM2),0)#"+" - THEN RETURN(ANSDUM+COLLECTTERMSL(SPLITDUM3,NEXTLEVELDUM)), - SPLITDUM3:SORT(MAPLIST(LAMBDA([TERM],ORPARTITIONL(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], /* Maxima: quoted the lambda expression */ - IF FREEOFL(RTHISLEVELDUM,FDUM:FIRST(DUM)) - THEN COLLECTTERMSL(FDUM,NEXTLEVELDUM) - *LAST(DUM) - ELSE MULTTHRUSPLIT(LAST(DUM), - COLLECTTERMS0(FDUM,RTHISLEVELDUM, - NEXTLEVELDUM), - RTHISLEVELDUM)), - ANSLIST))+ANSDUM)$ + 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(collecttermsl(first(splitdum1),nextleveldum) + +iflopmap("+", + lambda([termdum], + collecttermsl(termdum,nextleveldum)), + last(splitdum1)))), + rthisleveldum:rest(thisleveldum), + if freeof(fthisleveldum:first(thisleveldum),exp) + then return(collectterms0(exp,rthisleveldum,nextleveldum)), + splitdum1:orpartitionl(exp,"+",thisleveldum), + splitdum2:orpartitionl(last(splitdum1),"+",[fthisleveldum]), + ansdum:collecttermsl(first(splitdum1),nextleveldum) + +collectterms0(first(splitdum2),rthisleveldum,nextleveldum), + if inpart(splitdum3:last(splitdum2),0)#"+" + then return(ansdum+collecttermsl(splitdum3,nextleveldum)), + splitdum3:sort(maplist(lambda([term],orpartitionl(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], /* Maxima: quoted the lambda expression */ + if freeofl(rthisleveldum,fdum:first(dum)) + then collecttermsl(fdum,nextleveldum) + *last(dum) + else multthrusplit(last(dum), + collectterms0(fdum,rthisleveldum, + nextleveldum), + rthisleveldum)), + anslist))+ansdum)$ -ORDERLASTP(EXP1,EXP2):=ORDERLESSP(LAST(EXP1),LAST(EXP2))$ +orderlastp(exp1,exp2):=orderlessp(last(exp1),last(exp2))$ -MULTTHRUSPLIT(FACTORDUM,SUMDUM,RTHISLEVELDUM):=BLOCK( - [SPLITDUM1:ORPARTITIONL(SUMDUM,"+",RTHISLEVELDUM)], - MULTTHRU(FACTORDUM,LAST(SPLITDUM1))+FACTORDUM*FIRST(SPLITDUM1))$ +multthrusplit(factordum,sumdum,rthisleveldum):=block( + [splitdum1:orpartitionl(sumdum,"+",rthisleveldum)], + multthru(factordum,last(splitdum1))+factordum*first(splitdum1))$ -EVAL_WHEN(BATCH,TTYOFF:FALSE)$ +eval_when(batch,ttyoff:false)$ Index: facexp.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/simplification/facexp.mac,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- facexp.mac 3 Mar 2004 01:59:11 -0000 1.5 +++ facexp.mac 25 Nov 2004 01:46:05 -0000 1.6 @@ -1,5 +1,5 @@ /* -*- MACSYMA -*- */ -EVAL_WHEN(BATCH,TTYOFF:TRUE)$ +eval_when(batch,ttyoff:true)$ /*ASB;FACEXP 10 2:37pm Wednesday, 4 November 1981 */ @@ -46,32 +46,32 @@ /* Commented out all local SPECIAL declarations. -wj */ eval_when([batch,loadfile], - if get('GNAUTO,'DIAGEVAL_VERSION)=false + if get('gnauto,'diageval_version)=false then load("genut"))$ eval_when(translate, - declare_translated(OPERATOR0P,MULTTHRUSPLIT,LOPPLUSP,ORPARTITION, - COLLECTTERMS0,COLLECTTERMSL,LDELETE,LISTTOSUM, - IFMULTTHRU,INTERSECTION,ZEROSUBST,FACEXPFORM1, - OPMAP,ORPARTITIONL,FACEXPFORM,FREEOFL,NEXTLAYER, - IFLOPMAP,FACEXPL,ARGSPLIT,SETLIST,FACSUML, - NULLLISTP,AUTOFORM), - mode_declare(function(NULLLISTP,FREEOFL),boolean))$ + declare_translated(operator0p,multthrusplit,lopplusp,orpartition, + collectterms0,collecttermsl,ldelete,listtosum, + ifmultthru,intersection,zerosubst,facexpform1, + opmap,orpartitionl,facexpform,freeofl,nextlayer, + iflopmap,facexpl,argsplit,setlist,facsuml, + nulllistp,autoform), + mode_declare(function(nulllistp,freeofl),boolean))$ /* Variable definitions */ -define_variable(NEXTLAYERFACTOR,false,boolean)$ -define_variable(FACSUM_COMBINE,true,boolean)$ +define_variable(nextlayerfactor,false,boolean)$ +define_variable(facsum_combine,true,boolean)$ /* Predicates */ -LOPPLUSP(EXP):=IS(INPART(EXP,0)="+")$ +lopplusp(exp):=is(inpart(exp,0)="+")$ -OPERATOR0P(EXP):=BLOCK( - [IP0DUM], - IS((IP0DUM:INPART(EXP,0))='OPERATOR OR IP0DUM=NOUNIFY('OPERATOR)))$ +operator0p(exp):=block( + [ip0dum], + is((ip0dum:inpart(exp,0))='operator or ip0dum=nounify('operator)))$ -ORDERLASTP(EXP1,EXP2):=ORDERLESSP(LAST(EXP1),LAST(EXP2))$ +orderlastp(exp1,exp2):=orderlessp(last(exp1),last(exp2))$ /* User accessible functions */ /* @@ -79,83 +79,83 @@ [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)))$ +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)$ +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], +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))))$ + 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)$ +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))$ +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), +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)$ + 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)$ +facexpform(exp):=( + exp:opmap(exp,["+",'vplus,"*",'vstar]), + if inpart(exp,0)="+" + then facexpform1(exp) + else exp)$ -FACEXPFORM1(EXPDUM):=BLOCK( - [SUBDUM:ZEROSUBST(ARGDUM,EXPDUM)], +facexpform1(expdum):=block( + [subdum:zerosubst(argdum,expdum)], /* DECLARE(SUBDUM,SPECIAL), */ - EXPDUM-SUBDUM+NEXTLAYER(SUBDUM))$ + expdum-subdum+nextlayer(subdum))$ /* FACEXPTEN([ARGLIST]):=FACEXPTENL(ARGLIST)$ @@ -167,154 +167,154 @@ FACEXPTENL(ARGLIST):=BLOCK( [FACEXPTENFLAG:TRUE], /* DECLARE(FACEXPTENFLAG,SPECIAL), */ - MODEDECLARE(FACEXPTENFLAG,BOOLEAN), - FACSUML(APPEND(ARGLIST,LISTOFTENS(FIRST(ARGLIST)))))$ + 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)], +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)$ + 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)$ +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( +fplus(exp):=block( /* DECLARE([LIST,OP_FCN_LIST],SPECIAL), */ - IFLOPMAP("+", - LAMBDA([DUM],OPMAP(DUM,OP_FCN_LIST)), - LISTTOSUM(LDELETE(LIST,ARGS(EXP)))))$ + iflopmap("+", + lambda([dum],opmap(dum,op_fcn_list)), + listtosum(ldelete(list,args(exp)))))$ -FEXPT(EXP):=BLOCK( - [IP1EXP:ZEROSUBST(LIST,INPART(EXP,1))], +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)))$ + if ip1exp=0 + then 0 + else ip1exp^zerosubst(list,inpart(exp,2)))$ -FSTAR(EXP):=BLOCK( +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)$ + 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])$ +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$ +ifmultthru(exp1,exp2):= + if inpart(exp2,0)="+" + then multthru(exp1,exp2) + else exp1*exp2$ -Collect&& +collect&& /* COLLECTTEN(EXP):=COLLECTTERMSL(EXP,LISTOFTENS(EXP))$ */ -COLLECTTERMS(EXP,[VARLIST]):=COLLECTTERMSL(EXP,VARLIST)$ +collectterms(exp,[varlist]):=collecttermsl(exp,varlist)$ -COLLECTTERMSL(EXP,VARLIST):=BLOCK( - [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - APPLY('COLLECTTERMS0,CONS(EXP,ARGSPLIT(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:[], - PREVDUM,LSPLIT3,ANSDUM,LASTDUMSAVE,PREVLASTDUM, - RTHISLEVELDUM,FTHISLEVELDUM], - MODEDECLARE(LSPLIT3,FIXNUM), +collectterms0(exp,thisleveldum,nextleveldum):=block( + [iforp:true,splitdum1,splitdum2,splitdum3,anslist:[], + prevdum,lsplit3,ansdum,lastdumsave,prevlastdum, + rthisleveldum,fthisleveldum], + modedeclare(lsplit3,fixnum), /* DECLARE([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(COLLECTTERMSL(FIRST(SPLITDUM1),NEXTLEVELDUM) - +IFLOPMAP("+", - LAMBDA([TERMDUM], - COLLECTTERMSL(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:COLLECTTERMSL(FIRST(SPLITDUM1),NEXTLEVELDUM) - +COLLECTTERMS0(FIRST(SPLITDUM2),RTHISLEVELDUM,NEXTLEVELDUM), - IF NOT LOPPLUSP(SPLITDUM3:LAST(SPLITDUM2)) - THEN RETURN(ANSDUM+COLLECTTERMSL(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,FIRST(DUM)) - THEN COLLECTTERMSL(first(DUM),NEXTLEVELDUM) - *LAST(DUM) - ELSE MULTTHRUSPLIT(LAST(DUM), - COLLECTTERMS0(first(DUM),RTHISLEVELDUM, - NEXTLEVELDUM), - RTHISLEVELDUM)), - ANSLIST))+ANSDUM)$ + 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(collecttermsl(first(splitdum1),nextleveldum) + +iflopmap("+", + lambda([termdum], + collecttermsl(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:collecttermsl(first(splitdum1),nextleveldum) + +collectterms0(first(splitdum2),rthisleveldum,nextleveldum), + if not lopplusp(splitdum3:last(splitdum2)) + then return(ansdum+collecttermsl(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,first(dum)) + then collecttermsl(first(dum),nextleveldum) + *last(dum) + else multthrusplit(last(dum), + collectterms0(first(dum),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])$ +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))$ +multthrusplit(factordum,sumdum,rthisleveldum):=block( + [splitdum1:orpartitionl(sumdum,"+",rthisleveldum)], + multthru(factordum,last(splitdum1))+factordum*first(splitdum1))$ -AUTOFORM(exp) := - block([fun:get('FACSUM,'AUTOMATIC)], +autoform(exp) := + block([fun:get('facsum,'automatic)], if not member('noun,apply('properties,[fun])) then apply(fun,[exp]) else apply(nounify(fun),[exp]))$ -IF GET('FACSUM,'AUTOMATIC)=FALSE -THEN PUT('FACSUM,'NONUMFACTOR,'AUTOMATIC)$ +if get('facsum,'automatic)=false +then put('facsum,'nonumfactor,'automatic)$ -SQFRFACSUM([ARGLIST]):=BLOCK( - [DUM,AUTODUM:GET('FACSUM,'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)$ + put('facsum,'sqfr,'automatic), + dum:facsuml(arglist), + put('facsum,autodum,'automatic), + dum)$ -EVAL_WHEN(BATCH,TTYOFF:FALSE)$ +eval_when(batch,ttyoff:false)$ Index: genut.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/simplification/genut.mac,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- genut.mac 3 Mar 2004 01:59:11 -0000 1.4 +++ genut.mac 25 Nov 2004 01:46:05 -0000 1.5 @@ -54,18 +54,18 @@ and foo to |$foo|). */ eval_when(translate, - declare_translated(ORPARTITION,ORPARTITIONL,NONUMFACTOR, - genut_prodmap,listofops_nonratl,SETLIST, - PREDPARTITION), - mode_declare(function(NULLLISTP,FREEOFL,ZEROLISTP,LCPRED),boolean))$ + declare_translated(orpartition,orpartitionl,nonumfactor, + genut_prodmap,listofops_nonratl,setlist, + predpartition), + mode_declare(function(nulllistp,freeofl,zerolistp,lcpred),boolean))$ -NULLLISTP(exp) := +nulllistp(exp) := is(exp=[])$ -ZEROLISTP(list) := +zerolistp(list) := catch(for exp in list do if exp#0 then throw(false),true)$ -FREEOFL(varl,exp) := +freeofl(varl,exp) := catch(for var in varl do if not freeof(var,exp) then throw(false),true)$ /* Note that PARTITION(EXP,VAR) gives an error when EXP is atomic. @@ -76,7 +76,7 @@ coerced to have OP as main operator. Otherwise this function behaves just like PARTITION. */ -ORPARTITION(exp,op,var) := +orpartition(exp,op,var) := if not(atom(exp)) and inpart(exp,0)=op then partition(exp,var) else if freeof(var,exp) @@ -85,35 +85,35 @@ /* Same thing for a list of variables. */ -ORPARTITIONL(exp,op,varl) := +orpartitionl(exp,op,varl) := block([free,notfree,partit], free:exp, notfree:apply(op,[]), for var in varl do - (partit:ORPARTITION(free,op,var), + (partit:orpartition(free,op,var), free:first(partit), notfree:if op="[" then append(notfree,last(partit)) else apply(op,[notfree,last(partit)])), [free,notfree])$ -ORPARTITIONLIST(list,op,[vars]) := - block([partitl:map(lambda([exp],ORPARTITIONL(exp,op,vars)),list)], +orpartitionlist(list,op,[vars]) := + block([partitl:map(lambda([exp],orpartitionl(exp,op,vars)),list)], [map('first,partitl),map('last,partitl)])$ -LDELETE(varl,exp) := +ldelete(varl,exp) := (for var in varl do exp:delete(var,exp),exp)$ -LISTTOSUM(list) := +listtosum(list) := apply("+",list)$ -LISTTOPROD(list) := +listtoprod(list) := apply("*",list)$ /* The following mimics the behaviour of APPEND. Note, however, that INTERSECTION takes exactly two arguments */ -INTERSECTION(exp1,exp2) := +intersection(exp1,exp2) := (if atom(exp1) then error(concat("argument value `", exp1, "' to INTERSECTION was atomic")), if atom(exp2) @@ -127,10 +127,10 @@ then cap:endcons(term,cap), apply(op,cap))))$ -SETLIST(lst,l1,l2) := +setlist(lst,l1,l2) := (l1::first(lst),l2::last(lst))$ -NONUMFACTOR(exp) := +nonumfactor(exp) := if numberp(exp) then exp else factor(exp)$ @@ -140,8 +140,8 @@ this function to be called instead of NONUMFACTOR by setting FACSUM's AUTOMATIC property: put('facsum,'nonumfactor_alt,'automatic) */ -NONUMFACTOR_ALT(exp) := - block([dum:NONUMFACTOR(exp)], +nonumfactor_alt(exp) := + block([dum:nonumfactor(exp)], if atom(dum) or inpart(dum,0)="+" then exp else dum)$ @@ -154,16 +154,16 @@ /* LST is an alternating list of operators and associated functions. OP_FCN_LIST is used to pass LST to recursive calls to OPMAP. */ -OPMAP(exp,lst) := +opmap(exp,lst) := if atom(exp) then exp else block([fun:?getf(?cdr(lst),inpart(exp,0))], if fun#false - then block([OP_FCN_LIST:lst], + then block([op_fcn_list:lst], apply(fun,[exp])) else exp)$ -IFLOPMAP(op,fun,exp) := +iflopmap(op,fun,exp) := if op="*" then genut_prodmap(fun,exp) else if atom(exp) @@ -185,7 +185,7 @@ /* Returns a list of the sub-expressions of EXP which have one of the operators in OPL as main operator. */ -LISTOFOPS_NONRAT(exp,[opl]) := +listofops_nonrat(exp,[opl]) := listofops_nonratl(exp,opl,[])$ listofops_nonratl(exp,opl,lst) := @@ -200,41 +200,41 @@ returns it as first element COMMON of a list. The second element is a list OTHER such that EXPL = COMMON * OTHER. */ -EXPLICITFACTOR(expl) := +explicitfactor(expl) := block([vars:map(lambda([dum],?gensym()),expl),common,other], - SETLIST(ORPARTITIONL(factor(expl . vars),"*",vars),'common,'other), + setlist(orpartitionl(factor(expl . vars),"*",vars),'common,'other), [common,map(lambda([var],coeff(other,var)),vars)])$ /* Don't ask. It's only used once, in declin.mac. */ -LCPRED(linp,is_op,exp) := +lcpred(linp,is_op,exp) := if atom(exp) then false else if apply(is_op,[exp]) then true else if inpart(exp,0)="*" - then is(length(last(PREDPARTITION(exp,is_op)))=1) + then is(length(last(predpartition(exp,is_op)))=1) else if inpart(exp,0)="+" - then is(first(PREDPARTITION(exp,linp))=[]) + then is(first(predpartition(exp,linp))=[]) else false$ /* The following two functions are copied from rncomb.mac */ -RLOIEWL(OP,EXP):=BLOCK( - [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - IF INPART(EXP,0)=OP - THEN ARGS(EXP) - ELSE [EXP])$ +rloiewl(op,exp):=block( + [partswitch:true,inflag:true,piece], + if inpart(exp,0)=op + then args(exp) + else [exp])$ -PREDPARTITION(LIST,PREDICATE):=BLOCK( - [NOLIST:[],YESLIST:[]], - FOR IDUM IN REVERSE(LIST) DO - IF MODE_IDENTITY(BOOLEAN,APPLY(PREDICATE,[IDUM])) - THEN YESLIST:CONS(IDUM,YESLIST) - ELSE NOLIST:CONS(IDUM,NOLIST), - [NOLIST,YESLIST])$ +predpartition(list,predicate):=block( + [nolist:[],yeslist:[]], + for idum in reverse(list) do + if mode_identity(boolean,apply(predicate,[idum])) + then yeslist:cons(idum,yeslist) + else nolist:cons(idum,nolist), + [nolist,yeslist])$ /* a sort of `provide' */ -put('GNAUTO,true,'DIAGEVAL_VERSION)$ +put('gnauto,true,'diageval_version)$ /* genut.mac ends here */ Index: lrats.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/simplification/lrats.mac,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- lrats.mac 8 May 2000 06:09:43 -0000 1.1.1.1 +++ lrats.mac 25 Nov 2004 01:46:05 -0000 1.2 @@ -1,5 +1,5 @@ /* -*- MACSYMA -*- */ -EVAL_WHEN(BATCH,TTYOFF:TRUE)$ +eval_when(batch,ttyoff:true)$ /*ASB;LRATS 3 5:05pm Tuesday, 14 July 1981 7:53pm Saturday, 29 May 1982 @@ -8,66 +8,66 @@ Changed loadflags to getversions, DEFINE_VARIABLE:'MODE. */ -EVAL_WHEN(TRANSLATE, - DEFINE_VARIABLE:'MODE, - TRANSCOMPILE:TRUE)$ +eval_when(translate, + define_variable:'mode, + transcompile:true)$ -PUT('LRATS,3,'DIAGEVAL_VERSION)$ +put('lrats,3,'diageval_version)$ -DEFINE_VARIABLE(MESSLRATS2,"Invalid argument to FULLRATSUBST:",ANY)$ +define_variable(messlrats2,"Invalid argument to FULLRATSUBST:",any)$ -DEFINE_VARIABLE(FULLRATSUBSTFLAG,FALSE,BOOLEAN)$ +define_variable(fullratsubstflag,false,boolean)$ -LRATSUBST(LISTOFEQNS,EXP):=BLOCK( - [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - IF NOT LISTP(LISTOFEQNS) - THEN IF INPART(LISTOFEQNS,0)="=" - THEN LISTOFEQNS:[LISTOFEQNS] - ELSE IF FULLRATSUBSTFLAG=TRUE - THEN ERROR(MESSLRATS2,[LISTOFEQNS,EXP]) - ELSE ERROR("Invalid argument to LRATSUBST:",[LISTOFEQNS,EXP]), - FOR IDUM IN LISTOFEQNS DO - IF INPART(IDUM,0)#"=" - THEN IF FULLRATSUBSTFLAG=TRUE - THEN ERROR(MESSLRATS2,[LISTOFEQNS,EXP]) - ELSE ERROR("Invalid argument to LRATSUBST:",[LISTOFEQNS,EXP]), - LRATSUBST1(LISTOFEQNS,EXP))$ +lratsubst(listofeqns,exp):=block( + [partswitch:true,inflag:true,piece], + if not listp(listofeqns) + then if inpart(listofeqns,0)="=" + then listofeqns:[listofeqns] + else if fullratsubstflag=true + then error(messlrats2,[listofeqns,exp]) + else error("Invalid argument to LRATSUBST:",[listofeqns,exp]), + for idum in listofeqns do + if inpart(idum,0)#"=" + then if fullratsubstflag=true + then error(messlrats2,[listofeqns,exp]) + else error("Invalid argument to LRATSUBST:",[listofeqns,exp]), + lratsubst1(listofeqns,exp))$ -LRATSUBST1(LISTOFEQNS,EXP):=BLOCK( - [DUM:IF LISTOFEQNS=[] - THEN EXP - ELSE IF REST(LISTOFEQNS)=[] - THEN RATSUBST(INPART(LISTOFEQNS,1,2),INPART(LISTOFEQNS,1,1),EXP) - ELSE LRATSUBST1(REST(LISTOFEQNS), - IF FULLRATSUBSTFLAG=TRUE - THEN FULLRATSUBST1(INPART(LISTOFEQNS,1,2), - INPART(LISTOFEQNS,1,1), - EXP) - ELSE RATSUBST(INPART(LISTOFEQNS,1,2), - INPART(LISTOFEQNS,1,1), - EXP))], - DECLARE(DUM,SPECIAL), - IF FULLRATSUBSTFLAG=TRUE AND DUM#EXP - THEN LRATSUBST1(LISTOFEQNS,DUM) - ELSE IF DUM#EXP - THEN DUM - ELSE EXP)$ +lratsubst1(listofeqns,exp):=block( + [dum:if listofeqns=[] + then exp + else if rest(listofeqns)=[] + then ratsubst(inpart(listofeqns,1,2),inpart(listofeqns,1,1),exp) + else lratsubst1(rest(listofeqns), + if fullratsubstflag=true + then fullratsubst1(inpart(listofeqns,1,2), + inpart(listofeqns,1,1), + exp) + else ratsubst(inpart(listofeqns,1,2), + inpart(listofeqns,1,1), + exp))], + declare(dum,special), + if fullratsubstflag=true and dum#exp + then lratsubst1(listofeqns,dum) + else if dum#exp + then dum + else exp)$ -FULLRATSUBST1(SUBSTEXP,FOREXP,EXP):=BLOCK( - [DUM:RATSUBST(SUBSTEXP,FOREXP,EXP)], - IF DUM=EXP - THEN EXP - ELSE FULLRATSUBST1(SUBSTEXP,FOREXP,DUM))$ +fullratsubst1(substexp,forexp,exp):=block( + [dum:ratsubst(substexp,forexp,exp)], + if dum=exp + then exp + else fullratsubst1(substexp,forexp,dum))$ -FULLRATSUBST([ARGLIST]):=BLOCK( - [FULLRATSUBSTFLAG:TRUE,LARGLISTDUM:LENGTH(ARGLIST),FARGLIST, - PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - IF LARGLISTDUM=2 - THEN IF LISTP(FARGLIST:FIRST(ARGLIST)) OR INPART(FARGLIST,0)="=" - THEN LRATSUBST(FARGLIST,LAST(ARGLIST)) - ELSE ERROR(MESSLRATS2,ARGLIST) - ELSE IF LARGLISTDUM=3 - THEN APPLY('FULLRATSUBST1,ARGLIST) - ELSE ERROR(MESSLRATS2,ARGLIST))$ +fullratsubst([arglist]):=block( + [fullratsubstflag:true,larglistdum:length(arglist),farglist, + partswitch:true,inflag:true,piece], + if larglistdum=2 + then if listp(farglist:first(arglist)) or inpart(farglist,0)="=" + then lratsubst(farglist,last(arglist)) + else error(messlrats2,arglist) + else if larglistdum=3 + then apply('fullratsubst1,arglist) + else error(messlrats2,arglist))$ -EVAL_WHEN(BATCH,TTYOFF:FALSE)$ +eval_when(batch,ttyoff:false)$ Index: rncomb.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/simplification/rncomb.mac,v retrieving revision 1.1.1.1 retrieving revision 1.2 diff -u -d -r1.1.1.1 -r1.2 --- rncomb.mac 8 May 2000 06:09:43 -0000 1.1.1.1 +++ rncomb.mac 25 Nov 2004 01:46:05 -0000 1.2 @@ -1,5 +1,5 @@ /* -*-Macsyma-*- */ -EVAL_WHEN(BATCH,TTYOFF:TRUE)$ +eval_when(batch,ttyoff:true)$ /*ASB;RNCOMB 2 12:32pm Friday, 14 January 1983 Created. @@ -10,62 +10,62 @@ LCM name changed to LCM_L to avoid name conflict with LCM in SHARE;FUNCTS > */ -EVAL_WHEN(TRANSLATE, - TRANSCOMPILE:TRUE, - DEFINE_VARIABLE:'MODE)$ +eval_when(translate, + transcompile:true, + define_variable:'mode)$ -PUT('RNCOMB,2,'VERSION)$ +put('rncomb,2,'version)$ -RNCOMBINE(EXP):=BLOCK( - [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE,PFEFORMAT:TRUE], - EXP:RLOIEWL("+",COMBINE(EXP)), - PFEFORMAT:FALSE, - RNCOMBINE1(EXP))$ +rncombine(exp):=block( + [partswitch:true,inflag:true,piece,pfeformat:true], + exp:rloiewl("+",combine(exp)), + pfeformat:false, + rncombine1(exp))$ -LCM_L(LIST):= - IF LIST=[] - THEN 1 - ELSE BLOCK([RLIST:REST(LIST),FLIST:FIRST(LIST),FRLIST, - PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - IF RLIST=[] - THEN FLIST - ELSE LCM_L(CONS(FLIST*(FRLIST:FIRST(RLIST))/GCD(FLIST,FRLIST), - REST(RLIST))))$ +lcm_l(list):= + if list=[] + then 1 + else block([rlist:rest(list),flist:first(list),frlist, + partswitch:true,inflag:true,piece], + if rlist=[] + then flist + else lcm_l(cons(flist*(frlist:first(rlist))/gcd(flist,frlist), + rest(rlist))))$ -RNCOMBINE1(LIST):=BLOCK( - [FLIST,SPLITDUM,LSPLITDUM,FLIST_DENOM], - IF LIST=[] THEN RETURN(0), - FLIST:FIRST(LIST), - IF LENGTH(LIST)=1 - THEN RETURN(IF INPART(NUM(FLIST),0)="+" - THEN RNCOMBINE1(ARGS(NUM(FLIST)))/DENOM(FLIST) - ELSE FLIST), - FLIST_DENOM:(FLIST_DENOM:DENOM(FLIST))/NUMFACTOR(FLIST_DENOM), - FLIST:FLIST*FLIST_DENOM, - SPLITDUM:PREDPARTITION(REST(LIST), - LAMBDA([DUM],NUMBERP(DENOM(DUM)/FLIST_DENOM))), - IF (LSPLITDUM:LAST(SPLITDUM))#[] - THEN FLIST:DENOMTHRU(CONS(FLIST,LSPLITDUM*FLIST_DENOM))/FLIST_DENOM, - FLIST+RNCOMBINE1(FIRST(SPLITDUM)))$ +rncombine1(list):=block( + [flist,splitdum,lsplitdum,flist_denom], + if list=[] then return(0), + flist:first(list), + if length(list)=1 + then return(if inpart(num(flist),0)="+" + then rncombine1(args(num(flist)))/denom(flist) + else flist), + flist_denom:(flist_denom:denom(flist))/numfactor(flist_denom), + flist:flist*flist_denom, + splitdum:predpartition(rest(list), + lambda([dum],numberp(denom(dum)/flist_denom))), + if (lsplitdum:last(splitdum))#[] + then flist:denomthru(cons(flist,lsplitdum*flist_denom))/flist_denom, + flist+rncombine1(first(splitdum)))$ -DENOMTHRU(EXP):=BLOCK( - [LCMDUM:LCM_L(MAPLIST('DENOM,EXP))], - APPLY("+",LCMDUM*EXP)/LCMDUM)$ +denomthru(exp):=block( + [lcmdum:lcm_l(maplist('denom,exp))], + apply("+",lcmdum*exp)/lcmdum)$ /* Functions from DGVAL;GENUT FASL: */ -RLOIEWL(OP,EXP):=BLOCK( - [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - IF INPART(EXP,0)=OP - THEN ARGS(EXP) - ELSE [EXP])$ +rloiewl(op,exp):=block( + [partswitch:true,inflag:true,piece], + if inpart(exp,0)=op + then args(exp) + else [exp])$ -PREDPARTITION(LIST,PREDICATE):=BLOCK( - [NOLIST:[],YESLIST:[]], - FOR IDUM IN REVERSE(LIST) DO - IF MODE_IDENTITY(BOOLEAN,APPLY(PREDICATE,[IDUM])) - THEN YESLIST:CONS(IDUM,YESLIST) - ELSE NOLIST:CONS(IDUM,NOLIST), - [NOLIST,YESLIST])$ +predpartition(list,predicate):=block( + [nolist:[],yeslist:[]], + for idum in reverse(list) do + if mode_identity(boolean,apply(predicate,[idum])) + then yeslist:cons(idum,yeslist) + else nolist:cons(idum,nolist), + [nolist,yeslist])$ -EVAL_WHEN(BATCH,TTYOFF:FALSE)$ +eval_when(batch,ttyoff:false)$ Index: stopex.mac =================================================================== RCS file: /cvsroot/maxima/maxima/share/simplification/stopex.mac,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- stopex.mac 3 Mar 2004 01:59:11 -0000 1.4 +++ stopex.mac 25 Nov 2004 01:46:05 -0000 1.5 @@ -1,5 +1,5 @@ /* -*-Macsyma-*- */ -EVAL_WHEN(BATCH,TTYOFF:TRUE)$ +eval_when(batch,ttyoff:true)$ /*ASB;STOPEX 15 2:48pm Wednesday, 4 November 1981 7:55pm Saturday, 29 May 1982 @@ -8,12 +8,12 @@ Changed loadflags to getversions, DEFINE_VARIABLE:'MODE. */ -EVAL_WHEN(TRANSLATE, - TRANSCOMPILE:TRUE, - DEFINE_VARIABLE:'MODE, - MODEDECLARE(FUNCTION(FREEOFL),BOOLEAN))$ +eval_when(translate, + transcompile:true, + define_variable:'mode, + modedeclare(function(freeofl),boolean))$ -PUT('STOPEX,15,'DIAGEVAL_VERSION)$ +put('stopex,15,'diageval_version)$ /* EVAL_WHEN([BATCH,LOADFILE], IF GET('GNAUTO,'DIAGEVAL_VERSION)=FALSE @@ -26,152 +26,152 @@ search for `Maxima:' below. -wj */ eval_when([batch,loadfile], - if get('GNAUTO,'DIAGEVAL_VERSION)=false + if get('gnauto,'diageval_version)=false then load("genut"))$ eval_when(translate, - declare_translated(EXWRT_POWER1,VARMULT,DISTRIBUTE,EXWRT_POWER, - FREEOFL,STOPEXPANDL1,ORPARTITIONL,LDELETE, - STOPEXPANDL))$ + declare_translated(exwrt_power1,varmult,distribute,exwrt_power, + freeofl,stopexpandl1,orpartitionl,ldelete, + stopexpandl))$ /* Switches */ -DEFINE_VARIABLE(IFORP,FALSE,BOOLEAN)$ -DEFINE_VARIABLE(EXPANDWRT_DENOM,FALSE,BOOLEAN)$ -DEFINE_VARIABLE(EXPANDWRT_NONRAT,TRUE,BOOLEAN)$ +define_variable(iforp,false,boolean)$ +define_variable(expandwrt_denom,false,boolean)$ +define_variable(expandwrt_nonrat,true,boolean)$ -STOPEXPAND(EXP,[VARLIST]):= - IF ATOM(EXP) OR MAPATOM(EXP) - THEN EXP - ELSE BLOCK([PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - STOPEXPANDL(EXP,VARLIST))$ +stopexpand(exp,[varlist]):= + if atom(exp) or mapatom(exp) + then exp + else block([partswitch:true,inflag:true,piece], + stopexpandl(exp,varlist))$ -EXPANDWRT(EXP,[VARLIST]):= - IF ATOM(EXP) OR MAPATOM(EXP) - THEN EXP - ELSE BLOCK([PARTSWITCH:TRUE,INFLAG:TRUE,PIECE], - STOPEXPANDL(EXP,VARLIST))$ +expandwrt(exp,[varlist]):= + if atom(exp) or mapatom(exp) + then exp + else block([partswitch:true,inflag:true,piece], + stopexpandl(exp,varlist))$ -EXPANDWRTL(EXP,VARLIST):=STOPEXPANDL(EXP,VARLIST)$ +expandwrtl(exp,varlist):=stopexpandl(exp,varlist)$ -STOPEXPANDL(EXP,VARLIST):= - IF ATOM(EXP) OR MAPATOM(EXP) - THEN EXP - ELSE BLOCK([INFLAG:TRUE,PARTSWITCH:TRUE,PIECE,IP0DUM], - IF (IP0DUM:INPART(EXP,0))="+" - THEN MAP(LAMBDA([TERMDUM],STOPEXPANDL(TERMDUM,VARLIST)),EXP) - ELSE BLOCK( - [NONRATDUM,IFORP:TRUE,DENDUM], - IF EXPANDWRT_NONRAT - THEN (NONRATDUM: - LDELETE(VARLIST,LAST(ORPARTITIONL(SHOWRATVARS(EXP),"[",VARLIST))), - FOR IDUM IN NONRATDUM DO - IF NOT ATOM(IDUM) - THEN EXP:SUBST(MAP(LAMBDA([DUM],STOPEXPANDL(DUM,VARLIST)),IDUM), - IDUM,EXP)), - IF EXPANDWRT_DENOM AND (DENDUM:DENOM(EXP))#1 - THEN EXP:NUM(EXP)/STOPEXPANDL(DENDUM,VARLIST), - STOPEXPANDL1(EXP,VARLIST)))$ +stopexpandl(exp,varlist):= + if atom(exp) or mapatom(exp) + then exp + else block([inflag:true,partswitch:true,piece,ip0dum], + if (ip0dum:inpart(exp,0))="+" + then map(lambda([termdum],stopexpandl(termdum,varlist)),exp) + else block( + [nonratdum,iforp:true,dendum], + if expandwrt_nonrat + then (nonratdum: + ldelete(varlist,last(orpartitionl(showratvars(exp),"[",varlist))), + for idum in nonratdum do + if not atom(idum) + then exp:subst(map(lambda([dum],stopexpandl(dum,varlist)),idum), + idum,exp)), + if expandwrt_denom and (dendum:denom(exp))#1 + then exp:num(exp)/stopexpandl(dendum,varlist), + stopexpandl1(exp,varlist)))$ -STOPEXPANDL1(EXP,VARLIST):= - IF ATOM(EXP) OR MAPATOM(EXP) - THEN EXP - ELSE BLOCK([IP0DUM:INPART(EXP,0),DUM:1,VARFOUND:FALSE], - MODEDECLARE(VARFOUND,BOOLEAN), - IF FREEOFL(VARLIST,EXP) - THEN EXP - ELSE IF FREEOF("+",EXP) THEN RETURN(EXP), - IF IP0DUM="+" - THEN RETURN(MAP(LAMBDA([TERMDUM], - STOPEXPANDL1(TERMDUM,VARLIST)),EXP)) - ELSE IF IP0DUM="^" - THEN IF INPART(EXP,1,0)="+" - THEN EXWRT_POWER(EXP,VARLIST) - ELSE EXP - ELSE IF IP0DUM="*" - THEN (FOR IDUM IN EXP DO - IF NOT FREEOFL(VARLIST,IDUM) - THEN (IDUM:STOPEXPANDL1(IDUM,VARLIST), - IF VARFOUND - THEN DUM:DISTRIBUTE(DUM,IDUM,VARLIST) - ELSE (VARFOUND:TRUE, - DUM:VARMULT(DUM,IDUM,VARLIST))) - ELSE IF VARFOUND - THEN DUM:VARMULT(IDUM,DUM,VARLIST) - ELSE DUM:DUM*IDUM, - DUM) - ELSE IF MATRIXP(EXP) OR LISTP(EXP) - THEN MATRIXMAP(LAMBDA([DUMM], - STOPEXPANDL1(DUMM,VARLIST)), - EXP) - ELSE IF IP0DUM="." AND EXPANDWRT_NONRAT - THEN REMOVE_NESTED_DOTS0L(MAP(LAMBDA([DUM], - STOPEXPANDL1(DUM, - VARLIST)), - EXP), - VARLIST) - ELSE EXP)$ +stopexpandl1(exp,varlist):= + if atom(exp) or mapatom(exp) + then exp + else block([ip0dum:inpart(exp,0),dum:1,varfound:false], + modedeclare(varfound,boolean), + if freeofl(varlist,exp) + then exp + else if freeof("+",exp) then return(exp), + if ip0dum="+" + then return(map(lambda([termdum], + stopexpandl1(termdum,varlist)),exp)) + else if ip0dum="^" + then if inpart(exp,1,0)="+" + then exwrt_power(exp,varlist) + else exp + else if ip0dum="*" + then (for idum in exp do + if not freeofl(varlist,idum) + then (idum:stopexpandl1(idum,varlist), + if varfound + then dum:distribute(dum,idum,varlist) + else (varfound:true, + dum:varmult(dum,idum,varlist))) + else if varfound + then dum:varmult(idum,dum,varlist) + else dum:dum*idum, + dum) + else if matrixp(exp) or listp(exp) + then matrixmap(lambda([dumm], + stopexpandl1(dumm,varlist)), + exp) + else if ip0dum="." and expandwrt_nonrat + then remove_nested_dots0l(map(lambda([dum], + stopexpandl1(dum, + varlist)), + exp), + varlist) + else exp)$ -EXWRT_POWER(EXP,VARLIST):=BLOCK( - [IP1DUM,IP2DUM1,EXWRTLIST,SPLITDUM,FSPLITDUM], +exwrt_power(exp,varlist):=block( + [ip1dum,ip2dum1,exwrtlist,splitdum,fsplitdum], /* DECLARE(EXWRTLIST,SPECIAL), */ - IF INPART(EXP,0)#"^" THEN RETURN(EXP), - IF NOT FREEOFL(VARLIST,IP1DUM:INPART(EXP,1)) - AND INTEGERP(IP2DUM1:INPART(EXP,2)) - AND (MODE_IDENTITY(FIXNUM,IP2DUM1))>1 - AND INPART(IP1DUM,0)="+" - THEN (SPLITDUM:ORPARTITIONL(IP1DUM,"+",VARLIST), - IF (FSPLITDUM:FIRST(SPLITDUM))#0 - THEN (EXWRTLIST:CONS(1,EXWRT_POWER1(LAST(SPLITDUM),IP2DUM1,VARLIST)), - SUM(VARMULT(FSPLITDUM^KDUM*IP2DUM1!/(KDUM!*(IP2DUM1-KDUM)!), - FIRST(EXWRTLIST:REST(EXWRTLIST)), - VARLIST), + if inpart(exp,0)#"^" then return(exp), + if not freeofl(varlist,ip1dum:inpart(exp,1)) + and integerp(ip2dum1:inpart(exp,2)) + and (mode_identity(fixnum,ip2dum1))>1 + and inpart(ip1dum,0)="+" + then (splitdum:orpartitionl(ip1dum,"+",varlist), + if (fsplitdum:first(splitdum))#0 + then (exwrtlist:cons(1,exwrt_power1(last(splitdum),ip2dum1,varlist)), + sum(varmult(fsplitdum^kdum*ip2dum1!/(kdum!*(ip2dum1-kdum)!), + first(exwrtlist:rest(exwrtlist)), + varlist), /* Maxima: added MODE_IDENTITY for translator */ - KDUM,0,MODE_IDENTITY(FIXNUM,IP2DUM1))) - ELSE FIRST(EXWRT_POWER1(LAST(SPLITDUM),IP2DUM1,VARLIST))) - ELSE EXP)$ + kdum,0,mode_identity(fixnum,ip2dum1))) + else first(exwrt_power1(last(splitdum),ip2dum1,varlist))) + else exp)$ -EXWRT_POWER1(EXP,POWERDUM,VARLIST):=( - MODEDECLARE(POWERDUM,FIXNUM), - BLOCK( - [DUM:[EXP,1],FIRSTDUM:STOPEXPANDL1(EXP,VARLIST)], - IF POWERDUM=1 THEN RETURN(DUM), - IF INPART(EXP,0)#"+" - THEN FOR IDUM:2 THRU POWERDUM DO - DUM:CONS(EXP^IDUM,DUM) - ELSE FOR IDUM:2 THRU POWERDUM DO - DUM:CONS(FIRSTDUM: - MAP(LAMBDA([DUM],MULTTHRU(DUM,FIRSTDUM)),EXP),DUM), - DUM))$ +exwrt_power1(exp,powerdum,varlist):=( + modedeclare(powerdum,fixnum), + block( + [dum:[exp,1],firstdum:stopexpandl1(exp,varlist)], + if powerdum=1 then return(dum), + if inpart(exp,0)#"+" + then for idum:2 thru powerdum do + dum:cons(exp^idum,dum) + else for idum:2 thru powerdum do + dum:cons(firstdum: + map(lambda([dum],multthru(dum,firstdum)),exp),dum), + dum))$ -VARMULT(FACT,EXP,VARLIST):=BLOCK( - [SPLITDUM:ORPARTITIONL(EXP,"+",VARLIST)], - FACT*FIRST(SPLITDUM)+MULTTHRU(FACT,LAST(SPLITDUM)))$ +varmult(fact,exp,varlist):=block( + [splitdum:orpartitionl(exp,"+",varlist)], + fact*first(splitdum)+multthru(fact,last(splitdum)))$ -DISTRIBUTE(EXP1,EXP2,VARLIST):=BLOCK( - [SPLITEXP1:ORPARTITIONL(EXP1,"+",VARLIST), - SPLITEXP2:ORPARTITIONL(EXP2,"+",VARLIST), - FSPLEXP1,FSPLEXP2,LSPLEXP1,LSPLEXP2], - LSPLEXP1:LAST(SPLITEXP1), - LSPLEXP2:LAST(SPLITEXP2), - (FSPLEXP1:FIRST(SPLITEXP1))*(FSPLEXP2:FIRST(SPLITEXP2)) - +(IF FSPLEXP1#0 - THEN VARMULT(FSPLEXP1,STOPEXPANDL1(LSPLEXP2,VARLIST),VARLIST) - ELSE 0) - +(IF FSPLEXP2#0 - THEN VARMULT(FSPLEXP2,STOPEXPANDL1(LSPLEXP1,VARLIST),VARLIST) - ELSE 0) - +(IF INPART(LSPLEXP1,0)="+" - THEN MAP(LAMBDA([TERM],STOPEXPANDL1(TERM*LSPLEXP2,VARLIST)),LSPLEXP1) - ELSE IF INPART(LSPLEXP2,0)="+" - THEN MAP(LAMBDA([TERM],STOPEXPANDL1(TERM*LSPLEXP1,VARLIST)),LSPLEXP2) - ELSE LSPLEXP1*LSPLEXP2))$ +distribute(exp1,exp2,varlist):=block( + [splitexp1:orpartitionl(exp1,"+",varlist), + splitexp2:orpartitionl(exp2,"+",varlist), + fsplexp1,fsplexp2,lsplexp1,lsplexp2], + lsplexp1:last(splitexp1), + lsplexp2:last(splitexp2), + (fsplexp1:first(splitexp1))*(fsplexp2:first(splitexp2)) + +(if fsplexp1#0 + then varmult(fsplexp1,stopexpandl1(lsplexp2,varlist),varlist) + else 0) + +(if fsplexp2#0 + then varmult(fsplexp2,stopexpandl1(lsplexp1,varlist),varlist) + else 0) + +(if inpart(lsplexp1,0)="+" + then map(lambda([term],stopexpandl1(term*lsplexp2,varlist)),lsplexp1) + else if inpart(lsplexp2,0)="+" + then map(lambda([term],stopexpandl1(term*lsplexp1,varlist)),lsplexp2) + else lsplexp1*lsplexp2))$ -EXPANDWRT_FACTORED(EXP,[VARLIST]):= - IF LISTP(EXP) OR MATRIXP(EXP) - THEN MATRIXMAP(LAMBDA([DUM],APPLY('EXPANDWRT_FACTORED,CONS(DUM,VARLIST))), - EXP) - ELSE BLOCK([IFORP:TRUE,PIECE,PARTSWITCH:TRUE,INFLAG:TRUE,DUM], - DUM:ORPARTITIONL(EXP,"*",VARLIST), - FIRST(DUM)*STOPEXPANDL(LAST(DUM),VARLIST))$ +expandwrt_factored(exp,[varlist]):= + if listp(exp) or matrixp(exp) + then matrixmap(lambda([dum],apply('expandwrt_factored,cons(dum,varlist))), + exp) + else block([iforp:true,piece,partswitch:true,inflag:true,dum], + dum:orpartitionl(exp,"*",varlist), + first(dum)*stopexpandl(last(dum),varlist))$ -EVAL_WHEN(BATCH,TTYOFF:FALSE)$ +eval_when(batch,ttyoff:false)$ |
