Check-ins Using Download Hex

Artifact bc29b70b656a0c38e13a0c3134aeaa836c873ccf9df2b0bfc770b54730d7df5f:

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
REDUCE Historical
[ REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]