maxima-test 5.32.1-1 / usr / share / maxima / 5.32.1 / tests / rtest11.mac

/*************** -*- 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;

/* 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 (xx, yy, zz), sort (listofvars (xx + yy * zz)));
[xx, yy, zz];

(newcontext (aa), 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));

/* 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);