/*************** -*- Mode: MACSYMA; Package: MAXIMA -*- ******************/ /*************************************************************************** *** ***** *** Copyright (c) 1984 by William Schelter,University of Texas ***** *** All rights reserved ***** ***************************************************************************/ (kill(all), use_fast_arrays: true, 0); 0; display(b[1,2]); done$ exp1:integrate(1/(x^3+2),x); -log(x^2-2^(1/3)*x+2^(2/3))/(6*2^(2/3))+atan((2*x-2^(1/3))/(2^(1/3)*sqrt(3))) /(2^(2/3)*sqrt(3)) +log(x+2^(1/3))/(3*2^(2/3)); /* tops 20 got exp1 below but exp2 is also ok.*/ /* lispm got -2^(1/3)*log(2^(2/3)*x^2-2*x+2*2^(1/3))/12 +2^(1/3)*atan((2*2^(2/3)*x-2)/(2*sqrt(3)))/(2*sqrt(3)) +2^(1/3)*log(x+2^(1/3))/6$ */ exp2:diff(exp1,x); 1/(3*((2*x-2^(1/3))^2/(3*2^(2/3))+1))-(2*x-2^(1/3)) /(6*2^(2/3)*(x^2-2^(1/3)*x+2^(2/3))) +1/(3*2^(2/3)*(x+2^(1/3)))$ /* was 1/(3*((2*2^(2/3)*x-2)^2/12+1))-2^(1/3)*(2*2^(2/3)*x-2) /(12*(2^(2/3)*x^2-2*x+2*2^(1/3))) +2^(1/3)/(6*(x+2^(1/3)))$ which is equal */ radcan(exp2); 1/(x^3+2)$ (exp1:-log(x^2-2^(1/3)*x+2^(2/3))/(6*2^(2/3))+atan((2*x-2^(1/3))/(2^(1/3)*sqrt(3))) /(2^(2/3)*sqrt(3)) +log(x+2^(1/3))/(3*2^(2/3)),0); 0$ /* It's not easy to test reveal. Let's not worry about it too much. */ expand(reveal(exp1,2),0,0); Negterm + 2 * Quotient$ expand(reveal(exp1,3),0,0); log/Product(2)+atan/Product(2)-Quotient$ g(l):=catch(map(lambda([x],if x < 0 then throw(x) else f(x)),l)); g(l):=catch(map(lambda([x],if x < 0 then throw(x) else f(x)),l))$ g([1,2,3,7]); [f(1),f(2),f(3),f(7)]$ g([1,2,-3,7]); -3$ (kill(b),0); 0$ exp1:y^2+b*x; y^2+b*x$ orderless(y); done$ y^2+b*x; b*x+y^2$ string(%-exp1); "y^2-y^2"$ unorder(); [y]$ exp:a^2+b*x; b*x+a^2$ ordergreat(a); done$ a^2+b*x; a^2+b*x$ string(%-exp); "a^2-a^2"$ unorder(); [a]$ exp:a^2+b*x; b*x+a^2$ ordergreat(a); done$ a^2+b*x; a^2+b*x$ string(%-exp); "a^2-a^2"$ unorder(); [a]$ declare(f,linear); done$ f(2*a+3*b); 3*f(b)+2*f(a)$ f(2*x+y,x); f(1,x)*y+2*f(x,x)$ declare (c1, constant); done; f (x*c1/2 + 2*y/c1); c1*f(x)/2 + 2*f(y)/c1; declare(f,additive); done$ f(2*a+3*b); 3*f(b)+2*f(a)$ declare(f,outative); done$ f(2*a); 2*f(a)$ declare(f,multiplicative); done$ f(2*a*b); 2*f(a)*f(b)$ (kill(functions),declare(g,lassociative)); done$ g(g(a,b),g(c,d)); g(g(g(a,b),c),d)$ g(g(a,b),g(c,d))-g(a,g(b,g(c,d))); 0$ declare(g,rassociative); done$ g(g(a,b),g(c,d)); g(g(g(a,b),c),d)$ g(g(a,b),g(c,d))-g(a,g(b,g(c,d))); 0$ (kill(h),declare(h,commutative)); done$ h(x,z,y); h(x,y,z)$ (kill(h),declare(h,symmetric)); done$ h(x,z,y); h(x,y,z)$ (kill(h),declare(h,antisymmetric)); done$ h(x,z,y); -h(x,y,z)$ (kill(all),declare(j,nary)); done$ j(j(a,b),j(c,d)); j(a,b,c,d)$ declare(f,oddfun); done$ f(-x); -f(x)$ declare(g,evenfun); done$ g(-x); g(x)$ (kill(all),kill(g),declare(f,posfun)); done$ is(f(x) > 0); true$ (kill (foo), declare (foo, [nary, symmetric])); done; foo (a, 1, h, 2, z, d, %pi); foo (1, 2, %pi, a, d, h, z); foo (a, foo (1, foo (h, 2), z), foo (d, %pi)); foo (1, 2, %pi, a, d, h, z); (kill(all),b[1,x]:1); 1$ (array(f,2,3),0); 0$ arrayinfo(b); [hash_table, true, [1, x]]$ /* tops 20: this is incompatible difference [hashed,2,[1,x]]$ */ arrayinfo(f); [declared,2,[2,3]]$ block([use_fast_arrays:false],kill(bb),bb[1,x]:7,arrayinfo(bb)); [hashed, 2, [1, x]]; block([use_fast_arrays:true],kill(bb),bb[1,x]:7,arrayinfo(bb)); [hash_table, true, [1, x]]$ properties(?cons); ["system function"]$ assume(var1 > 0); [var1 > 0]$ properties(var1); ["database info",var1 > 0]$ var2:2; 2$ properties(var2); [value]$ gradef(r,x,x/r); r$ gradef(r,y,y/r); r$ printprops(r,atomgrad); done$ propvars(atomgrad); [r]$ gradef(r,x,x/r); r$ gradef(r,y,y/r); r$ printprops(r,atomgrad); done$ propvars(atomgrad); [r]$ put(%e,transcendental,type); transcendental$ put(%pi,transcendental,type); transcendental$ block([algebraic:false],put(%i,algebraic,type)); false$ typeof(x):=block([q],if numberp(x) then return(algebraic), if not atom(x) then return(maplist(typeof,x)),q:get(x,type), if q = false then error("not numeric") else q); typeof(x):=block([q],if numberp(x) then return(algebraic), if not atom(x) then return(maplist(typeof,x)),q:get(x,type), if q = false then error("not numeric") else q)$ block([algebraic:false],errcatch(typeof(2*%e+x*%pi))); []$ block([algebraic:false],typeof(2*%e+%pi)); [transcendental,[false,transcendental]]$ is(x^2 >= 2*x-1); true$ assume(a > 1); [a > 1]$ is(log(log(a+1)+1) > 0 and a^2+1 > 2*a); true$ freeof(y,sin(x+2*y)); false$ freeof(cos(y),"*",sin(y)+cos(x)); true$ /* freeof should try both noun and verb forms */ (kill (f, g, h, x, n), 0); 0; freeof (sin, sin (x)); false; freeof (integrate, 'integrate (f(x), x)); false; freeof (diff, 'diff (f(x), x)); false; freeof (sum, 'sum (f(x), x, 1, n)); false; freeof (limit, 'limit (f(x), x, inf)); false; freeof (sin, f (g (1 + sin (h (x))))); false; freeof (integrate, f (g (x - 'integrate (h (x), x)))); false; freeof (diff, f (g (x * 'diff (h (x), x, 3)))); false; freeof (sum, f (g (x / 'sum (h (x), x, 2, n)))); false; freeof (limit, f (g (x ^ 'limit (h (x), x, inf)))); false; /* Additional freeof tests */ lfreeof([x],y); true$ lfreeof([x],y+z); true$ lfreeof([x,y],y+z); false$ use_fast_arrays: false; false; /* It would be nice to test foreign language characters here. * Is there a way to make such tests independent of environment stuff like $LANG ?? */ declare ("|~`", alphabetic); done; [member ('alphabetic, properties ("|")), member ('alphabetic, properties ("`")), member ('alphabetic, properties ("~"))]; [true, true, true]; ~`||`~ : ~|^`~ - |~^~`; ~|^`~ - |~^~`; (kill (~`||`~), ~`||`~); '~`||`~; (remove ("`~", alphabetic), remove ("|", alphabetic)); done; [member ('alphabetic, properties ("|")), member ('alphabetic, properties ("`")), member ('alphabetic, properties ("~"))]; [false, false, false]; /* Verify that time functions are defined and return numbers. * Don't bother trying to verify if the values are reasonable. */ [integerp (absolute_real_time ()), floatnump (elapsed_real_time ()), floatnump (elapsed_run_time ())]; [true, true, true]; stringp (timedate ()); true; stringp (timedate (100*365*24*3600)); true; /* date parsing */ parse_timedate (timedate (86400)); 86400; parse_timedate (timedate (86401)); 86401; parse_timedate (timedate (87400)); 87400; parse_timedate (timedate (1000000)); 1000000; parse_timedate (timedate (1000000000)); 1000000000; parse_timedate (timedate (10000000000)); 10000000000; /* Do the right thing when listarray and arrayinfo are called within * a function and the name of the formal argument coincides with the * name of the actual argument. (Was a bug in ARRAYINFO-AUX.) */ (foo(x) := apply (arrayinfo, [x]), bar(x) := listarray (x), kill (x), x[1] : 1234, foo(x)); [hashed, 1, [1]]; bar(x); [1234]; (kill(y), y[2] : 2345, foo(y)); [hashed, 1, [2]]; bar(y); [2345]; /* constant declaration -- bug reported to mailing list 2009-05-02 */ (kill (aa, xx, yy, zz), sort (listofvars (xx + yy * zz))); [xx, yy, zz]; (aa : newcontext (), declare (zz, constant)); done; facts (aa); [kind (zz, constant)]; [featurep (xx, constant), featurep (yy, constant), featurep (zz, constant)]; [false, false, true]; constantp (zz); true; sort (listofvars (xx + yy * zz)); [xx, yy]; constantp (sin(xx)/exp(yy) + %pi^zz); false; declare ([xx, yy], constant); done; sort (facts (aa)); [kind (xx, constant), kind (yy, constant), kind (zz, constant)]; [featurep (xx, constant), featurep (yy, constant), featurep (zz, constant)]; [true, true, true]; constantp (sin(xx)/exp(yy) + %pi^zz); true; kill (zz); done; sort (facts (aa)); [kind (xx, constant), kind (yy, constant)]; [featurep (xx, constant), featurep (yy, constant), featurep (zz, constant)]; [true, true, false]; constantp (zz); false; listofvars (xx + yy * zz); [zz]; constantp (sin(xx)/exp(yy)); true; constantp (sin(xx)/exp(yy) + %pi^zz); false; kill (xx, yy); done; facts (aa); []; [constantp (xx), constantp (yy), constantp (zz), constantp (xx + yy + zz)]; [false, false, false, false]; sort (listofvars (xx + yy * zz)); [xx, yy, zz]; killcontext (aa); done; /* tellsimp interaction with rassociative declaration * from the mailing list circa 2011-03-25 */ (kill (zand, zor, a, b, c), declare (zand, rassociative)); done; zand (a, zand (b, c)); zand (a, zand (b, c)); zand (zand (a, b), c); zand (a, zand (b, c)); (matchdeclare ([var1, var2, var3], all), tellsimp (zand (zor (var1, var2), var3), zor (zand (var1, var3), zand (var2, var3))), tellsimp (zand (var1, zor (var2, var3)), zor (zand (var1, var2), zand (var1, var3))), 0); 0; zand (zor (a, b), c); zor (zand (a, c), zand (b, c)); zand (a, zor (b, c)); zor (zand (a, b), zand (a, c)); zand (a, zand (b, c)); zand (a, zand (b, c)); zand (zand (a, b), c); zand (a, zand (b, c)); /* try it w/ lassociative as well */ (remove (zand, rassociative), declare (zand, lassociative)); done; zand (zand (a, b), c); zand (zand (a, b), c); zand (a, zand (b, c)); zand (zand (a, b), c); zand (zor (a, b), c); zor (zand (a, c), zand (b, c)); zand (a, zor (b, c)); zor (zand (a, b), zand (a, c)); /* another lassociative/rassociative bug, tickled by rule which returns an atom * reported to mailing list 2015-03-16: "Requesting advice on simplification rules for user-defined operators" */ kill (a, b, c, d, e, f, z); done; (kill ("wedge"), nary ("wedge"), declare ("wedge", [commutative, lassociative]), matchdeclare (var, true), 0); 0; (tellsimpafter (0 wedge var, 0), 0); 0; ev (a wedge (b wedge (c wedge (0 wedge d))) wedge (e wedge f), infeval); 0; (kill ("wedge"), nary ("wedge"), declare ("wedge", [commutative, rassociative]), matchdeclare (var, true), 0); 0; (tellsimpafter (var wedge z, z), 0); 0; ev (a wedge (b wedge (c wedge (z wedge d))) wedge (e wedge f), infeval); z; /* some tests for partition */ (kill (foo, u, e1, e2, e3), e1 : 'at ('diff (foo (u), u), u = 0), e2 : 'integrate (foo (u), u, 0, 1), e3 : 'sum (foo (u), u, 1, n), [freeof (u, e1), freeof (u, e2), freeof (u, e3)]); [true, true, true]; partition (e1 * sin (u), u); [''e1, sin (u)]; partition (e2 * sin (u), u); [''e2, sin (u)]; partition (e3 * sin (u), u); [''e3, sin (u)]; integrate (e1 * cos (u), u); sin (u) * ''e1; integrate (e1 * cos (u), u, 1, 2); (sin (2) - sin (1)) * ''e1; integrate (e2 * cos (u), u); sin (u) * ''e2; integrate (e2 * cos (u), u, 1, 2); (sin (2) - sin (1)) * ''e2; integrate (e3 * cos (u), u); sin (u) * ''e3; integrate (e3 * cos (u), u, 1, 2); (sin (2) - sin (1)) * ''e3; diff (e1 * sin (u), u); ''e1 * cos (u); diff (e2 * sin (u), u); ''e2 * cos (u); diff (e3 * sin (u), u); ''e3 * cos (u);