reduce-historical/r35/lib/assist.tst

% Tests of Assist Package version 2.0 for  REDUCE 3.4 and 3.4.1.
% DATE : 30 May 1993
% Author: H. Caprasse <caprasse@vm1.ulg.ac.be>

showtime;

Comment 1. CONTROL OF SWITCHES;
;
switches;
off exp; on gcd;
switches;
switchorg;
switches;
;
if !*mcd then "the switch mcd is on";
if !*gcd then "the switch gcd is on";
;
comment 2. MANIPULATION OF THE LIST STRUCTURE:;
;
t1:=mklist(4);

Comment   MKLIST does NEVER destroy anything ;

mklist(t1,3);
mklist(t1,10);
;
sequences 3;
lisp;
sequences 3;
algebraic;

frequency append(t1,t1);
elmult(a1,t1);
insert(a1,t1,2);
li:=list(1,2,5);
insert_keep_order(4,li,lessp);
merge_list(li,li,lessp);
for i:=1:4 do t1:= (t1.i:=mkid(a,i));
% for i:=1:2 do t1:=(t1.i:=mkid(a,i));
t1.1;
t1:=(t1.1) . t1;
position(a2,t1);
pair(t1,t1);
depth list t1;
depth a1;
appendn(li,li,li);
;
comment 3. THE BAG STRUCTURE AND ITS ASSOCIATED FUNCTIONS
 ;
aa:=bag(x,1,"A");
putbag bg1,bg2;
on errcont;
putbag list;
off errcont;
aa:=bg1(x,y**2);
;
if bagp aa then "this is a bag";
;
clearbag bg2;
;
depth bg2(x);
;
if baglistp aa then "this is a bag or list";
if baglistp list(x) then "this is a bag or list";
;
ab:=bag(x1,x2,x3);
al:=list(y1,y2,y3);
first ab;  third ab;  first al;
last ab; last al;
belast ab; belast al;
rest ab; rest al;
depth al; depth bg1(ab);
;
ab.1; al.3;
on errcont;
ab.4;
off errcont;
kernlist(aa);
listbag(list x,bg1);
size ab; length al;
remove(ab,3);
delete(y2,al);
reverse al;
member(x3,ab);
al:=list(x**2,x**2,y1,y2,y3);
;
elmult(x**2,al);
position(y3,al);
;
repfirst(xx,al);
represt(xx,ab);
insert(x,al,3);
insert( b,ab,2);
insert(ab,ab,1);
substitute (new,y1,al);
;
appendn(ab,ab,ab);
append(ab,al);
append(al,ab);
;
comment Association list or bag may be constructed and thoroughly used;
;
l:=list(a1,a2,a3,a4);
b:=bg1(x1,x2,x3);
al:=pair(list(1,2,3,4),l);
ab:=pair(bg1(1,2,3),b);
;
comment : A BOOLEAN function abaglistp to test if it is an association;
;
if abaglistp bag(bag(1,2)) then "it is an associated bag";
;
% Values associated to the keys can be extracted
% first occurence ONLY.
;
asfirst(1,al);
asfirst(3,ab);
;
assecond(a1,al);
assecond(x3,ab);
;
aslast(z,list(list(x1,x2,x3),list(y1,y2,z)));
asrest(list(x2,x3),list(list(x1,x2,x3),list(y1,y2,z)));
;
clear a1;
;
% All occurences.
asflist(x,bg1(bg1(x,a1,a2),bg1(x,b1,b2)));
asslist(a1,list(list(x,a1),list(y,a1),list(x,y)));
restaslist(bag(a1,x),bg1(bag(x,a1,a2),bag(a1,x,b2),bag(x,y,z)));
restaslist(list(a1,x),bag(bag(x,a1,a2),bag(a1,x,b2),bag(x,y,z)));
;
comment 4. SETS AND THEIR MANIPULATION FUNCTIONS
;
ts:=mkset list(a1,a1,a,2,2);
if setp ts then "this is a SET";
;
union(ts,ts);
diffset(ts,list(a1,a));
diffset(list(a1,a),ts);
symdiff(ts,ts);
intersect(listbag(ts,set1),listbag(ts,set2));


COMMENT 5. MISCELLANEOUS UTILITY FUNCTIONS :;
;
clear a1,a2,a3,a,x,y,z,x1,x2,op$
;
% DETECTION OF A GIVEN VARIABLE IN A GIVEN SET
;
mkidnew();
mkidnew(a);
dellastdigit 23;
detidnum aa;
detidnum a10;
detidnum a1b2z34;
list_to_ids list(a,1,rr,22);
;
if oddp 3 then "this is an odd integer";
;
<<prin2 1; followline 7; prin2 8;>>;
;
operator foo;
foo(x):=x;
foo(x)==value;
x:=x;
;
clear x;
;
randomlist(10,20);
combnum(8,3);
permutations(bag(a1,a2,a3));
permutations {1,2,3};
cyclicpermlist{1,2,3};
combinations({1,2,3},2);
labc:={a,b,c};
symmetrize(labc,foo,cyclicpermlist);
symmetrize(labc,list,permutations);
symmetrize({labc},foo,cyclicpermlist);
extremum({1,2,3},lessp);
extremum({1,2,3},geq);
extremum({a,b,c},ordp);
;
funcvar(x+y);
funcvar(sin log(x+y));
funcvar(sin pi);
funcvar(x+e+i);
;
depatom a;
depend a,x,y;
depatom a;
depend op,x,y,z;
implicit op;
explicit op;
depend y,zz;
explicit op;
aa:=implicit op;
clear op;
;
korder x,z,y;
korderlist;
;
if checkproplist({1,2,3},fixp) then "it is a list of integers";
;
if checkproplist({a,b1,c},idp) then "it is a list of identifiers";
;
if checkproplist({1,b1,c},idp) then "it is a list of identifiers";
;
lmix:={1,1/2,a,"st"};
;
extractlist(lmix,fixp);
extractlist(lmix,numberp);
extractlist(lmix,idp);
extractlist(lmix,stringp);
;
comment 6. PROPERTIES AND FLAGS:;
;
putflag(list(a1,a2),fl1,t);
putflag(list(a1,a2),fl2,t);
displayflag a1;
;
clearflag a1,a2;
displayflag a2;
putprop(x1,propname,value,t);
displayprop(x1,prop);
displayprop(x1,propname);
;
putprop(x1,propname,value,0);
displayprop(x1,propname);
;
comment CONTROL FUNCTIONS:;
;
alatomp z;
z:=s1;
alatomp z;
;
alkernp z;
alkernp log sin r;
;
precp(difference,plus);
precp(plus,difference);
precp(times,.);
precp(.,times);
;
if stringp x then "this is a string";
if stringp "this is a string" then "this is a string";
;
if nordp(b,a) then "a is ordered before b";
operator op;
for all x,y such that nordp(x,y) let op(x,y)=x+y;
op(a,a);
op(b,a);
op(a,b);
clear op;
;
depvarp(log(sin(x+cos(1/acos rr))),rr);
;
operator op;
symmetric op;
op(x,y)-op(y,x);
remsym op;
op(x,y)-op(y,x);
;
clear y,x,u,v;
clear op;
;
% DISPLAY and CLEARING of user's objects of various types entered
% to the console. Only TOP LEVEL assignments are considered up to now.
% The following statements must be made INTERACTIVELY. We put them
% as COMMENTS for the user to experiment with them. We do this because
% in a fresh environment all outputs are nil.
;
% THIS PART OF THE TEST SHOULD BE REALIZED INTERACTIVELY.
% SEE THE ** ASSIST LOG **  FILE .
%v1:=v2:=1;
%show variables;   % For REDUCE 3.3 ONLY.
%show scalars;
%aa:=list(a);
%show lists;
%array ar(2);
%show arrays;
%load matr$
%matrix mm;
%show matrices;
%x**2;
%saveas res;
%show saveids;
%suppress variables; % For REDUCE 3.3 ONLY
%show variables;     % For REDUCE 3.3 ONLY
%suppress scalars;
%show scalars;
%show lists;
%suppress all;
%show arrays;
%show matrices;
;
comment end of the interactive part;
;
clear op;
operator op;
op(x,y,z);
clearop op;
clearfunctions abs,tan;
;
comment  THIS FUNCTION MUST BE USED WITH CARE !!"!!!;
;
comment 6. HANDLING OF POLYNOMIALS

clear x,y,z;
COMMENT  To see the internal representation :;
;
off pri;
;
pol:=(x-2*y+3*z**2-1)**3;
;
pold:=distribute pol;
;
on distribute;
leadterm (pold);
pold:=redexpr pold;
leadterm pold;
;
off distribute;
polp:=pol$
leadterm polp;
polp:=redexpr polp;
leadterm polp;
;
monom polp;
;
on pri;
;
splitterms polp;
;
splitplusminus polp;
;
divpol(pol,x+2*y+3*z**2);
;
lowestdeg(pol,y);
;
comment 7.  HANDLING OF SOME TRANSCENDENTAL FUNCTIONS:;
;
trig:=((sin x)**2+(cos x)**2)**4;
trigreduce trig;
trig:=sin (5x);
trigexpand trig;
trigreduce ws;
trigexpand sin(x+y+z);
;
;
hypreduce (sinh x **2 -cosh x **2);
;
;
clear a,b;
pluslog log(a*log(x**b));
concsumlog((2*log x + a*b*log(x*y)+1)/(3*x**2*log(y)));
;
comment 8. HANDLING OF N6DIMENSIONAL VECTORS:;
;
clear u1,u2,v1,v2,v3,v4,w3,w4;
u1:=list(v1,v2,v3,v4);
u2:=bag(w1,w2,w3,w4);
%
sumvect(u1,u2);
minvect(u2,u1);
scalvect(u1,u2);
crossvect(rest u1,rest u2);
mpvect(rest u1,rest u2, minvect(rest u1,rest u2));
scalvect(crossvect(rest u1,rest u2),minvect(rest u1,rest u2));
;
comment 9. HANDLING OF GRASSMANN OPERATORS:;
;
putgrass eta,eta1;
grasskernel:=
{eta(~x)*eta(~y) => -eta y * eta x when nordp(x,y),
(~x)*(~x) => 0 when grassp x};
;
eta(y)*eta(x);
eta(y)*eta(x) where grasskernel;
let grasskernel;
eta(x)^2;
eta(y)*eta(x);
operator zz;
grassparity (eta(x)*zz(y));
grassparity (eta(x)*eta(y));
grassparity(eta(x)+zz(y));
clearrules grasskernel;
grasskernel:=
{eta(~x)*eta(~y) => -eta y * eta x when nordp(x,y),
eta1(~x)*eta(~y) => -eta x * eta1 y,
eta1(~x)*eta1(~y) => -eta1 y * eta1 x when nordp(x,y),
(~x)*(~x) => 0 when grassp x};
;
let grasskernel;
eta1(x)*eta(x)*eta1(z)*eta1(w);
clearrules grasskernel;
remgrass eta,eta1;
clearop zz;
;
COMMENT 10. HANDLING OF MATRICES:;
;
clear m,mm,b,b1,bb,cc,a,b,c,d;
matrix mm(2,2);
baglmat(bag(bag(a1,a2)),m);
m;
on errcont;
;
baglmat(bag(bag(a1),bag(a2)),m);
off errcont;
%    **** i.e. it cannot redefine the matrix! in order
%         to avoid accidental redefinition of an already given matrix;

clear m; baglmat(bag(bag(a1),bag(a2)),m);
m;
on errcont;
baglmat(bag(bag(a1),bag(a2)),bag);
off errcont;
comment  Right since a bag-like object cannot become a matrix.;
;
coercemat(m,op);
coercemat(m,list);
;
on nero;
unitmat b1(2);
matrix b(2,2);
b:=mat((r1,r2),(s1,s2));
b1;b;
mkidm(b,1);
;
seteltmat(b,newelt,2,2);
geteltmat(b,2,1);
%
b:=matsubr(b,bag(1,2),2);
;
submat(b,1,2);
;
bb:=mat((1+i,-i),(-1+i,-i));
cc:=matsubc(bb,bag(1,2),2);
;
cc:=tp matsubc(bb,bag(1,2),2);
matextr(bb, bag,1);
;
matextc(bb,list,2);
;
hconcmat(bb,cc);
vconcmat(bb,cc);
;
tpmat(bb,bb);
bb tpmat bb;
;
clear hbb;
hermat(bb,hbb);
% id hbb changed to a matrix id and assigned to the hermitian matrix
% of bb.
;
showtime;
end;