file_search_maxima: append (file_search_maxima,
["c:/lisp/mmasim2015/###.mac"])$
file_search_lisp: append (file_search_lisp,
["c:/lisp/mmasim2015/###.lisp"])$
if MmaInfixLoaded#true then load("infixa.mac")$
kill(a,b,g,f,gg,k,q,r1,r2,r3,r4,r5,r6,r7,r8,r8f,rc4,
r7f,w,rules,fact,quad,M,start,tail,x,at,bt,foo,fooz,r3r)$
testcount:1$
/*WARNING -- some of the infix syntax includes characters that interact with
wxmaxima front ends, and so the commands may not work if you type them in there.
Commands that use ; or $, in particular, in sympathy with Mathematica, will not
always work. Using Maxima in a text window (e.g. run maxima.bat in a terminal
or emacs windows) works better. */
test (a,b):= if a=pt(b) then testcount:testcount+1 else
print("*********** ",a," # ",b, "testcount =", testcount)$
test ( pt(a__integer), Pattern(a,BlankSegment(integer)))$
test (mp1( f(a,x_integer),f(a,3)), [x -> 3])$
test (mp1(f(a),f(a)), [])$
test ((k*k/. f_*f_-> square(f)), square(k))$
test ((k*k/. f_^2-> square(f)), square(k))$
test (mp1(Alternatives(a_symbol,a_integer),3), [a -> 3])$
test ( f(g(f(d),k(e)))/. x_(d) ->hi(x), f(g(hi(f),k(e))))$
mdeclare(c,Orderless)$
test ( c(a,b) /. c(b,a)->win, win)$
test (f(a,b)/. [a->1,b->2], f(1,2))$
test ( q(a,b,c)/. q(x_,y__)-> M(start(x),tail(y)), M(start(a),tail(b,c)))$
test (f(3)+f(4)/. a_integer?$oddp -> a-1, f(2)+f(4))$
test (3/.a_?$oddp -> a+1, 4)$
test (f(3,4)/. f(a_,b_)/;a+b=7 -> lucky7, lucky7)$
test (f(3,4)+g(9,10)/. f(a_,b_)/;a+b=7 -> lucky7, lucky7+g(9,10))$
test (f(3,4)+f(90,10)/. f(a_,b_)/;a<b -> lucky7, lucky7+f(90,10))$
r8:(f(a_,b_integer?$evenp)->f(b+a))$
RuleToFn(r8f,r8)$
r7:(f(a_,b_integer?$oddp) ->b*f(a))$
RuleToFn(r7f,r7)$
test (r8f(f(w,6)),f(w+6))$
test (x/.x+a_.$->r(a), r(0))$
test (x+y/.x+a_.$->r(a), r(y))$
test (y/. x+a_.$ ->r(a),y)$
test (x^2/. x^2+b_.$ -> yes(b),yes(0))$
test (x^a+y /. x^n1_.$ +y^n2_.$ -> pows(n1,n2), pows(a,1))$
test (mm( ff(123, 456)) /. mm(a:$ ff(z__)) -> yes(a,z), yes(ff(123,456),123,456))$
test (mp1(a:$f(b_integer), f(3)), [b -> 3,a -> f(3)])$
test ((1-x)*(x-1)^k /. a_^b_*c_ -> -a^(b+1) /; a=-c, -(x-1)^(k+1))$
test ((1-x)*(x-1)^k*(x-y)^n*(y-x) /. a_^b_*c_ -> -a^(b+1) /; a=-c, (x-1)^(k+1)*(x-y)^(n+1))$
qrule:a_.$+b_.$*x_+c_.$*x_^2-> quad(x,c,b,a)$
test (3*r^2+4*r+5/. qrule, quad(r,3,4,5))$
test ( r^2+4*r+5/. qrule, quad(r,1,4,5))$
test ( r^2+ r+5/. qrule, quad(r,1,1,5))$
test ( r^2+ r /. qrule, quad(r,1,1,0))$
test ( r^2+ c /. qrule, r^2+c)$
test ( r^2+ b*r /. qrule,quad(r,1,b,0))$ /*? uses 1 default for *, not 0 default for + */
test ( aa*x^2+bb*x+cc/.qrule, quad(x,aa,bb,cc))$ /* careful. Needs parallel substitute if actually a*x^2+b*x+c */
test ((1-z)^w*(z-1)/. x_^a_*y_ /; x=-y -> -x^(a+1), -(1-z)^(w+1))$
test ( a+c+d+e/. x__symbol +c -> 5+W(x), W(a,d,e)+5)$
mdeclare(bub,Flat)$
sortme: bub(a___,b_,c_,d___)/; b>c -> bub(a,c,b,d)$ /* one line bubble sort */
test( bub(1,2,3,10,9,8,7,4,5,2)/. sortme, bub(1, 2, 2, 3, 4, 5, 7, 8, 9, 10))$
/* this is a very slow sorting program. */
/*a rule from Rubi, mashed around a bit
original:
Int[(a_.*x_^q_.+b_.*x_^n_.)^p_,x_Symbol] :=
(a*x^q+b*x^n)^(p+1)/(b*(n-q)(p+1)*x^(n-1)) /;
FreeQ[{a,b,n,p,q},x] && Not[IntegerQ[p]] && NonzeroQ[n-q] && ZeroQ[p*q-n+q+1]
our version */
FreeQ(lis, thevar):= block([ans:true],
for z in lis do if not(freeof(thevar,z))
then return(ans:false),
ans)$
rubirule: Int((a_.$*x_^q_.$+b_.$*x_^n_.$)^p_,x_symbol)
-> Rubi(a,b,q,n,p,x)$
test (Int((3*x^q+b*x^r)^p,x) /. rubirule, Rubi(3,3,r,q,p,x))$
test (f(q)+g(4)/. [a_integer-> foo,f(b_symbol)->b], q+g(foo))$
test (g(3,4)+g(4,3) /. g(a_integer,b_integer)/;a>b -> BigFirst, BigFirst+g(3,4))$
/*transforming mma-style rules to Maxima-style rules, and applying them */
RuleToFn(r1,a_integer-> foo)$
RuleToFn(r2,f(b_symbol)->b)$
RuleToFn(r3, g(a_integer,b_integer)/;a>b -> BigFirst)$
test (matapply1(f(q)+g(4),r1,r2), q+g(foo))$
test (matapply1(g(3,4)+g(4,3),r3),BigFirst+g(3,4))$
test (n/d /. a_ratio->R(a), n/d)$
test (n/d /. a_/b_->R(n,d),R(n,d))$
test (exp(-x)/. exp(a_) -> pow(e,a), pow(e,-x))$
test (exp(-x)/. r_^s_ -> pow(r,s), pow(%e,-x))$
test ( f(3)+g(q)/. f->h, h(3)+g(q))$
test ( f(3)+g(q)/. f(a_)->h(a), h(3)+g(q))$
test ( f(3)+g(q)/. f_symbol-> h, h(h(3),h(h)))$
/* here is an example of how to alter the Maxima simplifier using
mma-style rules. */
RuleToFn (fac0,fact(0)-> 1)$
RuleToFn (facn, fact(x_integer)/;x>0->x*fact(x-1))$
matchdeclare(aa,true)$
tellsimpafter(fact(aa),matapply1(fact(aa),facn,fac0))$ /* rule order matters */
test (fact(4),24)$
test ( f(3)/.a_integer?$oddp->a, f(3))$
test (sin(x)/. f_(a_)/;equal(f,sin)or equal(f,cos) -> trig(f,a),trig(sin,x))$
test ( cos(x)/. f_(a_)->trig(f,a)/;equal(f,cos), trig(cos,x))$
test (mp1( a_+Optional(b_),x) , [b->0,a ->x])$
test (mp1( a_+Optional(b_),x+y) , [a->x,b->y])$
/* test (f(3)/.a_integer?$oddp:>block([q:a+1],print("a=",q),43+a),
'f(block([q : 4], print("a=", q), 46)))$ */
test (g(f(3),f(4))/.a_integer?$oddp->a+1, g(f(4),f(4)))$
test ( f(3)+f(4)/.a_integer?$oddp->a+1, 2*f(4))$
test (s^2+c^2+k+w /.s^2+c^2-> 1, w+k+1)$
test ( sin(y)^2+cos(y)^2+sin(2*w)^2+cos(3*w)^2+cos(2*w)^2+4/. sin(z_)^2+cos(z_)^2 -> 1,
cos(3*w)^2+6)$
matchdeclare(at,true,bt,true)$
tellsimpafter(fooz(at,bt),
fooz(at,bt)/.[ fooz(a_integer,b_?$evenp) -> foozeven(a,b),
fooz(a_integer,b_?$oddp) -> foozodd(a,b)])$
test (fooz(3,4)+fooz(5,5)+fooz(a,b), foozeven(3,4)+foozodd(5,5)+fooz(a,b))$
/* note the following test MUST use :> rather than ->. num(a) is a, denom(a) is 1.
must delay evaluation of num(a) until AFTER a is bound to 1/2 */
test (a*b*c /. r_*c->xx, b*xx)$ /*could be a*xx*/
test (a*b*c /. r__*c->xx, xx)$
test (a*b*c*d*s /. r__*s ->q+f(r), q +f(a,b,c,d))$
test (a*b*c/. r_*a ->q /; r=b, c*q)$
test ((1-x)*(x-1)^k*z /. a_^b_*c_ -> -a^(b+1) /; a=-c, -(x-1)^(k+1)*z)$
test ( a*b*c*d*s /. r_*s ->q /; r=b, a*q*c*d)$
test (f(x) /.f( a_+Optional(b_)) -> g(a,b), g(x,0))$
test (f(x+s+r) /.f( a_+Optional(b__)) -> g(a,[b]), g(r,[s,x]))$ /* among others */
solvequad:
sol(
(c__.$+b_.$*x_+a_.$*x_^2)
|
DefaultBind(b,0, c__.$+a_.$*x_^2)) /*DefaultBind is a new feature not in mma */
/; freeof(x,a) and freeof(x,b) and freeof(x,c)
-> [(-b+sqrt(b^2-4*a*c))/(2*a),
(-b-sqrt(b^2-4*a*c))/(2*a)]$
test (sol(a*x^2+b*x+c)/. solvequad, [(sqrt(b^2-4*a*c)-b)/(2*a),(-sqrt(b^2-4*a*c)-b)/(2*a)])$
test (sol(a*x^2+1) /. solvequad, [sqrt(-a)/a,-sqrt(-a)/a])$
test (sol(x ^2+x)/. solvequad, [0,-1])$
test (sol(x ^3+x)/. solvequad, sol(x ^3+x))$ /* not a quadratic */
test (sol(x+a)/. solvequad, sol(x+a))$ /* not a quadratic*/
test (sol(sin(x)*x^2+x)/. solvequad, sol(sin(x)*x^2+x))$ /*not a quadratic*/
test (sol((x+1)*(x-1))/. solvequad, sol ((x+1)*(x-1)))$ /* secretly a quadratic */
test (sol(x^3+x^2)/. solvequad, sol(x^3+x^2))$
test(mp1(n_.$*x_, q), [n->1, x->q])$
test(mp1(n_.$+x_, q), [n->0,x -> q])$
mdeclare(z,Orderless)$
mdeclare(z,Flat)$
test(z(a,1,b,2)/. z(x__integer,y__symbol)-> n(x,y),n(1,2,a,b))$
/*arguably this, below could be z(m(b,a)+n(4,3,1,2)). Here we do same as in mma */
test(z(2,1,3,4,a,b)/. z(x__integer,y__symbol)-> n(x)+m(y), m(a,b)+n(2,1,3,4))$
test(z(a,1,b,2)/. z(x__integer,y__symbol)-> x, 1)$ /* for example */
/*arguably this, above,should be just 1 or 2 . */
/* like a*1*b*2 /. x__integer*y__symbol --> x would give 1*2
test(z(a,1,b,2)/. z(x__integer,y__symbol)-> n(x)+m(y))$
gives z(m(b, a) + n(1), 2)
like a*1*b*2 /. x__integer*y__symbol --> (m(b,a)*n(1))* 2
one of several possibilities I suppose, but not what mma gives tho' */
test(sin(a)+cos(b) /. [sin->cos,a->b],2*cos(b))$
test(Replace(a,[a->b,b->c]), c)$
test (w1(1,3)/. w1(x__?$oddp)->yes(x), yes(1,3))$
test ( x+ 3/. z_+(a_integer) -> z(a+1), x(4))$
mdeclare(q,Orderless)$
test( Replace(z(1,2) , z(x__?$ oddp,y__?$evenp) -> n(x)+m(y)), m(2)+n(1))$
test(Replace(z(1,3,2,4) , z(x__?$ oddp,y__?$evenp) -> n(x)+m(y)), m(2,4)+n(1,3))$
test( Replace(zxx(1,3,2,4) , zxx(x__?$ oddp, y__?$evenp) -> n(x)+m(y)), m(2,4)+n(1,3))$
/* not the only possibility, below */
test(Replace(z(2,1,3,4,a,b,3.4), z(x__integer,y__symbol)-> n(x)+m(y)), z(n(2,1,3,4)+m(a),b, 3.4))$
test(Replace(z(2,a,b,3,5,6), z(x__integer?$oddp,y___?$evenp,w__?$symbolp)-> n([x],[y],[w])), n([3,5],[2,6],[a,b]))$
test( mp1(q(a___integer?$oddp,b___integer?$evenp), q(1,2,3,4)), [a->'Segment(1,3),b->'Segment(2,4)])$
test(z(2,1,3,4,a,b,3.4)/. z(x__integer,y__symbol)-> n(x)+m(y), z(m(a) + n(2, 1, 3, 4), b, 3.4) ) /* maybe prefer z(n(2,1,3,4)+m(b,a), 3.4) */ $
test(mp1all(z(x__integer,y__symbol),z(a,1,b,2)),
[[Rule(x,'Segment(2,1)),Rule(y,'Segment(b,a))],[Rule(x,'Segment(2,1)),
Rule(y,'Segment(a,b))],[Rule(x,'Segment(1,2)),Rule(y,'Segment(b,a))],[Rule(x,
'Segment(1,2)),Rule(y,'Segment(a,b))]])$
Replace(z(1,2,3,4,5), z(a__integer?$oddp,b___integer?$evenp)-> e(b)+o(a))$
/* show how segments work when they appear in a replacement or anywhere else*/
test(q(3,4,5) /. q(a___)-> sticktogether(1,2,a,6,7), sticktogether(1,2,3,4,5,6,7))$
test(h(1,2,Segment(3,4),5,6), h(1,2,3,4,5,6))$
test(cos(x)+sin(y) /. (f_(a_) :> trig(f,a)) /; member(f,[sin,cos]),
trig(cos,x)+trig(sin,y))$
test(cos(w)+sin(z) /. [q_sin :> trig(s,args(q)[1]),
q_cos :> trig(c,args(q)[1])],
trig(c,w)+trig(s,z))$
r0: d(y_,x_)/; freeof(x,y)->0$
r1: d(y_^n_integer,x_) -> n*y^(n-1)*d(y,x)$
r2: d(sin(y_),x_)-> cos(y)*d(y,x)$
r3:(d(x_,x_)->1)$
r4: d(a_+b__,x_):> map(lambda([r],d(r,x)),a+b)$
r5: d(a_*b__,x_):> apply("+",map(lambda([r],a*b*d(r,x)/r), args(a*b)))$
alltherules:[r0,r1,r2,r3,r4,r5]$
/* rules for differentiation need to be repeatedly applied, so here we test "replace repeatedly"*/
test (d(sin(x)^2,x) //. alltherules, 2*cos(x)*sin(x))$
test (d(sin(x)^2+sin(x^2)^3,x) //. [r1,r2,r3,r4,r5], 6*x*cos(x^2)*sin(x^2)^2+2*cos(x)*sin(x))$
test (d(f(x)*g(x)*h(x),x)//. r5, f(x)*g(x)*d(h(x),x)+f(x)*h(x)*d(g(x),x)+g(x)*h(x)*d(f(x),x))$
r6:d(exp(y_),x_)->exp(y)*d(y,x)$
r7:d(a_^b_, x_)-> d(exp(b*log(a)),x)$
r8: d(log(a_),x_)-> d(a,x)/x$
alltherules: [r0,r1,r2,r3,r4,r5,r6,r7,r8]$
test(d(ff1(x)^gg1(x),x) //. alltherules , %e^(gg1(x)*log(ff1(x)))*(log(ff1(x))*d(gg1(x),x)+gg1(x)*d(ff1(x),x)/x))$
/* interval arithmetic. il = IntervaL */
ri1: il(lo_,hi_)+il(lo2_,hi2_)-> il(limit(lo+lo2),limit(hi+hi2))$
test(il(1,2)+il(3,4)+il(5,6)+x /. ri1, x+il(9,12))$
test(il(0,inf)+il(minf,0) /. ri1, il(minf,inf))$
ri2: il(lo_,hi_)*il(lo2_,hi2_)->
block([p:limit([lo*lo2,lo*hi2,hi*lo2,hi*hi2])],
il(apply(min,p),apply(max,p)))$
/* test(il(0,1)*il(-inf,inf)/. ri2, il(minf,inf))$ */
test(il(-1,2)*il(3,4)/.ri2, il(-4,8))$
test( il(a,2)*il(2,3)+il(3,4)+z/. [ri2,ri1],z+il(min(4,3*a,2*a)+3,max(6,2*a,3*a)+4))$
test( il(0,2)*il(2,3)//. ri2, il(0,6))$
/* Maybe this is simpler than defrule etc which would force us
to write rules for il1(l1,h1)*il2(l2,h2)+ as well as il1(l1,h1)*il2(l2,h2)+ any ...
etc. It is still kind of crude. */
test(Replace(f(7), a:$f(b_integer)->g(a,b+1)), g(f(7),8))$
test (mp1(a:$f(b_integer?$evenp), f(4)), [Rule(b,4),Rule(a,f(4))])$
test ( x+ 3/. z_+(a_integer) -> z(a+1), x(4))$
test(g(3,x)/. g(anon_integer,anon_symbol)->yep, yep)$ /* two anons don't have to match*/
test(g(x,3)/. g(anon_integer,anon_symbol)->yep, g(x,3))$
test(Replace(g(3,x), aha:$ g(anon_integer,anon_symbol)->yes(aha)), yes(g(3,x)))$
test( Replace(z(1,4,3,b,a,2), z(x__?$oddp,y__?$evenp,w__?$symbolp)-> n([x],[y],[w])),
n([1,3],[4,2],[b,a]))$
mdeclare(?mnctimes, Flat)$
rc4: p.q->s$
test(p.q.r.s /. rc4, s.r.s)$
test(z.p.q/. p.q->s, z.s)$
test (1/2 /. a_ratio:> R(num(a),denom(a)),R(1,2))$
/* We rely on limit calcs so that 2*inf is simplified to inf, etc. */
ri3: il(lo_,hi_)+x_?$numberp:> il(limit(lo+x),limit(hi+x))$
test(il(0,1)+4.1/. ri3, il(4.1,5.1))$
test(mp1((a_+m_?$evenp),(b+4)),[a->b, m->4])$
test(mp1((m_?$evenp)+a_,(b+4)), [a->b, m->4])$
test(mp1((m_?$evenp)+z_,(b+4)), [m->4,z->b])$ /*ok */
test (f(3,4)+f(90,10)/. f(a_,b_)/;a<b -> sorted(a,b), sorted(3,4)+f(90,10))$
test (mp1all(a_+b_,x+y), [[a->y, b -> x],[a->x, b->y]])$
/* known bugs go here ****************************
on my computer,
:lisp (compile-file "e19a.lisp)
load("e19a.o");
reduces the runtime for 12/28/2015 of
batch(testmma) from 0.984 sec... to 0.73 sec. eh.
*/
Done;