← Back to branch summary

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

« back to all changes in this revision

Viewing changes to share/simplification/functs.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/functs.mac
1
1
/* eval_when([translate,load,loadfile,batch,demo],
2
 
 MATCHDECLARE(a,nonzeroandfreeof(x),[b,c],FREEOF(x)))$ */
 
2
 matchdeclare(a,nonzeroandfreeof(x),[b,c],freeof(x)))$ */
3
3
 
4
4
define_variable(takegcd,true,boolean,"used in gcdivide to decide the
5
5
gcd choice");
6
6
 
7
 
conjugate&&  conjugate(m):=IF MATRIXP(m) THEN FULLMAPL('conjugate,m)
8
 
    ELSE IF FREEOF(%I,SUBST('\&I,%I,m)) THEN
9
 
    SUBST(-%I,%I,m) ELSE RATSUBST(-%I,%I,m)$
10
 
 
11
7
rempart&&  rempart(exp,n):=
12
 
    ?APPEND(REST(exp,  /* combine two parts of exp
 
8
    ?append(rest(exp,  /* combine two parts of exp
13
9
           first part is beginning to part to be removed
14
 
           Specify that the first l-1 parts are retained */
15
 
        (IF LISTP(n) THEN n[1] ELSE n)-1-LENGTH(exp)),
16
 
        BLOCK([t],  /* last part is from removed part to end */
17
 
        IF ATOM(t:REST(exp,  /* last m-1 parts are retained */
18
 
            IF LISTP(n) THEN n[2] ELSE n))
19
 
        THEN ?LIST(t) ELSE ?CDR(t)))$
 
10
           specify that the first l-1 parts are retained */
 
11
        (if listp(n) then n[1] else n)-1-length(exp)),
 
12
        block([t],  /* last part is from removed part to end */
 
13
        if atom(t:rest(exp,  /* last m-1 parts are retained */
 
14
            if listp(n) then n[2] else n))
 
15
        then ?list(t) else ?cdr(t)))$
20
16
 
21
 
wronskian&&  wronskian(functlist,var):=BLOCK([end],
22
 
    end:LENGTH(functlist)-1,
 
17
wronskian&&  wronskian(functlist,var):=block([end],
 
18
    end:length(functlist)-1,
23
19
    functlist:[functlist],
24
 
    THRU end DO functlist:ENDCONS(MAP(LAMBDA([x],DIFF(x,var)),
25
 
        LAST(functlist)),functlist),
26
 
    APPLY('MATRIX,functlist))$
27
 
 
28
 
adjoint&&  adjoint(m):=BLOCK([adjoint,len],
29
 
    adjoint:DIAGMATRIX(len:LENGTH(m),0),
30
 
    FOR i THRU len DO
31
 
        FOR j THRU len DO
32
 
            adjoint[i,j]:(-1)^(i+j)*DETERMINANT(MINOR(m,i,j)),
33
 
    TRANSPOSE(adjoint))$
 
20
    thru end do functlist:endcons(map(lambda([x],diff(x,var)),
 
21
        last(functlist)),functlist),
 
22
    apply('matrix,functlist))$
34
23
 
35
24
tracematrix&&  tracematrix(m):=block([sum,len],sum:0,len:length(m),
36
25
for i:1 thru len do sum:sum+part(m,i,i),sum)$
37
26
 
38
 
rational&&  rational(z):=BLOCK([n,d,cd,RATFAC],
39
 
    RATFAC:FALSE,
40
 
    n:RATDISREP(RATNUMER(z)*(cd:conjugate(d:RATDENOM(z)))),
41
 
    d:RAT(n/RATDISREP(d*cd)),
42
 
    IF RATP(z) THEN d ELSE RATDISREP(d))$
43
 
 
44
 
oddp&&  oddp(x):=IS(logand(x,1)#0)$
45
 
        evenp(x):=IS(logand(x,1)=0)$
46
 
 
47
 
logical&&  logand(x,y):=?BOOLE(1,x,y)$
48
 
        logxor(x,y):=?BOOLE(6,x,y)$
49
 
        logor(x,y):=?BOOLE(7,x,y)$
50
 
 
51
 
uprobe&&  uprobe(file):=?APPLY('?UPROBE,?FULLSTRIP(?CDR(file)))$
52
 
 
53
 
kronecker&&  kronecker(m,n):=IF m=n THEN 1 ELSE 0$
54
 
 
55
 
nonzeroandfreeof&&  nonzeroandfreeof(x,e):=IS(e#0 AND FREEOF(x,e))$
56
 
 
57
 
/* linear&& MATCHDECLARE(a,nonzeroandfreeof(x),[b,c],FREEOF(x))$
58
 
    DEFMATCH(linearize,a*x+b,x)$
59
 
    DEFMATCH(quadraticize,a*x^2+b*x+c,x)$
60
 
    linear(exp,x):=BLOCK([a,b],IF linearize(exp,x)=FALSE THEN exp ELSE
 
27
rational&&  rational(z):=block([n,d,cd,ratfac],
 
28
    ratfac:false,
 
29
    n:ratdisrep(ratnumer(z)*(cd:conjugate(d:ratdenom(z)))),
 
30
    d:rat(n/ratdisrep(d*cd)),
 
31
    if ratp(z) then d else ratdisrep(d))$
 
32
 
 
33
logical&&  logand(x,y):=?boole(6,x,y)$
 
34
        logor(x,y):=?boole(7,x,y)$
 
35
        logxor(x,y):=?boole(8,x,y)$
 
36
 
 
37
nonzeroandfreeof&&  nonzeroandfreeof(x,e):=is(e#0 and freeof(x,e))$
 
38
 
 
39
/* linear&& matchdeclare(a,nonzeroandfreeof(x),[b,c],freeof(x))$
 
40
    defmatch(linearize,a*x+b,x)$
 
41
    defmatch(quadraticize,a*x^2+b*x+c,x)$
 
42
    linear(exp,x):=block([a,b],if linearize(exp,x)=false then exp else
61
43
        a*x+b)$
62
 
    quadratic(exp,x):=BLOCK([a,b,c],IF quadraticize(exp,x)=FALSE THEN
63
 
        exp ELSE a*x^2+b*x+c)$ */
 
44
    quadratic(exp,x):=block([a,b,c],if quadraticize(exp,x)=false then
 
45
        exp else a*x^2+b*x+c)$ */
64
46
 
65
47
lcm&& lcm([list]):=block([listconstvars:false],if listofvars(list)=[] then
66
48
lcm1(list) else factor(lcm1(list)))$
69
51
frlist,partswitch:true,inflag:true,piece], if rlist=[] then flist else
70
52
lcm1(cons(flist*(frlist:first(rlist))/gcd(flist,frlist),rest(rlist))))$
71
53
 
72
 
gcdivide&&  gcdivide(poly1,poly2):=BLOCK([gcdlist],
73
 
                gcdlist:IF takegcd THEN EZGCD(poly1,poly2)
74
 
                        ELSE [1,poly1,poly2],
 
54
gcdivide&&  gcdivide(poly1,poly2):=block([gcdlist],
 
55
                gcdlist:if takegcd then ezgcd(poly1,poly2)
 
56
                        else [1,poly1,poly2],
75
57
                gcdlist[2]/gcdlist[3])$
76
58
 
77
59
series&&  arithmetic(a,d,n):=a+(n-1)*d$
78
 
        geometric(a,r,n):=a*r^(n-1)$
79
 
        harmonic(a,b,c,n):=a/(b+(n-1)*c)$
80
 
        arithsum(a,d,n):=n*(a+(n-1)*d/2)$
81
 
        geosum(a,r,n):=IF n='INF THEN a/(1-r)
82
 
                ELSE a*(1-r^n)/(1-r)$
83
 
 
84
 
gauss&&  gaussprob(x):=1/SQRT(2*%PI)*%E^(-x^2/2)$
85
 
 
86
 
gd&&  gd(x):=2*ATAN(%E^x-%PI/2)$
87
 
        agd(x):=LOG(TAN(%PI/4+x/2))$
88
 
 
89
 
trig&&  vers(x):=1-COS(x)$
90
 
        covers(x):=1-SIN(x)$
91
 
        exsec(x):=SEC(x)-1$
92
 
        hav(x):=(1-COS(x))/2$
93
 
 
94
 
combination&&  combination(n,r):=BINOMIAL(n,r)$
95
 
        permutation(n,r):=BINOMIAL(n,r)*r!$
 
60
          geometric(a,r,n):=a*r^(n-1)$
 
61
          harmonic(a,b,c,n):=a/(b+(n-1)*c)$
 
62
          arithsum(a,d,n):=n*(a+(n-1)*d/2)$
 
63
          geosum(a,r,n):=block([],
 
64
            if r=1
 
65
                then if n='inf
 
66
                        then return(limit(i*a,i,'inf))
 
67
                        else return(n*a),
 
68
            if r=-1
 
69
                then error("The series is not convergent"),
 
70
            if n='inf 
 
71
                then if abs(r) < 1 
 
72
                        then a/(1-r)
 
73
                        else limit(a*(1-r^i)/(1-r),i,'inf)
 
74
                else a*(1-r^n)/(1-r)   )$
 
75
 
 
76
gauss&&  gaussprob(x):=1/sqrt(2*%pi)*%e^(-x^2/2)$
 
77
 
 
78
gd&&  gd(x):=2*atan(%e^x-%pi/2)$
 
79
        agd(x):=log(tan(%pi/4+x/2))$
 
80
 
 
81
trig&&  vers(x):=1-cos(x)$
 
82
        covers(x):=1-sin(x)$
 
83
        exsec(x):=sec(x)-1$
 
84
        hav(x):=(1-cos(x))/2$
 
85
 
 
86
combination&&  combination(n,r):=binomial(n,r)$
 
87
        permutation(n,r):=binomial(n,r)*r!$