← Back to branch summary

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

« back to all changes in this revision

Viewing changes to share/diffequations/abel.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/diffequations/abel.mac
1
1
/* -*- Macsyma -*- */
2
 
ABEL(DE,A,X):=block([v,coefs,f0,f1,f2,f3,a,%a,%fff,y,u,z,%ff,%dff,
 
2
abel(de,a,x):=block([v,coefs,f0,f1,f2,f3,a,%a,%fff,y,u,z,%ff,%dff,
3
3
                     %v,%uu,newde],
4
 
    DEPENDS(V,X),
5
 
    DE:LHS(DE)-RHS(DE),
6
 
    COEFS:MAKECOEFLIST3(DE),
7
 
    F0:COEFS[1],F1:COEFS[2],F2:COEFS[3],F3:COEFS[4],a:coefs[5],
 
4
    depends(v,x),
 
5
    de:lhs(de)-rhs(de),
 
6
    coefs:makecoeflist3(de),
 
7
    f0:coefs[1],f1:coefs[2],f2:coefs[3],f3:coefs[4],a:coefs[5],
8
8
    if a#1 then return(abel2(coefs,y,x)),
9
9
    if f0=0 and f1=0 and freeof(x,%a:diff(%fff:f3/f2,x)/f2) then
10
10
      return(transform(de,y,x,u,z,[x=z,u=%fff*y])),
12
12
    %v:exp(integrate((f1+%ff*f2),x)),
13
13
    %uu:(f0-%dff+f1*%ff+2*f2*%ff^2/3)/%v^3/f3,
14
14
    newde:transform(de,y,x,u,z,[y=u*%v+%ff,z=ratsimp(integrate(f3*%v^2,x))]),
15
 
     RETURN(ratsimp(newDE)))$
16
 
 
17
 
 
18
 
MAKECOEFLIST3(DE):=BLOCK([a,F0,F1,F2,F3,y,x],
19
 
        DE:EXPAND(DE),       
20
 
        A: COEFF(DE,'DIFF(Y,X),1),
21
 
 
22
 
        F0:-COEFF(DE,Y,0),
23
 
        F1:-COEFF(DE,Y,1),
24
 
        F2:-COEFF(DE,Y,2),
25
 
        F3:-COEFF(DE,Y,3),
26
 
RETURN([F0,F1,F2,F3,a]))$
27
 
 
28
 
/*METHOD FOR NON-LINEAR Y'*/
29
 
NONLIN(DE,Y,X):=BLOCK([temp,temp1,newy,dd,newde,dispflag,%p],
 
15
     return(ratsimp(newde)))$
 
16
 
 
17
 
 
18
makecoeflist3(de):=block([a,f0,f1,f2,f3,y,x],
 
19
        de:expand(de),       
 
20
        a: coeff(de,'diff(y,x),1),
 
21
 
 
22
        f0:-coeff(de,y,0),
 
23
        f1:-coeff(de,y,1),
 
24
        f2:-coeff(de,y,2),
 
25
        f3:-coeff(de,y,3),
 
26
return([f0,f1,f2,f3,a]))$
 
27
 
 
28
/*method for non-linear y'*/
 
29
nonlin(de,y,x):=block([temp,temp1,newy,dd,newde,dispflag,%p],
30
30
        de:expand(de),depends(newy,x),dispflag:false,
31
 
        DD:DERIVDEGREE(DE,Y,X),
32
 
        IF(DD>1) THEN RETURN(FALSE) ELSE
33
 
         IF(HIPOW(DE,DIFF(Y,X))<2) THEN RETURN(FALSE),
34
 
        NEWDE:SUBST(%P,DIFF(Y,X),DE),
35
 
        DEPENDS(%P,X),
36
 
        NEWDE:LHS(NEWDE)-RHS(NEWDE),
37
 
        TEMP:SOLVE(NEWDE=0,%P),
38
 
        TEMP:SUBST('DIFF(Y,X),%P,apply('ev,[TEMP])),
39
 
        temp:map(LAMBDA([V],ODE2(V,Y,X)),apply('ev,[TEMP,'diff])),
 
31
        dd:derivdegree(de,y,x),
 
32
        if(dd>1) then return(false) else
 
33
         if(hipow(de,diff(y,x))<2) then return(false),
 
34
        newde:subst(%p,diff(y,x),de),
 
35
        depends(%p,x),
 
36
        newde:lhs(newde)-rhs(newde),
 
37
        temp:solve(newde=0,%p),
 
38
        temp:subst('diff(y,x),%p,apply('ev,[temp])),
 
39
        temp:map(lambda([v],ode2(v,y,x)),apply('ev,[temp,'diff])),
40
40
        temp:map(lambda([v],solve(v,y)),temp),
41
41
        return(apply('ev,[temp,'infeval])))$
42
42
 
43
43
 
44
44
 
45
 
BERNO(DE,Y,X):=BLOCK([nn,mm,nni,mmi,%q,ans],ANS:[],
46
 
          IF(DERIVDEGREE(DE,Y,X)>1) THEN RETURN(FALSE),
47
 
          DE:LHS(DE)-RHS(DE),
48
 
          NN:EXPAND(COEFF(DE,DIFF(Y,X))),
49
 
          MM:EXPAND(RADCAN(DE-NN*DIFF(Y,X))),
50
 
          NNI:APPLY('APPEND,MAPLIST('ELEMENTS,NN)),
51
 
          MMI:APPLY('APPEND,MAPLIST('ELEMENTS,MM)),
52
 
          IF(ATOM(MM) OR PART(MM,0)="^") THEN MM:[MM],
 
45
berno(de,y,x):=block([nn,mm,nni,mmi,%q,ans],ans:[],
 
46
          if(derivdegree(de,y,x)>1) then return(false),
 
47
          de:lhs(de)-rhs(de),
 
48
          nn:expand(coeff(de,diff(y,x))),
 
49
          mm:expand(radcan(de-nn*diff(y,x))),
 
50
          nni:apply('append,maplist('elements,nn)),
 
51
          mmi:apply('append,maplist('elements,mm)),
 
52
          if(atom(mm) or part(mm,0)="^") then mm:[mm],
53
53
/* commented out of DOE MACSYMA because it can't be translated
54
54
          MAP(LAMBDA([V],IF NOT FREEOF(%Q,RATSUBST(%Q,
55
55
             DELETE(NUMFACTOR(DIFF(V,X)),DELETE(DIFF(Y,X),DIFF(V,X))),NN))
56
56
             THEN ANS:CONS(V,ANS)),MM), */
57
57
/* and replaced by the equivalent do loop */
58
 
          for v in mm do (IF NOT FREEOF(%Q,RATSUBST(%Q,
59
 
             DELETE(NUMFACTOR(DIFF(V,X)),DELETE(DIFF(Y,X),DIFF(V,X))),NN))
60
 
             THEN ANS:CONS(V,ANS)),
61
 
          RETURN(ANS))$
 
58
          for v in mm do (if not freeof(%q,ratsubst(%q,
 
59
             delete(numfactor(diff(v,x)),delete(diff(y,x),diff(v,x))),nn))
 
60
             then ans:cons(v,ans)),
 
61
          return(ans))$
62
62
          
63
 
ELEMENTS(A):=BLOCK([],IF ATOM(A) THEN RETURN([A]),
64
 
          IF(PART(A,0) ="*") THEN RETURN(MAPLPROD(LAMBDA([V],V),A)),
65
 
          IF(PART(A,0)="+") THEN RETURN(MAPLSUM(LAMBDA([V],V),A)),
66
 
          RETURN([A]))$
 
63
elements(a):=block([],if atom(a) then return([a]),
 
64
          if(part(a,0) ="*") then return(maplprod(lambda([v],v),a)),
 
65
          if(part(a,0)="+") then return(maplsum(lambda([v],v),a)),
 
66
          return([a]))$
67
67
 
68
68
/*Method for nonlinear coeffs*/
69
 
NONLIN1(de,y,x):=block([%v,a1,a2,newde],
 
69
nonlin1(de,y,x):=block([%v,a1,a2,newde],
70
70
          de:expand(rhs(de)-lhs(de)),depends(%v,x),
71
71
          a1:coeff(de,diff(y,x)),
72
72
          a2:expand(de-a1*diff(y,x)),