← Back to branch summary

~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to share/simplification/facex1.mac

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
Import upstream version 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
share/simplification/facex1.mac
1
1
/* -*- MACSYMA -*- */
2
 
EVAL_WHEN(BATCH,TTYOFF:TRUE)$
 
2
eval_when(batch,ttyoff:true)$
3
3
/*ASB;FACEX1 1
4
4
4:19pm  Monday, 7 February 1983
5
5
  Split off from FACEXP 15
10
10
          THEN (LOAD('[FACEXP,FASL]),
11
11
                LOAD('[GNDECL,FASL])))$
12
12
*/
13
 
EVAL_WHEN(TRANSLATE,
14
 
          TRANSCOMPILE:TRUE,
15
 
          DEFINE_VARIABLE:'MODE,
16
 
          MODEDECLARE(FUNCTION(NULLLISTP,FREEOFL),BOOLEAN))$
 
13
eval_when(translate,
 
14
          transcompile:true,
 
15
          define_variable:'mode,
 
16
          modedeclare(function(nulllistp,freeofl),boolean))$
17
17
 
18
 
PUT('FACEX1,1,'VERSION)$
 
18
put('facex1,1,'version)$
19
19
 
20
20
/* GNU Maxima */
21
21
 
29
29
  so don't use it.  Use facexp instead. */
30
30
 
31
31
eval_when([batch,loadfile],
32
 
  if get('GNAUTO,'DIAGEVAL_VERSION)=false
 
32
  if get('gnauto,'diageval_version)=false
33
33
  then load("genut"))$
34
34
 
35
 
COLLECTTEN(EXP):=COLLECTTERMSL(EXP,LISTOFTENS(EXP))$
36
 
 
37
 
COLLECTTERMS(EXP,[VARLIST]):=COLLECTTERMSL(EXP,VARLIST)$
38
 
 
39
 
COLLECTTERMSL(EXP,VARLIST):=BLOCK(
40
 
  [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE],
41
 
  APPLY('COLLECTTERMS0,CONS(EXP,ARGSPLIT(EXP,VARLIST))))$
42
 
 
43
 
COLLECTTERMS0(EXP,THISLEVELDUM,NEXTLEVELDUM):=BLOCK(
44
 
  [IFORP:TRUE,SPLITDUM1,SPLITDUM2,SPLITDUM3,ANSLIST:[],FDUM,
45
 
   PREVDUM,LSPLIT3,ANSDUM,LASTDUMSAVE,PREVLASTDUM,
46
 
   RTHISLEVELDUM,FTHISLEVELDUM],
47
 
  MODEDECLARE(LSPLIT3,FIXNUM),
 
35
collectten(exp):=collecttermsl(exp,listoftens(exp))$
 
36
 
 
37
collectterms(exp,[varlist]):=collecttermsl(exp,varlist)$
 
38
 
 
39
collecttermsl(exp,varlist):=block(
 
40
  [partswitch:true,inflag:true,piece],
 
41
  apply('collectterms0,cons(exp,argsplit(exp,varlist))))$
 
42
 
 
43
collectterms0(exp,thisleveldum,nextleveldum):=block(
 
44
  [iforp:true,splitdum1,splitdum2,splitdum3,anslist:[],fdum,
 
45
   prevdum,lsplit3,ansdum,lastdumsave,prevlastdum,
 
46
   rthisleveldum,fthisleveldum],
 
47
  modedeclare(lsplit3,fixnum),
48
48
  /* DECLARE([FDUM,SPLITDUM3,ANSDUM],SPECIAL), */
49
 
  IF EXP=0 THEN RETURN(0),
50
 
  IF NULLLISTP(THISLEVELDUM) OR FREEOFL(THISLEVELDUM,EXP)
51
 
  THEN IF NULLLISTP(NEXTLEVELDUM)
52
 
       THEN RETURN(EXP)
53
 
       ELSE (SPLITDUM1:ORPARTITIONL(EXP,"+",NEXTLEVELDUM),
54
 
             RETURN(COLLECTTERMSL(FIRST(SPLITDUM1),NEXTLEVELDUM)
55
 
                    +IFLOPMAP("+",
56
 
                              LAMBDA([TERMDUM],
57
 
                                     COLLECTTERMSL(TERMDUM,NEXTLEVELDUM)),
58
 
                              LAST(SPLITDUM1)))),
59
 
  RTHISLEVELDUM:REST(THISLEVELDUM),
60
 
  IF FREEOF(FTHISLEVELDUM:FIRST(THISLEVELDUM),EXP)
61
 
  THEN RETURN(COLLECTTERMS0(EXP,RTHISLEVELDUM,NEXTLEVELDUM)),
62
 
  SPLITDUM1:ORPARTITIONL(EXP,"+",THISLEVELDUM),
63
 
  SPLITDUM2:ORPARTITIONL(LAST(SPLITDUM1),"+",[FTHISLEVELDUM]),
64
 
  ANSDUM:COLLECTTERMSL(FIRST(SPLITDUM1),NEXTLEVELDUM)
65
 
         +COLLECTTERMS0(FIRST(SPLITDUM2),RTHISLEVELDUM,NEXTLEVELDUM),
66
 
  IF INPART(SPLITDUM3:LAST(SPLITDUM2),0)#"+"
67
 
  THEN RETURN(ANSDUM+COLLECTTERMSL(SPLITDUM3,NEXTLEVELDUM)),
68
 
  SPLITDUM3:SORT(MAPLIST(LAMBDA([TERM],ORPARTITIONL(TERM,"*",[FTHISLEVELDUM])),
69
 
                 SPLITDUM3),
70
 
                 'ORDERLASTP),
71
 
  LSPLIT3:LENGTH(SPLITDUM3)-1,
72
 
  PREVLASTDUM:INPART(SPLITDUM3,1,2),
73
 
  PREVDUM:INPART(SPLITDUM3,1,1),
74
 
  SPLITDUM3:REST(SPLITDUM3),
75
 
  FOR IDUM THRU LSPLIT3 DO
76
 
       (IF (LASTDUMSAVE:INPART(SPLITDUM3,IDUM,2))=PREVLASTDUM
77
 
        THEN PREVDUM:PREVDUM+INPART(SPLITDUM3,IDUM,1)
78
 
        ELSE (ANSLIST:ENDCONS([PREVDUM,PREVLASTDUM],ANSLIST),
79
 
              PREVDUM:INPART(SPLITDUM3,IDUM,1),
80
 
              PREVLASTDUM:LASTDUMSAVE),
81
 
        IF IDUM=LSPLIT3
82
 
        THEN ANSLIST:ENDCONS([PREVDUM,PREVLASTDUM],ANSLIST)),
83
 
  LISTTOSUM(MAPLIST('LAMBDA([DUM], /* Maxima: quoted the lambda expression */
84
 
                           IF FREEOFL(RTHISLEVELDUM,FDUM:FIRST(DUM))
85
 
                           THEN COLLECTTERMSL(FDUM,NEXTLEVELDUM)
86
 
                                    *LAST(DUM)
87
 
                           ELSE MULTTHRUSPLIT(LAST(DUM),
88
 
                                              COLLECTTERMS0(FDUM,RTHISLEVELDUM,
89
 
                                                            NEXTLEVELDUM),
90
 
                                              RTHISLEVELDUM)),
91
 
                    ANSLIST))+ANSDUM)$
92
 
 
93
 
ORDERLASTP(EXP1,EXP2):=ORDERLESSP(LAST(EXP1),LAST(EXP2))$
94
 
 
95
 
 
96
 
MULTTHRUSPLIT(FACTORDUM,SUMDUM,RTHISLEVELDUM):=BLOCK(
97
 
  [SPLITDUM1:ORPARTITIONL(SUMDUM,"+",RTHISLEVELDUM)],
98
 
  MULTTHRU(FACTORDUM,LAST(SPLITDUM1))+FACTORDUM*FIRST(SPLITDUM1))$
99
 
 
100
 
EVAL_WHEN(BATCH,TTYOFF:FALSE)$
 
49
  if exp=0 then return(0),
 
50
  if nulllistp(thisleveldum) or freeofl(thisleveldum,exp)
 
51
  then if nulllistp(nextleveldum)
 
52
       then return(exp)
 
53
       else (splitdum1:orpartitionl(exp,"+",nextleveldum),
 
54
             return(collecttermsl(first(splitdum1),nextleveldum)
 
55
                    +iflopmap("+",
 
56
                              lambda([termdum],
 
57
                                     collecttermsl(termdum,nextleveldum)),
 
58
                              last(splitdum1)))),
 
59
  rthisleveldum:rest(thisleveldum),
 
60
  if freeof(fthisleveldum:first(thisleveldum),exp)
 
61
  then return(collectterms0(exp,rthisleveldum,nextleveldum)),
 
62
  splitdum1:orpartitionl(exp,"+",thisleveldum),
 
63
  splitdum2:orpartitionl(last(splitdum1),"+",[fthisleveldum]),
 
64
  ansdum:collecttermsl(first(splitdum1),nextleveldum)
 
65
         +collectterms0(first(splitdum2),rthisleveldum,nextleveldum),
 
66
  if inpart(splitdum3:last(splitdum2),0)#"+"
 
67
  then return(ansdum+collecttermsl(splitdum3,nextleveldum)),
 
68
  splitdum3:sort(maplist(lambda([term],orpartitionl(term,"*",[fthisleveldum])),
 
69
                 splitdum3),
 
70
                 'orderlastp),
 
71
  lsplit3:length(splitdum3)-1,
 
72
  prevlastdum:inpart(splitdum3,1,2),
 
73
  prevdum:inpart(splitdum3,1,1),
 
74
  splitdum3:rest(splitdum3),
 
75
  for idum thru lsplit3 do
 
76
       (if (lastdumsave:inpart(splitdum3,idum,2))=prevlastdum
 
77
        then prevdum:prevdum+inpart(splitdum3,idum,1)
 
78
        else (anslist:endcons([prevdum,prevlastdum],anslist),
 
79
              prevdum:inpart(splitdum3,idum,1),
 
80
              prevlastdum:lastdumsave),
 
81
        if idum=lsplit3
 
82
        then anslist:endcons([prevdum,prevlastdum],anslist)),
 
83
  listtosum(maplist('lambda([dum], /* Maxima: quoted the lambda expression */
 
84
                           if freeofl(rthisleveldum,fdum:first(dum))
 
85
                           then collecttermsl(fdum,nextleveldum)
 
86
                                    *last(dum)
 
87
                           else multthrusplit(last(dum),
 
88
                                              collectterms0(fdum,rthisleveldum,
 
89
                                                            nextleveldum),
 
90
                                              rthisleveldum)),
 
91
                    anslist))+ansdum)$
 
92
 
 
93
orderlastp(exp1,exp2):=orderlessp(last(exp1),last(exp2))$
 
94
 
 
95
 
 
96
multthrusplit(factordum,sumdum,rthisleveldum):=block(
 
97
  [splitdum1:orpartitionl(sumdum,"+",rthisleveldum)],
 
98
  multthru(factordum,last(splitdum1))+factordum*first(splitdum1))$
 
99
 
 
100
eval_when(batch,ttyoff:false)$