Menu
▾
▴
[Maxima-commits] [git] Maxima CAS branch, master, updated. branch-5_32-base-18-g140df03
|
From: Robert D. <rob...@us...> - 2014-01-02 17:43:43
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "Maxima CAS".
The branch, master has been updated
via 140df03c7b54c3da7abfcc8e9a792122bc85a0da (commit)
via a1de35d89f5051482cd649fe09c194cc4add0b58 (commit)
via cf5a71b6a89f37a3c5de2cbb09c16b67853e19b9 (commit)
via 9d6f1905815ca03cc173a04f4aa771d3cda6b5fb (commit)
via 8f506cf15a33ba58c1d9fb7ff5039611880d818f (commit)
via 051e848108372ab1fa629fb48bad02842ca85f20 (commit)
via 0e9968685cf73ecdbb0ce8ba3104523bd86acf0b (commit)
from bf4155ead747be6be51f2eb23054ee065c9e13ad (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 140df03c7b54c3da7abfcc8e9a792122bc85a0da
Merge: a1de35d bf4155e
Author: Robert Dodier <rob...@us...>
Date: Wed Jan 1 17:50:53 2014 -0800
Merge branch 'master' of ssh://git.code.sf.net/p/maxima/code
commit a1de35d89f5051482cd649fe09c194cc4add0b58
Author: Robert Dodier <rob...@us...>
Date: Wed Jan 1 17:48:38 2014 -0800
When formatting floats for display, ensure that result has a leading zero if needed.
diff --git a/src/commac.lisp b/src/commac.lisp
index 7de50f0..55eb973 100644
--- a/src/commac.lisp
+++ b/src/commac.lisp
@@ -325,7 +325,15 @@ values")
(t 1)))))
(t
(values "~ve" (+ 5 effective-printprec))))
- (setq string (format nil form width symb))))
+ (setq string (format nil form width a))
+ ;; Ensure result has a leading zero if it needs one.
+ (if (eq (aref string 0) #\.)
+ (setq string (concatenate 'string "0" string)))
+ ;; EXPLODEN is often called after NFORMAT, so it doesn't
+ ;; usually see a negative argument. I can't guarantee
+ ;; a non-negative argument, so handle negative here.
+ (if (< symb 0)
+ (setq string (concatenate 'string "-" string)))))
(setq string (string-trim " " string))))
((integerp symb)
commit cf5a71b6a89f37a3c5de2cbb09c16b67853e19b9
Author: Robert Dodier <rob...@us...>
Date: Wed Jan 1 17:44:56 2014 -0800
TeX property for structure field selection operator.
diff --git a/src/mlisp.lisp b/src/mlisp.lisp
index e16cd32..fe3b268 100644
--- a/src/mlisp.lisp
+++ b/src/mlisp.lisp
@@ -868,6 +868,8 @@ wrapper for this."
;; !! (define-symbol "@")
(defprop $@ dimension-infix dimension)
(defprop $@ (#\@) dissym)
+(defprop $@ tex-infix tex)
+(defprop $@ ("@") texsym)
(defprop $@ msize-infix grind)
(defprop $@ 200 lbp)
(defprop $@ 201 rbp)
commit 9d6f1905815ca03cc173a04f4aa771d3cda6b5fb
Author: Robert Dodier <rob...@us...>
Date: Wed Jan 1 17:43:37 2014 -0800
TeX property for units conversion operator.
diff --git a/share/ezunits/ezunits.lisp b/share/ezunits/ezunits.lisp
index c051e9b..2e1de81 100644
--- a/share/ezunits/ezunits.lisp
+++ b/share/ezunits/ezunits.lisp
@@ -3,6 +3,8 @@
;; I release this program under the terms of the
;; GNU General Public License.
+(defprop $\`\` tex-infix tex)
+
;; Process tex(a`b): throw away the backtick, texify a,
;; and texify b with all symbols in b output as mathrm.
commit 8f506cf15a33ba58c1d9fb7ff5039611880d818f
Author: Robert Dodier <rob...@us...>
Date: Sat Dec 28 13:06:25 2013 -0800
Bug fix for ratinterpol, contributed by Andre Maute.
diff --git a/share/numeric/interpol.mac b/share/numeric/interpol.mac
index 395cc3b..5017391 100644
--- a/share/numeric/interpol.mac
+++ b/share/numeric/interpol.mac
@@ -297,7 +297,7 @@ cspline(tab,[select]):= block([options, defaults, n, aux, y2, u, sig, p,
/* title = concat("Degree of numerator = ",k), */
/* yrange=[0,10])$ */
ratinterpol(tab,r,[select]) :=
- block([n,m,coef,unk,sol,lov,options,defaults,ratprint:false],
+ block([n,m,coef,unk,sol,lovtab,lov,options,defaults,ratprint:false],
tab: interpol_check_input(tab,"ratinterpol"),
options: ['varname],
defaults: ['x],
@@ -325,7 +325,9 @@ ratinterpol(tab,r,[select]) :=
p, tab)),
unk: makelist(gensym(), k, r+m+2),
sol: map(last, linsolve(flatten(args(coef.unk)),unk)),
+ lovtab : listofvars(tab),
lov: listofvars(sol),
+ lov: listify(setdifference(setify(lov),setify(lovtab))),
sol: subst(map(lambda([z1,z2], z1=z2), lov, makelist(1, k, length(lov))), sol),
makelist(sol[k],k,1,r+1) . makelist(defaults[1]^k,k,0,r) /
makelist(sol[k],k,r+2,r+2+m) . makelist(defaults[1]^k,k,0,m) )$
diff --git a/share/numeric/rtest_interpol.mac b/share/numeric/rtest_interpol.mac
index 86b978d..91cde2d 100644
--- a/share/numeric/rtest_interpol.mac
+++ b/share/numeric/rtest_interpol.mac
@@ -132,6 +132,29 @@ ratinterpol(dat3,5,varname=t);
(-38471*t^5/35760+692581*t^4/35760-1525837*t^3/11920+13508819*t^2/35760
-8456297*t/17880+216979/1490)/(t-1253/149);
+(kill (h),
+ h:[[1,(-(13+2*b)*1)/12],
+ [2,(-(15+2*b)*1)/7],
+ [3,(-(17+2*b)*3)/16],
+ [4,(-(19+2*b)*2)/9],
+ [5,(-(21+2*b)*1)/4],
+ [6,(-(23+2*b)*3)/11]],
+ 0);
+0;
+
+is (equal (ratinterpol(h,1),
+ ((32*b^5+1552*b^4+30064*b^3+291128*b^2+1412514*b+2766033)*x
+ /(32*b+16)+144)
+ /(x^4-(2*b+53)*x^3/2+(4*b^2+128*b+1283)*x^2/4
+ -(8*b^3+300*b^2+3974*b+19993)*x/8
+ -(80*b^4+3440*b^3+56240*b^2+418500*b+1260063)/(16*b+8))));
+true;
+
+is (equal (ratinterpol(h,2), (-x^2-(2*b+11)*x/2)/(x+5)));
+true;
+
+is (equal (ratinterpol (subst (b=5/7, h), 2), subst (b=5/7, ratinterpol (h, 2))));
+true;
(float_approx_equal_tolerance : save_tolerance,
0);
commit 051e848108372ab1fa629fb48bad02842ca85f20
Author: Robert Dodier <rob...@us...>
Date: Sat Dec 28 13:04:29 2013 -0800
New share items contrib/odes and contrib/trigtools, contributed by Aleksas Domarkas.
diff --git a/share/contrib/odes/odes-doc.pdf b/share/contrib/odes/odes-doc.pdf
new file mode 100644
index 0000000..5b9ae65
Binary files /dev/null and b/share/contrib/odes/odes-doc.pdf differ
diff --git a/share/contrib/odes/odes.mac b/share/contrib/odes/odes.mac
new file mode 100644
index 0000000..73bda17
--- /dev/null
+++ b/share/contrib/odes/odes.mac
@@ -0,0 +1,427 @@
+
+/*
+odes package for solving ordinary diferential equations
+version 2.01, 2013.11
+Copyright (C) A.Domarkas 2013
+odes package is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License,
+*/
+
+/*
+Examples see in odes-doc.pdf
+*/
+
+/*
+1
+*/
+
+odecv(tr,eq,y,x):=block([_n,_t,tr1,itr,eq1,r,solvetrigwarn],
+solvetrigwarn:false,_n:derivdegree(eq,y,x),
+tr1:(solve(tr,x))[1],
+_t:last(listofvars(rhs(tr1))),
+itr:(solve(tr,_t))[1],
+depends(y,_t,_t,x),
+eq1:ev(eq,nouns),
+makelist(diff(itr,x,k),k,1,_n),
+subst(%%,eq1),
+ev(%%,nouns),
+r:subst(tr1,%%),
+remove([y,_t],dependency),
+radcan(r))$
+
+/*
+2
+*/
+
+dchange(tr,eq,fun,var,nfun,nvar):=block(local(T,keit),
+diffpf(f,t,k):=block(
+if k = 0 then f[2] elseif k = 1
+then ratsimp(diff(f[2],t,1)/diff(f[1],t,1))
+else ratsimp(diff(diffpf(f,t,k-1),t,1)/diff(f[1],t,1))),
+T:makelist('diff(fun,var,k)=
+diffpf([rhs(tr),nfun],nvar,k),k,0,derivdegree(eq,fun,var)),
+keit:append(reverse(T),[tr]),
+ev(eq,keit))$
+
+/*
+3
+*/
+
+odeC(eq,r,x):=block([derivsubst,_u,tr,itr,L],
+depends(_u,x),assume(_u>0),
+derivsubst:true,
+L:listofvars(r),
+tr:_u=r, itr:solve(tr,last(L))[1],
+subst(itr,eq),
+ev(%%, nouns), expand(%%),
+ode2(%%,_u,x),
+subst(tr,expand(%%))
+)$
+
+/*
+4
+*/
+
+solvet(eq,x):=block([spr,k,maperror,mapprint],
+maperror:false,mapprint:false,
+spr:solve(eq,x),
+rectform(%%),
+if freeof(sin,%%) then return(sort(%%))
+else makelist(x=map(polarform,rhs(spr[k])),k,1,length(spr)),
+rectform(%%),
+trigsimp(%%),
+sort(%%))$
+
+/*
+5
+*/
+
+ode1_ic(eq,y,x,_ic):=block([sol,gsol, spr,ats,p],
+solvetrigwarn:false,
+sol:ode2(eq,y,x),
+if %%=false then return(false),
+trigsimp(sol),
+radcan(%%),
+trigsimp(%%),
+trigreduce(%%),
+trigexpand(%%),
+gsol:rootscontract(%%),
+subst([x=_ic[1],y=_ic[2]],trigsimp(gsol)),
+solve(%%,%c),
+subst(%%,gsol),
+sol:ratsimp(logcontract(%%)),
+spr:solve(%%,y),
+if not freeof(y,map(rhs,%%)) then return(sol),
+if length(spr)=1 and freeof(y,rhs(spr[1])) then return(spr[1]),
+sublist(spr,lambda([e],is(radcan(subst([x=_ic[1], y=_ic[2]],e))))),
+trigsimp(%%[1]),
+radcan(%%),
+if not freeof(%e,%%) then
+radcan(%%) else %%,
+if not freeof(%i,%%) then
+ats:rootscontract(subst(%i=sqrt(-1),%%))
+else ats:%%,
+return(ats)
+)$
+
+/*
+6
+*/
+
+ode2_ic(eq,y,x,_ic):=block([p,sol,ats,spr],
+solvetrigwarn:false,
+maperror:false,
+mapprint:false,
+assume(x>_ic[1]),
+sol:ode2(eq,y,x),
+solve(eq,'diff(y,x,2)),
+rhs(%%[1]),
+if listofvars(%%)=[y] and listp(sol) then
+ (
+ subst('diff(y,x,2)=p*'diff(p,y),eq),
+ ode1_ic(%%,p,y,[_ic[2],_ic[3]]),
+ subst(p='diff(y,x),%%),
+ ats:ode1_ic(%%,y,x,[_ic[1],_ic[2]])
+ )
+else
+ (
+ ic2(sol, x=_ic[1], y=_ic[2],'diff(y,x)=_ic[3]),
+ ats:lhs(%%)=map(factor,rhs(%%)),
+ if lhs(%%)#y then
+ (
+ spr:solve(ats,y),
+ if spr#[] then
+ (
+ sublist(spr,lambda([e],
+ _ic[2]=ratsimp(ev(rhs(e),x=_ic[1])) and
+ _ic[3]=ratsimp(at(diff(rhs(e),x),x=_ic[1])))),
+ ats:%%[1]
+ )
+ ),
+ forget(facts(x)),
+ return(ats)
+ )
+)$
+
+/*
+6a
+*/
+
+ode_ic(eq,y,x,_ic):=block([],
+if derivdegree(eq,y,x)=1 then ode1_ic(eq,y,x,_ic)
+elseif derivdegree(eq,y,x)=2 then ode2_ic(eq,y,x,_ic)
+else error("equation must be the first or second order"),
+rootscontract(%%)
+)$
+
+/*
+7
+*/
+
+P_iter(eq,x,y,x0,y0,n):=block([f,t],
+solve(eq,'diff(y,x,1))[1],
+define(f(x,y),rhs(%%)),
+if n=0 then y0 else
+(assume(x>x0),
+subst(x=t,f(t,P_iter(eq,x,y,x0,y0,n-1))),
+y0+expand(integrate(%%,t,x0,x))))$
+
+/*
+8
+*/
+
+ode1taylor(eq,x0,y0,n):=block([spr,nezin],
+atvalue(y(x),x=x0,y0),
+spr:taylor(y(x),x,x0,n),
+nezin:at(makelist(diff(y(x),x,k),k,1,n),x=x0),
+makelist(diff(eq,x,k),k,0,n-1),
+at(%%,x=x0),solve(%%,nezin),
+ratexpand(ev(spr,first(%%))),
+taylor(%%,x,x0,n)
+)$
+
+/*
+9
+*/
+
+ode2taylor(eq,x0,y0,y1,n):=block([spr,nezin],
+atvalue(y(x),x=x0,y0),
+atvalue(diff(y(x),x),x=x0,y1),
+spr:taylor(y(x),x,x0,n),
+nezin:at(makelist(diff(y(x),x,k),k,2,n),x=x0),
+makelist(diff(eq,x,k),k,0,n-2),
+at(%%,x=x0),solve(%%,nezin),
+ratexpand(ev(spr,first(%%))),
+taylor(%%,x,x0,n)
+)$
+
+/*
+10
+*/
+
+ode1exact(eq):=block([P,Q,F],
+P:coeff(expand(lhs(eq)-rhs(eq)),dx),
+Q:coeff(expand(lhs(eq)-rhs(eq)),dy),
+if trigsimp(trigexpand(diff(P,y)-diff(Q,x)))=0 then
+(F:integrate(P,x)+g(y),diff(F,y)=Q,
+ode2(%%,g(y),y),
+subst([%%,%c=0],F)=C,
+trigexpand(%%),
+trigsimp(%%),
+expand(%%))
+else false)$
+
+/*
+11
+*/
+
+intfactor1(eq,omega):=block([P,Q,d,t,ans],
+P:coeff(expand(lhs(eq)-rhs(eq)),dx),
+Q:coeff(expand(lhs(eq)-rhs(eq)),dy),
+(diff(P,y)-diff(Q,x))/(Q*diff(omega,x)-P*diff(omega,y)),
+ratsimp(ev(%%,diff)),
+trigexpand(%%),
+ratsubst(t,omega,%%),
+d:map(radcan,expand(%%)),
+if listofvars(%%)=[t] then (
+exp(integrate(d,t)),
+ans:subst(t=omega,%%))
+else return(false),
+if freeof(integrate, ans) then return(ans)
+else return(false)
+)$
+
+/*
+12
+*/
+
+odeL(eq,y,x):=block([n,_yp,gamma_expand,i,_Y,_C],
+gamma_expand:true,
+_Y:fs(eq,y,x),
+n:derivdegree(eq,y,x),
+_yp:partsol(eq,y,x),
+_C:makelist(concat(C,i),i,1,n),
+y=_C._Y+_yp)$
+
+/*
+13
+*/
+
+odeL_ic(eq,y,x,ic):=block(odeL(eq,y,x), icn(%%,y,x,ic))$
+
+icn(sol,y,x,ic):=block([_spr,n],
+_spr:rhs(sol),
+n:length(ic)-1,
+makelist(at(diff(_spr,x,k),x=ic[1])=ic[k+2],k,0,n-1),
+solve(%%,_C:makelist(concat(C,i),i,1,n)),
+y=subst(%%,_spr)
+)$
+
+/*
+14
+*/
+
+fs(eq,y,x):=block([_f,n,j,cr,_k,ce],
+_f(r):=block([a,b,i],
+ a:radcan(realpart(r[1])),
+ b:radcan(imagpart(r[1])),
+ if b=0 then
+ return(makelist(x^(i-1)*exp(a*x),i,1,r[2]))
+ else
+ join(makelist(x^(i-1)*exp(a*x)*cos(b*x),i,1,r[2]),
+ makelist(x^(i-1)*exp(a*x)*sin(b*x),i,1,r[2]))),
+n:derivdegree(eq,y,x),
+makelist('diff(y,x,j)=_k^j,j,0,n),
+reverse(%%),
+ce:subst(%%,lhs(eq))=0,
+solve(ce,_k),
+map(rhs,%%),
+map(rootssimp,%%),
+makelist([%%[j],multiplicities[j]],j,1,length(%%)),
+cr:sublist(%%,lambda([e],is(radcan(imagpart(e[1]))>=0))),
+map(_f,cr),
+flatten(%%),
+trigreduce(%%),
+sort(%%))$
+
+/*
+15
+*/
+
+partsolL_UC(eq,y,x):=block([spr,u],
+if rhs(eq)=0 then return(0),
+subst(y=u(x),eq),
+rhs(desolve([%%],[u(x)])),
+args(%%),
+sublist(%%,lambda([e],freeof(u,ilt,e))),
+spr:apply("+",%%),
+if not atom(spr) and op(spr)="+" then
+(args(expand(spr)),
+sublist(%%,lambda([e],ode_check(lhs(eq),y=e)#0) ),
+apply("+",%%),return(ratsimp(%%)))
+else
+return(ratsimp(spr))
+)$
+
+partsolL_VP(eq,y,x):=block([W,Wi,_n,_dp],
+if rhs(eq)=0 then return(0),
+FS:fs(eq,y,x),
+F:rhs(eq),
+W:wronskian(FS,x),
+_n:length(FS),
+makelist(0,i,1,_n-1),
+_dp:append(%%,[F]),
+Wi:radcan(trigsimp(invert(W))),
+integrate(Wi._dp,x),
+ratsimp(%%),
+trigsimp(%%),
+logcontract(%%),
+FS.%%,
+ratsimp(%%),
+trigsimp(%%),
+trigreduce(%%),
+ratsimp(%%)
+)$
+
+partsol(eq,y,x):=block([s,eq1],
+eq1:subst(y=y(x),eq),
+if freeof(laplace,laplace(rhs(eq),x,s))
+and freeof(log,tan,atan,sec,csc,rhs(eq))
+then partsolL_UC(eq,y,x)
+else partsolL_VP(eq,y,x)
+)$
+
+/*
+16
+*/
+
+odeM(A,F,t):=block([W,gamma_expand,n,Ya],
+gamma_expand:true,
+n:length(F),
+W:matrix_exp(A,t),
+W.integrate(trigsimp(invert(W).F),t),
+trigrat(expand(%%)),
+Ya:expand(%%),
+W.transpose(makelist(concat(C,i),i,1,n))+Ya)$
+
+/*
+17
+*/
+
+odeM_ic(A,B,t,t0,Y0):=block([bspr],
+bspr:odeM(A,B,t),
+subst(t=t0,%%)-Y0,
+list_matrix_entries(%%),
+solve(%%,makelist(concat(C,i),i,1,length(Y0))),
+subst(%%[1],bspr),
+expand(%%)
+)$
+
+/*
+18
+*/
+
+matrix_exp(A,r):=block([n,B,s,t,Lap,f],
+n:length(A),
+B:invert(s*ident(n)-A),
+Lap(f):=ilt(f, s, t),
+matrixmap(Lap,B),
+subst(t=r,%%))$
+
+/*
+19
+*/
+
+odelinsys(A,F,t,t0,Y0):=block([s,g,expA],
+assume(t>t0),
+define(g(t),F),
+mat_function(exp,A*t),ratsimp(%%),
+define(Aexp(t),%%),
+Aexp(t-t0).Y0+integrate(Aexp(t-s).g(s),s,t0,t),
+expand(%%)
+)$
+
+/*
+20
+*/
+
+wronskian(functlist,var):=block([end],end:length(functlist)-1,functlist:[
+functlist],thru end do functlist:
+endcons(map(lambda([x],diff(x,var)),last(functlist)),functlist),
+apply('matrix,functlist))$
+
+/*
+etc
+*/
+
+itr2can(eq,y,x):=block(coeff(lhs(eq),'diff(y,x))/coeff(lhs(eq),'diff(y,x,2)),
+t=radcan(integrate(exp(-integrate(%%,x)),x)))$
+
+rootssimp(x):=block([maperror,mapprint],
+maperror:false,
+mapprint:false,
+map(polarform,x),rectform(%%),trigsimp(%%))$
+
+trigvalue(r):=block(
+[f,x,sol,spr,spr1,solvetrigwarn,algebraic],
+load (sqdnst),
+solvetrigwarn:false,
+algebraic:true,
+if freeof(%pi,r) then return(r),
+f:part(r,0),
+if part(r,0)="-" then f:part(r,1,0),
+if f=cot then f:tan,
+sol:solve(x=r,%pi)[1],
+sol*denom(rhs(sol)),
+map(f,%%),
+trigexpand(%%),
+factor(%%),
+spr:solve(%%,x),
+if (length(spr)<=2 or not freeof(%i,%%)) then return(r),
+spr1:sublist(spr,lambda([e],is(abs(rhs(e)-r)<ratepsilon))),
+if %%=[] then return(r),
+rhs(spr1[1]),
+sqrtdenest(%%),
+factor(%%)
+)$
+
diff --git a/share/contrib/trigtools/trigtools-doc.pdf b/share/contrib/trigtools/trigtools-doc.pdf
new file mode 100644
index 0000000..39e066c
Binary files /dev/null and b/share/contrib/trigtools/trigtools-doc.pdf differ
diff --git a/share/contrib/trigtools/trigtools.mac b/share/contrib/trigtools/trigtools.mac
new file mode 100644
index 0000000..7b96301
--- /dev/null
+++ b/share/contrib/trigtools/trigtools.mac
@@ -0,0 +1,189 @@
+
+/*
+trigtools package for working with expressions with trigonometric and hyperbolic functions.
+version 1.01, 2013.11
+Copyright (C) A.Domarkas 2013
+rigtools package is free software; you can redistribute it and/or
+modify it under the terms of the GNU General Public License.
+*/
+
+/*
+The function c2sin convert expression a*cos(x)+b*sin(x) to r*sin(x+phi).
+*/
+
+c2sin(f):=block([x,a,b,r,phi],
+x:listofvars(f)[1],
+a:coeff(f,cos(x)),b:coeff(f,sin(x)),
+r:signum(b)*sqrt(a^2+b^2),
+phi:atan(a/b),
+r*sin(x+phi)
+)$
+
+/*
+The function c2cos convert expression a*cos(x)+b*sin(x) to r*cos(x-phi).
+*/
+
+c2cos(f):=block([x,a,b,r,phi],
+x:listofvars(f)[1],
+a:coeff(f,sin(x)),b:coeff(f,cos(x)),
+r:signum(b)*sqrt(a^2+b^2),
+phi:atan(a/b),
+r*cos(x-phi))$
+
+/*
+The function c2trig (convert to trigonometric) reduce expression with hyperbolic functions
+ sinh, cosh, tanh, coth to trigonometric expression with sin, cos, tan, cot.
+*/
+
+c2trig(r):=block([x,i,sinv,cosv,mi,mii,%iargs:false],
+mi(x):=%i*x,
+mii(x):=-%i*x,
+sinv:compose_functions([mii,sin,mi]),
+tanv:compose_functions([mii,tan,mi]),
+cosv:compose_functions([cos,mi]),
+cotv:compose_functions([mi,cot,mi]),
+subst([sinh=sinv,cosh=cosv,tanh=tanv,coth=cotv],r),
+subst(%i=i,%%),
+trigrat(%%),
+trigreduce(%%),
+subst(i=%i,%%)
+)$
+
+/*
+The function c2hyp (convert to hyperbolic) convert expression with exp function
+ to expression with hyperbolic functions sinh, cosh.
+*/
+
+c2hyp(expr):=block([pa,f,e1,e2,S],
+pa(f):=if atom(f) then f else makelist(part(f,k),k,1,length(f)),
+S:[],
+e1:[pa(expr)],
+e2:sublist(%%,listp),
+sublist(e2,lambda ([x], part(x,1)=%e)),
+S:append(S,%%),
+e1:flatten(e2),
+while e1#[] do
+(map(pa,e1),
+e2:sublist(%%,listp),
+sublist(e2,lambda ([x], part(x,1)=%e)),
+S:append(S,%%),
+e1:flatten(e2)),
+makelist(exp(S[k][2])=cosh(S[k][2])+sinh(S[k][2]),k,1,length(S)),
+subst(%%,expr)
+)$
+
+/*
+The function trigfactor factors expressions of form +-sin(x)+-cos(y)
+*/
+
+trigfactor(f):=block([r,_x,_y,%piargs:false],
+st(f):=block([f0,fun,a1],
+ f0:part(f,0),
+ if f0=sin or f0=cos then return([part(f,0),part(f,1)])
+ elseif f0="-" then
+ f0:part(f,1,0),
+ if f0=sin or f0=cos then
+ return([part(f,1,0),part(f,1,1)])
+ else fail
+ ),
+ cx(x):=%pi/2-x,
+if nterms(f)=2 and op(f)="+" then
+(s1:st(part(f,1))[1], s2:st(part(f,2))[1])
+else return(f),
+if s1#false and f2#false and s1#s2 then
+ (sinv:compose_functions([cos,cx]),f1:subst([sin=sinv],f))
+ else f1:f,
+_x:st(part(f1,1))[2],_y:st(part(f1,2))[2],
+r:[2*sin((_x+_y)/2)*cos((_x-_y)/2),2*sin((_x-_y)/2)*cos((_x+_y)/2),
+2*cos((_x+_y)/2)*cos((_x-_y)/2),2*sin((_x+_y)/2)*sin((_x-_y)/2)],
+r:append(r,-r),
+%piargs:true,
+sublist(r,lambda([x],trigrat(f1-x)=0)),
+expand(%%),
+if length(%%)>=1 then %%[1] else f )$
+
+/*
+The function trigsolve find solutions of trigonometric equation from interval [a, b).
+*/
+
+trigsolve(eq,a,b):=block([s,i,ats,algebraic],
+algebraic:true,
+to_poly_solve([eq], [x],'simpfuncs =
+['rootscontract,'expand,'radcan,'nicedummies]),
+s:makelist(rhs(part(%%,k)[1]),k,1,length(%%)),
+ats:[],
+for i:1 thru length(s) do
+(makelist(ev(s[i],%z0=k),k,-10,10),
+ats:append(ats,%%)),
+sublist(ats,lambda([e],e>=a and e<b)),
+sort(%%),
+setify(%%)
+)$
+
+/*
+The function trigvalue compute values of sin(m*pi/n), cos(m*pi/n), tan(m*pi/n), cot(m*pi/n) in radicals.
+*/
+
+trigvalue(r):=block(
+[f,x,sol,spr,spr1,solvetrigwarn,algebraic],
+load (sqdnst),
+solvetrigwarn:false,
+algebraic:true,
+if freeof(%pi,r) then return(r),
+f:part(r,0),
+if part(r,0)="-" then f:part(r,1,0),
+if f=cot then f:tan,
+sol:solve(x=r,%pi)[1],
+sol*denom(rhs(sol)),
+map(f,%%),
+trigexpand(%%),
+factor(%%),
+spr:solve(%%,x),
+if (length(spr)<=2 or not freeof(%i,%%)) then return(r),
+spr1:sublist(spr,lambda([e],is(abs(rhs(e)-r)<ratepsilon))),
+if %%=[] then return(r),
+rhs(spr1[1]),
+sqrtdenest(%%),
+factor(%%)
+)$
+
+/*
+The function trigeval compute values of expressions with sin(m*pi/n), cos(m*pi/n), tan(m*pi/n), cot(m*pi/n)
+in radicals.
+*/
+
+trigeval(r):=block([sinv,cosv,tanv,cotv],
+sinv:compose_functions([trigvalue,sin]),
+cosv:compose_functions([trigvalue,cos]),
+tanv:compose_functions([trigvalue,tan]),
+cotv:compose_functions([trigvalue,cot]),
+subst([sin=sinv,cos=cosv, tan=tanv,cot=cotv],r)
+)$
+
+/*
+The function atan_contract contracts atan functions.
+*/
+
+atan_contract(r):=block([],
+if equal(r,%pi/2) then return(%pi/2)
+elseif equal(r,-%pi/2) then return(-%pi/2),
+is(abs(r)<%pi/2),
+if %%=true then
+(
+tan(r),
+trigexpand(%%),
+trigexpand(%%),
+atan(%%)
+)
+else return(r)
+)$
+
+/*
+compose_functions -- function from to_poly_solve package( used for trigeval, c2trig)
+*/
+
+compose_functions(l):=block([z,f],
+if listp(l) then (l:reverse(l),f:z,for lk in l do
+f:funmake(lk,[f]),buildq([z,f],lambda([z],f))) else
+error("The argument to 'compose_functions' must be a list."))$
+
diff --git a/src/share-subdirs.lisp b/src/share-subdirs.lisp
index a3c5803..761987c 100644
--- a/src/share-subdirs.lisp
+++ b/src/share-subdirs.lisp
@@ -15,5 +15,5 @@
;; DO NOT EDIT THIS LIST. It is automatically
;; generated by configure.
'(
-"affine" "algebra" "algebra/charsets" "algebra/solver" "amatrix" "bernstein" "calculus" "cobyla" "cobyla/ex" "cobyla/lisp" "colnew" "colnew/ex1" "colnew/ex2" "colnew/ex3" "colnew/ex4" "colnew/lisp" "combinatorics" "contrib" "contrib/Grobner" "contrib/Zeilberger" "contrib/altsimp" "contrib/bitwise" "contrib/boolsimp" "contrib/diffequations" "contrib/diffequations/tests" "contrib/format" "contrib/fresnel" "contrib/gentran" "contrib/gentran/man" "contrib/gentran/test" "contrib/gf" "contrib/integration" "contrib/levin" "contrib/lurkmathml" "contrib/maximaMathML" "contrib/mcclim" "contrib/namespaces" "contrib/noninteractive" "contrib/prim" "contrib/rand" "contrib/rkf45" "contrib/sarag" "contrib/smath" "contrib/state" "contrib/unit" "contrib/vector3d" "descriptive" "diff_form" "diffequations" "distrib" "draw" "dynamics" "ezunits" "finance" "fourier_elim" "fractals" "graphs" "hypergeometric" "integequations" "integer_sequence" "integration" "lapack" "lapack/blas" "lapack/lapack" "lbfgs" "linearalgebra" "logic" "lsquares" "macro" "matrix" "minpack" "minpack/lisp" "misc" "mnewton" "multiadditive" "numeric" "numericalio" "orthopoly" "pdiff" "physics" "simplex" "simplex/Tests" "simplification" "solve_rat_ineq" "solve_rec" "stats" "stringproc" "sym" "tensor" "to_poly_solve" "trigonometry" "utils" "vector" "z_transform"
+"affine" "algebra" "algebra/charsets" "algebra/solver" "amatrix" "bernstein" "calculus" "cobyla" "cobyla/ex" "cobyla/lisp" "colnew" "colnew/ex1" "colnew/ex2" "colnew/ex3" "colnew/ex4" "colnew/lisp" "combinatorics" "contrib" "contrib/Grobner" "contrib/Zeilberger" "contrib/altsimp" "contrib/bitwise" "contrib/boolsimp" "contrib/diffequations" "contrib/diffequations/tests" "contrib/format" "contrib/fresnel" "contrib/gentran" "contrib/gentran/man" "contrib/gentran/test" "contrib/gf" "contrib/integration" "contrib/levin" "contrib/lurkmathml" "contrib/maximaMathML" "contrib/mcclim" "contrib/namespaces" "contrib/noninteractive" "contrib/odes" "contrib/prim" "contrib/rand" "contrib/rkf45" "contrib/sarag" "contrib/smath" "contrib/state" "contrib/trigtools" "contrib/unit" "contrib/vector3d" "descriptive" "diff_form" "diffequations" "distrib" "draw" "dynamics" "ezunits" "finance" "fourier_elim" "fractals" "graphs" "hypergeometric" "integequations" "integer_sequence" "integration" "lapack" "lapack/blas" "lapack/lapack" "lbfgs" "linearalgebra" "logic" "lsquares" "macro" "matrix" "minpack" "minpack/lisp" "misc" "mnewton" "multiadditive" "numeric" "numericalio" "orthopoly" "pdiff" "physics" "simplex" "simplex/Tests" "simplification" "solve_rat_ineq" "solve_rec" "stats" "stringproc" "sym" "tensor" "to_poly_solve" "trigonometry" "utils" "vector" "z_transform"
)))
diff --git a/src/sharefiles.mk b/src/sharefiles.mk
index 1f7cb36..ed4b6db 100644
--- a/src/sharefiles.mk
+++ b/src/sharefiles.mk
@@ -366,6 +366,8 @@ contrib/noninteractive/asksign1.lisp \
contrib/noninteractive/noninteractive.lisp \
contrib/noninteractive/noninteractive.mac \
contrib/noninteractive/rtest_noninteractive.mac \
+contrib/odes/odes-doc.pdf \
+contrib/odes/odes.mac \
contrib/opsubst.lisp \
contrib/prim/prim-ex1.mac \
contrib/prim/prim-ex.mac \
@@ -466,6 +468,8 @@ contrib/state/tree.mac \
contrib/stirling.mac \
contrib/tex2ooo.lisp \
contrib/tocl.lisp \
+contrib/trigtools/trigtools-doc.pdf \
+contrib/trigtools/trigtools.mac \
contrib/unit/unit-functions.lisp \
contrib/unit/unit.mac \
contrib/unit/unit.texi \
commit 0e9968685cf73ecdbb0ce8ba3104523bd86acf0b
Merge: 6dc5fae bea2de8
Author: Robert Dodier <rob...@us...>
Date: Thu Dec 26 14:12:25 2013 -0800
Merge branch 'master' of ssh://git.code.sf.net/p/maxima/code
-----------------------------------------------------------------------
Summary of changes:
share/contrib/odes/odes-doc.pdf | Bin 0 -> 317544 bytes
share/contrib/odes/odes.mac | 427 +++++++++++++++++++++++++++++
share/contrib/trigtools/trigtools-doc.pdf | Bin 0 -> 345871 bytes
share/contrib/trigtools/trigtools.mac | 189 +++++++++++++
share/ezunits/ezunits.lisp | 2 +
share/numeric/interpol.mac | 4 +-
share/numeric/rtest_interpol.mac | 23 ++
src/commac.lisp | 10 +-
src/mlisp.lisp | 2 +
src/share-subdirs.lisp | 2 +-
src/sharefiles.mk | 4 +
11 files changed, 660 insertions(+), 3 deletions(-)
create mode 100644 share/contrib/odes/odes-doc.pdf
create mode 100644 share/contrib/odes/odes.mac
create mode 100644 share/contrib/trigtools/trigtools-doc.pdf
create mode 100644 share/contrib/trigtools/trigtools.mac
hooks/post-receive
--
Maxima CAS
|
