NOTE: THIS IS NOT YET CORRECT, BUT REPRESENTS THE STATE OF THE TEST RUN
AS OF THE DATE OF THIS FILE.

Fri Mar  6 11:46:58 PST 1998
REDUCE Development Version, 28-Feb-98 ...

1: 1: 
2: 2: 
3: 3: 3: 3: 3: 3: 3: 3: 3: 
nil

4: 4: Comment This is a standard test file for REDUCE that has been used for
many years.  It only tests a limited number of facilities in the
current system.  In particular, it does not test floating point
arithmetic, or any of the more advanced packages that have been made
available since REDUCE 3.0 was released.  It has been used for a long
time to benchmark the performance of REDUCE.  A description of this
benchmarking with statistics for REDUCE 3.2 was reported in Jed B.
Marti and Anthony C. Hearn, "REDUCE as a Lisp Benchmark", SIGSAM Bull.
19 (1985) 8-16.  That paper also gives information on the the parts of
the system exercised by the test file.  Updated statistics may be found
in the "timings" file in the REDUCE Network Library;


showtime;


Time: 0 ms


on reduce4;



of type: noval
  % For the time being.

comment some examples of the FOR statement;


comment summing the squares of the even positive integers
	through 50;


for i:=2 step 2 until 50 sum i**2;


22100

of type: bint


comment to set  w  to the factorial of 10;


w := for i:=1:10 product i;


3628800

of type: bint


comment alternatively, we could set the elements a(i) of the
	array  a  to the factorial of i by the statements;


array a(10);



of type: noval


a(0):=1$


of type: nzint


for i:=1:10 do a(i):=i*a(i-1);


nil

of type: variable


comment the above version of the FOR statement does not return
	an algebraic value, but we can now use these array
	elements as factorials in expressions, e. g.;


1+a(5);


121

of type: nzint


comment we could have printed the values of each a(i)
	as they were computed by writing the FOR statement as;


for i:=1:10 do write "a(",i,") := ",a(i):= i*a(i-1);

a(1) := 1

a(2) := 2

a(3) := 6

a(4) := 24

a(5) := 120

a(6) := 720

a(7) := 5040

a(8) := 40320

a(9) := 362880

a(10) := 3628800


nil

of type: variable


comment another way to use factorials would be to introduce an
operator FAC by an integer procedure as follows;


procedure fac(n:int)
   begin local m:int;
	m:=1;
    l1:	if n=0 then return m;
	m:=m*n;
	n:=n-1;
	go to l1
   end;


fac

of type: variable


comment we can now use  fac  as an operator in expressions, e. g.;


z**2+fac(4)-2*fac 2*y;


          2
 - 4*y + z  + 24

of type: xpoly


comment note in the above example that the parentheses around
the arguments of FAC may be omitted since it is a unary operator;


comment the following examples illustrate the solution of some
	complete problems;


comment the f and g series (ref  Sconzo, P., Leschack, A. R. and
	 Tobey, R. G., Astronomical Journal, Vol 70 (May 1965);


deps:= -sigma*(mu+2*epsilon)$


of type: xpoly

dmu:= -3*mu*sigma$


of type: xpoly

dsig:= epsilon-2*sigma**2$


of type: xpoly

f1:= 1$


of type: nzint

g1:= 0$


of type: zero

 
for i:= 1:8 do 
 <<f2:= -mu*g1 + deps*df(f1,epsilon) + dmu*df(f1,mu) + dsig*df(f1,sigma);
   write "f(",i,") := ",f2;
   g2:= f1 + deps*df(g1,epsilon) + dmu*df(g1,mu) + dsig*df(g1,sigma);
   write "g(",i,") := ",g2;
   f1:=f2;
   g1:=g2>>;

f(1) := 0

g(1) := 1

f(2) :=  - mu

g(2) := 0

f(3) := 3*mu*sigma

g(3) :=  - mu

                                     2
f(4) := mu*(3*epsilon + mu - 15*sigma )

g(4) := 6*mu*sigma

                                                2
f(5) := 15*mu*sigma*( - 3*epsilon - mu + 7*sigma )

                                     2
g(5) := mu*(9*epsilon + mu - 45*sigma )

                         2                                    2     2
f(6) := mu*( - 45*epsilon  - 24*epsilon*mu + 630*epsilon*sigma  - mu

                           2            4
             + 210*mu*sigma  - 945*sigma )

                                                 2
g(6) := 30*mu*sigma*( - 6*epsilon - mu + 14*sigma )

                               2                                    2     2
f(7) := 63*mu*sigma*(25*epsilon  + 14*epsilon*mu - 150*epsilon*sigma  + mu

                         2            4
            - 50*mu*sigma  + 165*sigma )

                          2                                     2     2
g(7) := mu*( - 225*epsilon  - 54*epsilon*mu + 3150*epsilon*sigma  - mu

                           2             4
             + 630*mu*sigma  - 4725*sigma )

                        3               2                   2      2
f(8) := mu*(1575*epsilon  + 1107*epsilon *mu - 42525*epsilon *sigma

                             2                         2                       4
             + 117*epsilon*mu  - 24570*epsilon*mu*sigma  + 155925*epsilon*sigma

                 3          2      2                 4               6
             + mu  - 2205*mu *sigma  + 51975*mu*sigma  - 135135*sigma )

                                2                                    2     2
g(8) := 126*mu*sigma*(75*epsilon  + 24*epsilon*mu - 450*epsilon*sigma  + mu

                          2            4
            - 100*mu*sigma  + 495*sigma )


nil

of type: variable


comment a problem in Fourier analysis;


factor cos,sin;



of type: noval


on list;



of type: noval


(a1*cos(omega*t) + a3*cos(3*omega*t) + b1*sin(omega*t) +
	b3*sin(3*omega*t))**3 where
	{cos(~x)*cos(~y) => (cos(x+y)+cos(x-y))/2,
	       cos(~x)*sin(~y) => (sin(x+y)-sin(x-y))/2,
	       sin(~x)*sin(~y) => (cos(x-y)-cos(x+y))/2,
	       cos(~x)**2 => (1+cos(2*x))/2,
	       sin(~x)**2 => (1-cos(2*x))/2};


                   3
(3*cos(omega*t)*(a1

                    2
                 +a1 *a3

                         2
                 +2*a1*a3

                       2
                 +a1*b1

                 +2*a1*b1*b3

                         2
                 +2*a1*b3

                       2
                 -a3*b1 )

                       2
 +cos(9*omega*t)*a3*(a3

         2
    -3*b3 )

                         2
 +3*cos(7*omega*t)*(a1*a3

          2
    -a1*b3

    -2*a3*b1*b3)

                      2
 +3*cos(5*omega*t)*(a1 *a3

          2
    +a1*a3

    -2*a1*b1*b3

          2
    -a1*b3

          2
    -a3*b1

    +2*a3*b1*b3)

                    3
 +cos(3*omega*t)*(a1

         2
    +6*a1 *a3

            2
    -3*a1*b1

         3
    +3*a3

            2
    +6*a3*b1

            2
    +3*a3*b3 )

                    2
 +3*sin(omega*t)*(a1 *b1

       2
    +a1 *b3

    -2*a1*a3*b1

         2
    +2*a3 *b1

       3
    +b1

       2
    -b1 *b3

            2
    +2*b1*b3 )

                         2
 +sin(9*omega*t)*b3*(3*a3

       2
    -b3 )

 +3*sin(7*omega*t)*(2*a1*a3*b3

       2
    +a3 *b1

          2
    -b1*b3 )

                      2
 +3*sin(5*omega*t)*(a1 *b3

    +2*a1*a3*b1

    +2*a1*a3*b3

       2
    -a3 *b1

       2
    -b1 *b3

          2
    +b1*b3 )

                      2
 +sin(3*omega*t)*(3*a1 *b1

         2
    +6*a1 *b3

         2
    +3*a3 *b3

       3
    -b1

         2
    +6*b1 *b3

         3
    +3*b3 ))/4

of type: xratpol


remfac cos,sin;



of type: noval


off list;



of type: noval


comment end of Fourier analysis example;


comment the following program, written in  collaboration  with  David
Barton  and  John  Fitch,  solves a problem in general relativity. it
will compute the Einstein tensor from any given metric;


on nero;



of type: noval


comment here we introduce the covariant and contravariant metrics;


operator p1,q1,x;



of type: noval


array gg(3,3),h(3,3);



of type: noval


gg(0,0):=e**(q1(x(1)))$


of type: kernel

gg(1,1):=-e**(p1(x(1)))$


of type: xpoly

gg(2,2):=-x(1)**2$


of type: xpoly

gg(3,3):=-x(1)**2*sin(x(2))**2$


of type: xpoly


for i:=0:3 do h(i,i):=1/gg(i,i);


nil

of type: variable


comment generate Christoffel symbols and store in arrays cs1 and cs2;


array cs1(3,3,3),cs2(3,3,3);



of type: noval


for i:=0:3 do for j:=i:3 do
   <<for k:=0:3 do
	cs1(j,i,k) := cs1(i,j,k):=(df(gg(i,k),x(j))+df(gg(j,k),x(i)) -
				      df(gg(i,j),x(k)))/2;
	for k:=0:3 do cs2(j,i,k):= cs2(i,j,k) := for p := 0:3 sum
				      h(k,p)*cs1(i,j,p)>>;


nil

of type: variable


comment now compute the Riemann tensor and store in r(i,j,k,l);


array r(3,3,3,3);



of type: noval


for i:=0:3 do for j:=i+1:3 do for k:=i:3 do
   for l:=k+1:if k=i then j else 3 do
      <<r(j,i,l,k) := r(i,j,k,l) := for q := 0:3 sum
		    gg(i,q)*(df(cs2(k,j,q),x(l))-df(cs2(j,l,q),x(k)) +
		  for p:=0:3 sum (cs2(p,l,q)*cs2(k,j,p) -
			 cs2(p,k,q)*cs2(l,j,p)));
	r(i,j,l,k) := -r(i,j,k,l);
	r(j,i,k,l) := -r(i,j,k,l);
	if i neq k or j>l then
	       <<r(k,l,i,j) := r(l,k,j,i) := r(i,j,k,l);
		 r(l,k,i,j) := -r(i,j,k,l);
		 r(k,l,j,i) := -r(i,j,k,l)>>>>;


nil

of type: variable


comment now compute and print the Ricci tensor;


array ricci(3,3);



of type: noval


for i:=0:3 do for j:=0:3 do  
    write ricci(j,i) := ricci(i,j) := for p := 0:3 sum for q := 0:3 sum
					h(p,q)*r(q,i,p,j);

0

0

0

0

0

  - df(p1(x(1)),x(1))
----------------------
         x(1)

0

0

0

0

                                p1(x(1))
  - df(p1(x(1)),x(1))*x(1) - 2*e         + 2
---------------------------------------------
                    p1(x(1))
                 2*e

0

0

0

0

          2                                 p1(x(1))
 sin(x(2)) *( - df(p1(x(1)),x(1))*x(1) - 2*e         + 2)
----------------------------------------------------------
                          p1(x(1))
                       2*e


nil

of type: variable


comment now compute and print the Ricci scalar;


rs := for i:= 0:3 sum for j:= 0:3 sum h(i,j)*ricci(i,j);


                              p1(x(1))
 2*(df(p1(x(1)),x(1))*x(1) + e         - 1)
--------------------------------------------
               p1(x(1))     2
              e        *x(1)

of type: xratpol


comment finally compute and print the Einstein tensor;


array einstein(3,3);



of type: noval


for i:=0:3 do for j:=0:3 do
	 write einstein(i,j):=ricci(i,j)-rs*gg(i,j)/2;

  q1(x(1))                               p1(x(1))
 e        *( - df(p1(x(1)),x(1))*x(1) - e         + 1)
-------------------------------------------------------
                     p1(x(1))     2
                    e        *x(1)

0

0

0

0

  p1(x(1))
 e         - 1
---------------
         2
     x(1)

0

0

0

0

 df(p1(x(1)),x(1))*x(1)
------------------------
         p1(x(1))
      2*e

0

0

0

0

                            2
 df(p1(x(1)),x(1))*sin(x(2)) *x(1)
-----------------------------------
               p1(x(1))
            2*e


nil

of type: variable


comment end of Einstein tensor program;


clear gg,h,cs1,cs2,r,ricci,einstein;



of type: noval


comment an example using the matrix facility;


matrix xx,yy,zz;


***** matrix not defined for type list 


let xx= mat((a11,a12),(a21,a22)),
   yy= mat((y1),(y2));


*** Please use => instead of = in rules 

*** Please use => instead of = in rules 


of type: noval


2*det xx - 3*w;


***** det not defined for type matrix 


zz:= xx**(-1)*yy;


***** expt not defined for types matrix nzint 


1/xx**2;


***** expt not defined for types matrix nzint 


comment end of matrix examples;


comment a physics example;


on div;



of type: noval
 comment this gives us output in same form as Bjorken and Drell;


mass ki= 0, kf= 0, p1= m, pf= m;


***** equal not defined for types variable zero 


vector eei,ef;


***** ~vector not defined for type list 


mshell ki,kf,p1,pf;


***** mshell not defined for type list 


let p1.eei= 0, p1.ef= 0, p1.pf= m**2+ki.kf, p1.ki= m*k,p1.kf=
    m*kp, pf.eei= -kf.eei, pf.ef= ki.ef, pf.ki= m*kp, pf.kf=
    m*k, ki.eei= 0, ki.kf= m*(k-kp), kf.ef= 0, eei.eei= -1, ef.ef=
    -1;


*** Please use => instead of = in rules 

*** cons declared operator 

***** ef ef invalid as list
 

operator gp;



of type: noval


for all p let gp(p)= g(l,p)+m;


*** Please use => instead of = in rules 


of type: noval


comment this is just to save us a lot of writing;


gp(pf)*(g(l,ef,eei,ki)/(2*ki.p1) + g(l,eei,ef,kf)/(2*kf.p1))



***** g not defined for types variable variable variable variable 
  * gp(p1)*(g(l,ki,eei,ef)/(2*ki.p1) + g(l,kf,ef,eei)/(2*kf.p1))$


***** g not defined for types variable variable variable variable 


write "The Compton cross-section is ",ws;

                                   -2
The Compton cross-section is 2*x(1)

    - p1(x(1))                            - p1(x(1))
*(e           *df(p1(x(1)),x(1))*x(1) - e            + 1)



of type: noval


comment end of first physics example;
 

off div;



of type: noval


comment another physics example;


index ix,iy,iz;


***** index not defined for type list 


mass p1=mm,p2=mm,p3= mm,p4= mm,k1=0;


***** equal not defined for types variable variable 


mshell p1,p2,p3,p4,k1;


***** mshell not defined for type list 


vector qi,q2;


***** ~vector not defined for type list 


factor mm,p1.p3;


***** cons not defined for types variable variable 


order mm;


***** order not defined for type list 


operator ga,gb;



of type: noval


for all p let ga(p)=g(la,p)+mm, gb(p)= g(lb,p)+mm;


*** Please use => instead of = in rules 

*** Please use => instead of = in rules 


of type: noval
 

ga(-p2)*g(la,ix)*ga(-p4)*g(la,iy)* (gb(p3)*g(lb,ix)*gb(qi)


ga(-p2)*g(la,ix)*ga(-p4)*g(la,iy)*(gb(p3)*g(lb,ix)*gb(qi) $$$


***** Too few right parentheses 

    *g(lb,iz)*gb(p1)*g(lb,iy)*gb(q2)*g(lb,iz)   +   gb(p3)



***** g not defined for types variable variable 
    *g(lb,iz)*gb(q2)*g(lb,ix)*gb(p1)*g(lb,iz)*gb(qi)*g(lb,iy))$

$*g(lb,iz)*gb(q2)*g(lb,ix)*gb(p1)*g(lb,iz)*gb(qi)*g(lb,iy)$$$)

***** Too many right parentheses 



let qi=p1-k1, q2=p3+k1;


*** Please use => instead of = in rules 

*** Please use => instead of = in rules 


of type: noval


comment it is usually faster to make such substitutions after all the
	trace algebra is done;


write "CXN =",ws;

                                   p1(x(1))
      2*(df(p1(x(1)),x(1))*x(1) + e         - 1)
CXN =--------------------------------------------
                    p1(x(1))     2
                   e        *x(1)



of type: noval


comment end of second physics example;
 

showtime;


Time: 2346 ms  plus GC time: 51 ms


of type: noval


end;


of type: noval

5: 5: 5: 5: 5: 5: 5: 
if(*_yyy_*:=gctime()+-*_yyy_*)>0 $$$


***** ; invalid in if statement 

6: 
;, plus GC time:  prin2<<$$$then

***** Improper delimiter 


*_yyy_**_yyy_*

of type: variable

8: 
 ms ms

of type: string


$>>terpri()>$$$>

***** Improper delimiter 

10: 10: 
Quitting
Fri Mar  6 11:47:01 PST 1998
