REDUCE 3.4.1, 15-Jul-92 ...
1:
(ASSIST)
% Tests of Assist Package version 1.1 .
% Valid only with REDUCE 3.4
% DATE : 15 September 1991.
% Author: H. Caprasse <u214001@bliulg11.bitnet>.
% <u214001@vm1.ulg.ac.be>
%---------------------------------------------------------------------
load assist;
showtime;
Time: 17 ms
% 1. TESTS OF THE SWITCH CONTROL FUNCTIONS :
;
switches;
**** exp:=T ............. allfac:= T ****
**** ezgcd:=NIL ......... gcd:= NIL ****
**** mcd:=T ............. lcm:= T ****
**** div:=NIL ........... rat:= NIL ****
**** intstr:=NIL ........ rational:= NIL ****
**** precise:=NIL ....... reduced:= NIL ****
**** complex:=NIL ....... rationalize:= NIL ****
**** factor:= NIL ....... distribute:= NIL ***
switchorg;
switches;
**** exp:=T ............. allfac:= T ****
**** ezgcd:=NIL ......... gcd:= NIL ****
**** mcd:=T ............. lcm:= T ****
**** div:=NIL ........... rat:= NIL ****
**** intstr:=NIL ........ rational:= NIL ****
**** precise:=NIL ....... reduced:= NIL ****
**** complex:=NIL ....... rationalize:= NIL ****
**** factor:= NIL ....... distribute:= NIL ***
;
if !*mcd then "the switch mcd is on";
the switch mcd is on
if !*gcd then "the switch gcd is on";
;
% A new switch :
!*distribute;
%
% 2. THE "LIST" MANIPULATION FACILITIES" :
;
% generation of a new list
;
t1:=mklist(4);
T1 := {0,0,0,0}
for i:=1:4 do t1:= (t1.i:=mkid(a,i));
;
% notice that part(t1,i) has become t1.i. as also shown here :
;
t1.1;
A1
t1:=(t1.1).t1;
T1 := {A1,A1,A2,A3,A4}
% MKLIST does NEVER destroy anything
;
mklist(t1,3);
{A1,A1,A2,A3,A4}
mklist(t1,10);
{A1,A1,A2,A3,A4,0,0,0,0,0}
% 3. THE DEFINITION OF A BAG
;
% The atom "BAG" is an available (and reserved) name for a BAG envelope
% it is an OPERATOR. In what follows we mostly use it but we insist that
% ANY identifier (there are a few exceptions) may be used.
;
aa:=bag(x,1,"A");
AA := BAG(X,1,A)
% It is easy to construct NEW bag-like objects
;
putbag bg1,bg2;
T
% now one can verify that
;
aa:=bg1(x,y**2);
2
AA := BG1(X,Y )
% is a bag by BAGP
;
if bagp aa then "this is a bag";
this is a bag
;
% One can erase the bag property of bg2 by the command
;
clearbag bg2;
;
% baglistp works in the same way for either a LIST OR a BAG
;
if baglistp aa then "this is a bag or list";
this is a bag or list
if baglistp list(x) then "this is a bag or list";
this is a bag or list
;
% Use of the DISPLAYFLAG command that we shall illustrate below is
% another way.
% "LIST" MAY NOT be a bag.
on errcont;
% The command below gives an error message:
;
putbag list;
***** LIST invalid as BAG
% LISTS may be transformed to BAGS and vice versa
off errcont;
;
kernlist(aa);
2
{X,Y }
listbag(list x,bg1);
BG1(X)
%
%
% 4. BASIC MANIPULATION FUNCTIONS WORKING FOR BOTH STRUCTURES :
;
% define:
;
ab:=bag(x1,x2,x3);
AB := BAG(X1,X2,X3)
al:=list(y1,y2,y3);
AL := {Y1,Y2,Y3}
% We illustrate how the elementary functions do work DIFFERENTLY
;
first ab;
BAG(X1)
third ab;
BAG(X3)
first al;
Y1
last ab;
BAG(X3)
last al;
Y3
% The subsequent one do act in the SAME way;
rest ab;
BAG(X2,X3)
rest al;
{Y2,Y3}
belast ab;
BAG(X1,X2)
belast al;
{Y1,Y2}
;
% depth determines if the depth of the list is uniform.
% when it is, it gives its deepness as an integer.
;
depth al;
1
depth bg1(ab);
2
% It is very convenient to define the PICKUP function PART(x,n) by . :
;
ab.1;
X1
al.3;
Y3
on errcont;
ab.4;
***** Expression BAG(X1,X2,X3) does not have part 4
off errcont;
% For bags, it is possible to avoid an error message when one
% has an index out of range using "first", "second" and "third".
% For instance:
;
second second ab;
BAG()
% This is coherent because the envelope of a bag always remains.
;
size ab;
3
length al;
3
remove(ab,3);
BAG(X1,X2)
delete(y2,al);
{Y1,Y3}
reverse al;
{Y3,Y2,Y1}
member(x3,ab);
BAG(X3)
% notice the output.
;
al:=list(x**2,x**2,y1,y2,y3);
2
AL := {X ,
2
X ,
Y1,
Y2,
Y3}
;
elmult(x**2,al);
2
position(y3,al);
5
;
repfirst(xx,al);
2
{XX,X ,Y1,Y2,Y3}
represt(xx,ab);
BAG(X1,XX)
insert(x,al,3);
2 2
{X ,X ,X,Y1,Y2,Y3}
insert( b,ab,2);
BAG(X1,B,XX)
insert(ab,ab,1);
BAG(BAG(X1,XX),X1,XX)
substitute (new,y1,al);
2 2
{X ,X ,NEW,Y2,Y3}
;
% Function that acts on TWO lists or bags :
;
append(ab,al);
2 2
BAG(X1,XX,X ,X ,Y1,Y2,Y3)
append(al,ab);
2 2
{X ,X ,Y1,Y2,Y3,X1,XX}
;
% Association list or bag may be constructed and thoroughly used
;
l:=list(a1,a2,a3,a4);
L := {A1,A2,A3,A4}
b:=bg1(x1,x2,x3);
B := BG1(X1,X2,X3)
% PAIR is the CONSTRUCTOR of the ASSOCIATION LIST or BAG.
al:=pair(list(1,2,3,4),l);
AL := {{1,A1},{2,A2},{3,A3},{4,A4}}
ab:=pair(bg1(1,2,3),b);
AB := BG1(BG1(1,X1),BG1(2,X2),BG1(3,X3))
;
% A BOOLEAN function abaglistp to test if it is an association
;
if abaglistp bag(bag(1,2)) then "it is an associated bag";
it is an associated bag
;
% Values associated to the keys can be extracted
% first occurence ONLY.
;
asfirst(1,al);
{1,A1}
asfirst(3,ab);
BG1(3,X3)
;
assecond(a1,al);
{1,A1}
assecond(x3,ab);
BG1(3,X3)
;
aslast(z,list(list(x1,x2,x3),list(y1,y2,z)));
{Y1,Y2,Z}
asrest(list(x2,x3),list(list(x1,x2,x3),list(y1,y2,z)));
{X1,X2,X3}
;
% All occurences.
asflist(x,bg1(bg1(x,a1,a2),bg1(x,b1,b2)));
BG1(BG1(X,A1,A2),BG1(X,B1,B2))
asslist(a1,list(list(x,a1,a2),list(x,a1,b2),list(x,y,z)));
{}
restaslist(bag(a1,x),bg1(bag(x,a1,a2),bag(a1,x,b2),bag(x,y,z)));
BG1(BG1(X,B2),BG1(A1,A2))
restaslist(list(a1,x),bag(bag(x,a1,a2),bag(a1,x,b2),bag(x,y,z)));
BAG(BAG(X,B2),BAG(A1,A2))
%********
% Mapping functions can be used with bags through
;
on errcont;
;
for each j in list(list(a),list(c)) join j;
{A,C}
for each j in list(bg1(a),bg1(b)) collect first j;
{BG1(A),BG1(BG1(X1,X2,X3))}
off errcont;
;
% The FOR EACH .. IN .. statement requires a LIST-LIKE object.;
;
% There are functions available for manipulating bags or lists
% as sets. (they exist in the symbolic mode).
;
ts:=mkset list(a1,a1,a,2,2);
TS := {A1,A,2}
;
% Again a boolean function to test the SET property
;
if setp ts then "this is a SET";
this is a SET
;
union(ts,ts);
{A1,A,2}
diffset(ts,list(a1,a));
{2}
diffset(list(a1,a),ts);
{}
symdiff(ts,ts);
{}
intersect(listbag(ts,set1),listbag(ts,set2));
SET1(A1,A,2)
% 5. MISCELLANEOUS GENERAL PURPOSE FUNCTIONS :
;
clear a1,a2,a3,a,x,y,z,x1,x2,op;
%
% DETECTION OF A GIVEN VARIABLE IN A GIVEN SET
;
detidnum aa;
detidnum a10;
10
detidnum a1b2z34;
34
% A list of a finite number of randomly chosen integers can be
% generated:
%
randomlist(3,10);
{0,0,1,2,2,2,0,0,0,0}
%
combnum(8,3);
56
permutations(bag(a1,a2,a3));
BAG(BAG(A1,A2,A3),BAG(A1,A3,A2),BAG(A2,A1,A3),BAG(A2,A3,A1),
BAG(A3,A1,A2),BAG(A3,A2,A1))
combinations({a1,a2,a3},2);
{{A2,A3},{A1,A3},{A1,A2}}
;
% The "depend" command can be traced and made EXPLICIT :
;
depatom a;
A
depend a,x,y;
depatom a;
{X,Y}
% The second use of DEPEND
;
depend op,x,y,z;
implicit op;
OP
explicit op;
OP(X,Y,Z)
depend y,zz;
explicit op;
OP(X,Y(ZZ),Z)
aa:=implicit op;
AA := OP
% The ENTIRE dependence of OP becomes "IMPLICIT"
;
df(aa,y);
DF(OP,Y)
% These two last functions work properly ONLY when the command "DEPEND"
%involves ATOMIC quantities.
;
% Detection of variables a given function depends on is possible
;
funcvar(x+y);
{X,Y}
funcvar(sin log(x+y));
{X,Y}
;
% Variables on which an expression depends :
%
funcvar(sin pi);
funcvar(x+e+i);
{X}
%
% CONSTANT and RESERVED identifiers are recognize and not taken
% as variables.
%
% Now we illustrate functions that give, display or erase
% a "FLAG" or a "PROPERTY" :
;
% It is possible to give "flags" in the algebraic mode;
%
putflag(list(a1,a2),fl1,t);
T
putflag(list(a1,a2),fl2,t);
T
displayflag a1;
{FL1,FL2}
% to clear ALL flags created for a1 :
;
clearflag a1,a2;
displayflag a2;
{}
putprop(x1,propname,value,t);
X1
displayprop(x1,prop);
{}
displayprop(x1,propname);
{{PROPNAME,VALUE}}
% To clear ONE property
;
putprop(x1,propname,value,0);
displayprop(x1,propname);
{}
%
%
% 6. FUNCTIONS TO CONTROL THE ENVIRONMENT :
;
% Algebraic ATOMS detection
;
alatomp z;
T
z:=s1;
Z := S1
alatomp z;
T
% Algebraic KERNEL detection
;
alkernp z;
T
alkernp log sin r;
T
% PRECEDENCE detection
;
precp(difference,plus);
T
precp(plus,difference);
precp(times,.);
precp(.,times);
T
% STRING detection
;
if stringp x then "this is a string";
if stringp "this is a string" then "this is a string";
this is a string
;
;
% A function which detects the dependence of u with respect
%to the ATOM or KERNEL v at ANY LEVEL
;
depvarp(log(sin(x+cos(1/acos rr))),rr);
T
;
operator op;
*** OP already defined as operator
symmetric op;
op(x,y)-op(y,x);
0
remsym op;
op(x,y)-op(y,x);
OP(X,Y) - OP(Y,X)
;
clear y,x,u,v;
korder y,x,u,v;
korderlist;
(Y X U V)
;
for all x,y such that nordp(x,y) let op(x,y)=x+y;
op(a,b);
BG1(X1,X2,X3) + A
op(b,a);
OP(BG1(X1,X2,X3),A)
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 .
%clear a1,a2,aa,ar,br,mm,m1,m2,f,tv;
%a1:=a2:=1;
%show scalars;
%x**2;
%saveas res;
%show scalars;
%aa:=list(a);
%show lists;
%array ar(2),br(3,3);
%show arrays;
%load matr$
%matrix mm; matrix m1(2,2); m2:=mat((1,1));
%show matrices;
%vector v1,v2;
%show vectors;
%load excalc; pform f=1; tvector tv;
%show vectors;
%show forms;
%show all;
%suppress vectors;
%show vectors;
%suppress all
%show all;
clear op;
operator op;
op(x,y,z);
OP(X,Y,S1)
clearop op;
T
clearfunctions abs,tan;
*** ABS is unprotected : Cleared ***
*** TAN is unprotected : Cleared ***
"Clearing is complete"
;
% THIS FUNCTION MUST BE USED WITH CARE !!"!!!
;
% 7. NEW POLYNOMIAL MANIPUKLATION FACILITIES
%
%
clear x,y,z;
% To see the internal representation :
%
off pri;
;
pol:=(x+2*y+3*z**2)**3;
3 2 2 2 2 4 3
POL := 8*Y + (12*X + 36*Z )*Y + (6*X + 36*Z *X + 54*Z )*Y + X + 9
2 2 4 6
*Z *X + 27*Z *X + 27*Z
;
% Notice the recursive form.
;
pold:=distribute pol;
3 2 2 2 4 2 2 3
POLD := 8*Y + 36*Z *Y + 12*X*Y + 54*Z *Y + 36*Z *X*Y + 6*X *Y + X
2 2 4 6
+ 9*Z *X + 27*Z *X + 27*Z
;
% Now it is in a distributive form.
;
% Terms and reductums may be extracted individually :
on distribute;
polp:=pol$
leadterm (pold);
3
8*Y
pold:=redexpr pold;
2 2 2 4 2 2 3 2
POLD := 36*Z *Y + 12*X*Y + 54*Z *Y + 36*Z *X*Y + 6*X *Y + X + 9*Z
2 4 6
*X + 27*Z *X + 27*Z
leadterm pold;
2 2
36*Z *Y
;
off distribute;
polp:=pol$
leadterm polp;
3
8*Y
polp:=redexpr polp;
2 2 2 2 4 3 2 2
POLP := (12*X + 36*Z )*Y + (6*X + 36*Z *X + 54*Z )*Y + X + 9*Z *X
4 6
+ 27*Z *X + 27*Z
leadterm polp;
2 2
(12*X + 36*Z )*Y
;
% "leadterm" and "redexpr" extract the leading term and reductum of a
% polynomial respectively WITHOUT specifying the variable.
% The default ordering is then assumed.
% They work both for the distributive and recursive representations.
%
% The function "monom" puts in a list all monoms of a multivariate
% polynomial.
monom polp;
6
{27*Z ,
4
27*Z *X,
2 2
9*Z *X ,
3
X ,
2
6*X *Y,
2
36*Z *X*Y,
4
54*Z *Y,
2
12*X*Y ,
2 2
36*Z *Y }
% "lowestdeg" extracts the smallest power of a given indeterminate
% in a polynomial:
lowestdeg(pol,z);
0
;
on pri;
;
divpol(pol,x+2*y+3*z**2);
2 2 2 2 4
{X + 4*X*Y + 6*X*Z + 4*Y + 12*Y*Z + 9*Z ,
0}
% This function gives the quotient AND the remainder directly inside a
% list.
;
% 8. MANIPUKLATIONS OF SOME ELEMENTARY TRANSCENDENTAL FUNCTIONS
trig:=((sin x)**2+(cos x)**2)**4;
8 6 2 4 4
TRIG := SIN(X) + 4*SIN(X) *COS(X) + 6*SIN(X) *COS(X)
2 6 8
+ 4*SIN(X) *COS(X) + COS(X)
trigreduce trig;
1
trig:=sin (5x);
TRIG := SIN(5*X)
trigexpand trig;
4 2 2 4
SIN(X)*(SIN(X) - 10*SIN(X) *COS(X) + 5*COS(X) )
trigreduce ws;
SIN(5*X)
trigexpand sin(x+y+z);
- SIN(X)*SIN(Y)*SIN(Z) + SIN(X)*COS(Y)*COS(Z) + SIN(Y)*COS(X)*COS(Z)
+ SIN(Z)*COS(X)*COS(Y)
;
% The same functions exist for hyperbolic functions:
;
hypreduce (sinh x **2 -cosh x **2);
-1
;
% For expressions containing log's. Expansion in terms of sums,
% differences, .. is given by "logplus" while concatenation is given
% by the function "concsumlog".
;
clear a,b;
pluslog log(a*log(x**b));
LOG(LOG(X)) + LOG(A) + LOG(B)
concsumlog((2*log x + a*b*log(x*y)+1)/(3*x**2*log(y)));
A*B A*B 2
LOG(Y *X *X ) + 1
-----------------------
2
3*X
LOG(Y )
% Though these functions do use substitution rules, these are
% active only during the time they actually do their work.
% 9. VECTOR CALCULUS OPERATIONS
;
clear u1,u2,v1,v2,v3,v4,w3,w4;
u1:=list(v1,v2,v3,v4);
U1 := {V1,V2,V3,V4}
u2:=bag(w1,w2,w3,w4);
U2 := BAG(W1,W2,W3,W4)
%
sumvect(u1,u2);
{V1 + W1,
V2 + W2,
V3 + W3,
V4 + W4}
minvect(u2,u1);
BAG( - V1 + W1, - V2 + W2, - V3 + W3, - V4 + W4)
scalvect(u1,u2);
V1*W1 + V2*W2 + V3*W3 + V4*W4
crossvect(rest u1,rest u2);
{V3*W4 - V4*W3,
- V2*W4 + V4*W2,
V2*W3 - V3*W2}
mpvect(rest u1,rest u2, minvect(rest u1,rest u2));
0
scalvect(crossvect(rest u1,rest u2),minvect(rest u1,rest u2));
0
;
% 10. NEW OPERATIONS ON MATRICES
;
clear m,mm,b,b1,bb,cc,a,b,c,d;
matrix mm(2,2);
baglmat(bag(bag(a1,a2)),m);
T
m;
[A1 A2]
on errcont;
;
baglmat(bag(bag(a1),bag(a2)),m);
***** (MAT ((*SQ ((((A1 . 1) . 1)) . 1) T) (*SQ ((((A2 . 1) . 1)) . 1) T)))
should be an identifier
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);
T
m;
[A1]
[ ]
[A2]
on errcont;
baglmat(bag(bag(a1),bag(a2)),bag);
***** OPERATOR BAG invalid as matrix
off errcont;
% Right since a bag-like object cannot become a matrix.
coercemat(m,op);
OP(OP(A1),OP(A2))
coercemat(m,list);
{{A1},{A2}}
;
on nero;
unitmat b1(2);
matrix b(2,2);
b:=mat((r1,r2),(s1,s2));
[R1 R2]
B := [ ]
[S1 S2]
b1;
[1 0]
[ ]
[0 1]
b;
[R1 R2]
[ ]
[S1 S2]
mkidm(b,1);
[1 0]
[ ]
[0 1]
% Allows to relate matrices already defined.
;
% Convenient to replace or get a matrix element inside a procedure :
%
seteltmat(b,newelt,2,2);
[R1 R2 ]
[ ]
[S1 NEWELT]
geteltmat(b,2,1);
S1
%
b:=matsubr(b,bag(1,2),2);
[R1 R2]
B := [ ]
[1 2 ]
% It gives automatically a new matrix with the second row substituted.
;
submat(b,1,2);
[1]
% What is left when row 1 and column 2 are taken off the matrix.
bb:=mat((1+i,-i),(-1+i,-i));
[I + 1 - I]
BB := [ ]
[I - 1 - I]
cc:=matsubc(bb,bag(1,2),2);
[I + 1 1]
CC := [ ]
[I - 1 2]
% Second column substituted.
cc:=tp matsubc(bb,bag(1,2),2);
[I + 1 I - 1]
CC := [ ]
[ 1 2 ]
matextr(bb, bag,1);
BAG(I + 1, - I)
% First row extracted and placed in a bag.
matextc(bb,list,2);
{ - I, - I}
% Second column extracted and placed in a bag.
;
hconcmat(bb,cc);
[I + 1 - I I + 1 I - 1]
[ ]
[I - 1 - I 1 2 ]
vconcmat(bb,cc);
[I + 1 - I ]
[ ]
[I - 1 - I ]
[ ]
[I + 1 I - 1]
[ ]
[ 1 2 ]
% Horizontal an vertical concatenations.
;
tpmat(bb,bb);
[ 2*I - I + 1 - I + 1 -1]
[ ]
[ -2 - I + 1 I + 1 -1]
[ ]
[ -2 I + 1 - I + 1 -1]
[ ]
[ - 2*I I + 1 I + 1 -1]
% Tensor product.
%
% It is an INFIX operation :
bb tpmat bb;
[ 2*I - I + 1 - I + 1 -1]
[ ]
[ -2 - I + 1 I + 1 -1]
[ ]
[ -2 I + 1 - I + 1 -1]
[ ]
[ - 2*I I + 1 I + 1 -1]
;
clear hbb;
hermat(bb,hbb);
[ - I + 1 - (I + 1)]
[ ]
[ I I ]
% id hbb changed to a matrix id and assigned to the hermitian matrix
% of bb.
;
showtime;
Time: 2210 ms
end;
Time: 17 ms
Quitting