reduce.log 14 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778
  1. Sat Jun 29 13:37:28 PDT 1991
  2. REDUCE 3.4, 15-Jul-91 ...
  3. 1: 1:
  4. 2: 2:
  5. 3: 3: showtime;
  6. Time: 0 ms
  7. comment some examples of the FOR statement;
  8. comment summing the squares of the even positive integers
  9. through 50;
  10. for i:=2 step 2 until 50 sum i**2;
  11. 22100
  12. comment to set w to the factorial of 10;
  13. w := for i:=1:10 product i;
  14. W := 3628800
  15. comment alternatively, we could set the elements a(i) of the
  16. array a to the factorial of i by the statements;
  17. array a(10);
  18. a(0):=1$
  19. for i:=1:10 do a(i):=i*a(i-1);
  20. comment the above version of the FOR statement does not return
  21. an algebraic value, but we can now use these array
  22. elements as factorials in expressions, e. g.;
  23. 1+a(5);
  24. 121
  25. comment we could have printed the values of each a(i)
  26. as they were computed by writing the FOR statement as;
  27. for i:=1:10 do write a(i):= i*a(i-1);
  28. A(1) := 1
  29. A(2) := 2
  30. A(3) := 6
  31. A(4) := 24
  32. A(5) := 120
  33. A(6) := 720
  34. A(7) := 5040
  35. A(8) := 40320
  36. A(9) := 362880
  37. A(10) := 3628800
  38. comment another way to use factorials would be to introduce an
  39. operator FAC by an integer procedure as follows;
  40. integer procedure fac (n);
  41. begin integer m;
  42. m:=1;
  43. l1: if n=0 then return m;
  44. m:=m*n;
  45. n:=n-1;
  46. go to l1
  47. end;
  48. FAC
  49. comment we can now use fac as an operator in expressions, e. g.;
  50. z**2+fac(4)-2*fac 2*y;
  51. 2
  52. - 4*Y + Z + 24
  53. comment note in the above example that the parentheses around
  54. the arguments of FAC may be omitted since it is a unary operator;
  55. comment the following examples illustrate the solution of some
  56. complete problems;
  57. comment the f and g series (ref Sconzo, P., Leschack, A. R. and
  58. Tobey, R. G., Astronomical Journal, Vol 70 (May 1965);
  59. deps:= -sig*(mu+2*eps)$
  60. dmu:= -3*mu*sig$
  61. dsig:= eps-2*sig**2$
  62. f1:= 1$
  63. g1:= 0$
  64. for i:= 1:8 do
  65. <<f2:= -mu*g1 + deps*df(f1,eps) + dmu*df(f1,mu) + dsig*df(f1,sig);
  66. write "F(",i,") := ",f2;
  67. g2:= f1 + deps*df(g1,eps) + dmu*df(g1,mu) + dsig*df(g1,sig);
  68. write "G(",i,") := ",g2;
  69. f1:=f2;
  70. g1:=g2>>;
  71. F(1) := 0
  72. G(1) := 1
  73. F(2) := - MU
  74. G(2) := 0
  75. F(3) := 3*SIG*MU
  76. G(3) := - MU
  77. 2
  78. F(4) := MU*(3*EPS - 15*SIG + MU)
  79. G(4) := 6*SIG*MU
  80. 2
  81. F(5) := 15*SIG*MU*( - 3*EPS + 7*SIG - MU)
  82. 2
  83. G(5) := MU*(9*EPS - 45*SIG + MU)
  84. 2 2 4
  85. F(6) := MU*( - 45*EPS + 630*EPS*SIG - 24*EPS*MU - 945*SIG
  86. 2 2
  87. + 210*SIG *MU - MU )
  88. 2
  89. G(6) := 30*SIG*MU*( - 6*EPS + 14*SIG - MU)
  90. 2 2 4
  91. F(7) := 63*SIG*MU*(25*EPS - 150*EPS*SIG + 14*EPS*MU + 165*SIG
  92. 2 2
  93. - 50*SIG *MU + MU )
  94. 2 2 4
  95. G(7) := MU*( - 225*EPS + 3150*EPS*SIG - 54*EPS*MU - 4725*SIG
  96. 2 2
  97. + 630*SIG *MU - MU )
  98. 3 2 2 2
  99. F(8) := MU*(1575*EPS - 42525*EPS *SIG + 1107*EPS *MU
  100. 4 2 2
  101. + 155925*EPS*SIG - 24570*EPS*SIG *MU + 117*EPS*MU
  102. 6 4 2 2 3
  103. - 135135*SIG + 51975*SIG *MU - 2205*SIG *MU + MU )
  104. 2 2 4
  105. G(8) := 126*SIG*MU*(75*EPS - 450*EPS*SIG + 24*EPS*MU + 495*SIG
  106. 2 2
  107. - 100*SIG *MU + MU )
  108. comment a problem in Fourier analysis;
  109. factor cos,sin;
  110. on list;
  111. (a1*cos(wt) + a3*cos(3*wt) + b1*sin(wt) + b3*sin(3*wt))**3
  112. where {cos(~x)*cos(~y) => (cos(x+y)+cos(x-y))/2,
  113. cos(~x)*sin(~y) => (sin(x+y)-sin(x-y))/2,
  114. sin(~x)*sin(~y) => (cos(x-y)-cos(x+y))/2,
  115. cos(~x)**2 => (1+cos(2*x))/2,
  116. sin(~x)**2 => (1-cos(2*x))/2};
  117. 2
  118. (COS(9*WT)*A3*(A3
  119. 2
  120. -3*B3 )
  121. 2
  122. +3*COS(7*WT)*(A1*A3
  123. 2
  124. -A1*B3
  125. -2*A3*B1*B3)
  126. 2
  127. +3*COS(5*WT)*(A1 *A3
  128. 2
  129. +A1*A3
  130. -2*A1*B1*B3
  131. 2
  132. -A1*B3
  133. 2
  134. -A3*B1
  135. +2*A3*B1*B3)
  136. 3
  137. +COS(3*WT)*(A1
  138. 2
  139. +6*A1 *A3
  140. 2
  141. -3*A1*B1
  142. 3
  143. +3*A3
  144. 2
  145. +6*A3*B1
  146. 2
  147. +3*A3*B3 )
  148. 3
  149. +3*COS(WT)*(A1
  150. 2
  151. +A1 *A3
  152. 2
  153. +2*A1*A3
  154. 2
  155. +A1*B1
  156. +2*A1*B1*B3
  157. 2
  158. +2*A1*B3
  159. 2
  160. -A3*B1 )
  161. 2
  162. +SIN(9*WT)*B3*(3*A3
  163. 2
  164. -B3 )
  165. +3*SIN(7*WT)*(2*A1*A3*B3
  166. 2
  167. +A3 *B1
  168. 2
  169. -B1*B3 )
  170. 2
  171. +3*SIN(5*WT)*(A1 *B3
  172. +2*A1*A3*B1
  173. +2*A1*A3*B3
  174. 2
  175. -A3 *B1
  176. 2
  177. -B1 *B3
  178. 2
  179. +B1*B3 )
  180. 2
  181. +SIN(3*WT)*(3*A1 *B1
  182. 2
  183. +6*A1 *B3
  184. 2
  185. +3*A3 *B3
  186. 3
  187. -B1
  188. 2
  189. +6*B1 *B3
  190. 3
  191. +3*B3 )
  192. 2
  193. +3*SIN(WT)*(A1 *B1
  194. 2
  195. +A1 *B3
  196. -2*A1*A3*B1
  197. 2
  198. +2*A3 *B1
  199. 3
  200. +B1
  201. 2
  202. -B1 *B3
  203. 2
  204. +2*B1*B3 ))/4
  205. remfac cos,sin;
  206. off list;
  207. comment end of Fourier analysis example;
  208. comment the following program, written in collaboration with David
  209. Barton and John Fitch, solves a problem in general relativity. it
  210. will compute the Einstein tensor from any given metric;
  211. on nero;
  212. comment here we introduce the covariant and contravariant metrics;
  213. operator p1,q1,x;
  214. array gg(3,3),h(3,3);
  215. gg(0,0):=e**(q1(x(1)))$
  216. gg(1,1):=-e**(p1(x(1)))$
  217. gg(2,2):=-x(1)**2$
  218. gg(3,3):=-x(1)**2*sin(x(2))**2$
  219. for i:=0:3 do h(i,i):=1/gg(i,i);
  220. comment generate Christoffel symbols and store in arrays cs1 and cs2;
  221. array cs1(3,3,3),cs2(3,3,3);
  222. for i:=0:3 do for j:=i:3 do
  223. <<for k:=0:3 do
  224. cs1(j,i,k) := cs1(i,j,k):=(df(gg(i,k),x(j))+df(gg(j,k),x(i))
  225. -df(gg(i,j),x(k)))/2;
  226. for k:=0:3 do cs2(j,i,k):= cs2(i,j,k) := for p := 0:3
  227. sum h(k,p)*cs1(i,j,p)>>;
  228. comment now compute the Riemann tensor and store in r(i,j,k,l);
  229. array r(3,3,3,3);
  230. for i:=0:3 do for j:=i+1:3 do for k:=i:3 do
  231. for l:=k+1:if k=i then j else 3 do
  232. <<r(j,i,l,k) := r(i,j,k,l) := for q := 0:3
  233. sum gg(i,q)*(df(cs2(k,j,q),x(l))-df(cs2(j,l,q),x(k))
  234. + for p:=0:3 sum (cs2(p,l,q)*cs2(k,j,p)
  235. -cs2(p,k,q)*cs2(l,j,p)));
  236. r(i,j,l,k) := -r(i,j,k,l);
  237. r(j,i,k,l) := -r(i,j,k,l);
  238. if i neq k or j>l
  239. then <<r(k,l,i,j) := r(l,k,j,i) := r(i,j,k,l);
  240. r(l,k,i,j) := -r(i,j,k,l);
  241. r(k,l,j,i) := -r(i,j,k,l)>>>>;
  242. comment now compute and print the Ricci tensor;
  243. array ricci(3,3);
  244. for i:=0:3 do for j:=0:3 do
  245. write ricci(j,i) := ricci(i,j) := for p := 0:3 sum for q := 0:3
  246. sum h(p,q)*r(q,i,p,j);
  247. Q1(X(1))
  248. RICCI(0,0) := RICCI(0,0) := (E *(
  249. X(1)*DF(P1(X(1)),X(1))*DF(Q1(X(1)),X(1))
  250. 2
  251. - 2*X(1)*DF(Q1(X(1)),X(1),2) - X(1)*DF(Q1(X(1)),X(1))
  252. P1(X(1))
  253. - 4*DF(Q1(X(1)),X(1))))/(4*E *X(1))
  254. RICCI(1,1) := RICCI(1,1) := (
  255. - X(1)*DF(P1(X(1)),X(1))*DF(Q1(X(1)),X(1))
  256. 2
  257. + 2*X(1)*DF(Q1(X(1)),X(1),2) + X(1)*DF(Q1(X(1)),X(1))
  258. - 4*DF(P1(X(1)),X(1)))/(4*X(1))
  259. RICCI(2,2) := RICCI(2,2) := ( - X(1)*DF(P1(X(1)),X(1))
  260. P1(X(1)) P1(X(1))
  261. + X(1)*DF(Q1(X(1)),X(1)) - 2*E + 2)/(2*E )
  262. 2
  263. RICCI(3,3) := RICCI(3,3) := (SIN(X(2)) *( - X(1)*DF(P1(X(1)),X(1))
  264. P1(X(1)) P1(X(1))
  265. + X(1)*DF(Q1(X(1)),X(1)) - 2*E + 2))/(2*E )
  266. comment now compute and print the Ricci scalar;
  267. rs := for i:= 0:3 sum for j:= 0:3 sum h(i,j)*ricci(i,j);
  268. 2
  269. RS := (X(1) *DF(P1(X(1)),X(1))*DF(Q1(X(1)),X(1))
  270. 2 2 2
  271. - 2*X(1) *DF(Q1(X(1)),X(1),2) - X(1) *DF(Q1(X(1)),X(1))
  272. + 4*X(1)*DF(P1(X(1)),X(1)) - 4*X(1)*DF(Q1(X(1)),X(1))
  273. P1(X(1)) P1(X(1)) 2
  274. + 4*E - 4)/(2*E *X(1) )
  275. comment finally compute and print the Einstein tensor;
  276. array einstein(3,3);
  277. for i:=0:3 do for j:=0:3 do
  278. write einstein(i,j):=ricci(i,j)-rs*gg(i,j)/2;
  279. EINSTEIN(0,0) :=
  280. Q1(X(1)) P1(X(1))
  281. E *( - X(1)*DF(P1(X(1)),X(1)) - E + 1)
  282. -------------------------------------------------------
  283. P1(X(1)) 2
  284. E *X(1)
  285. P1(X(1))
  286. - X(1)*DF(Q1(X(1)),X(1)) + E - 1
  287. EINSTEIN(1,1) := -------------------------------------------
  288. 2
  289. X(1)
  290. EINSTEIN(2,2) := (X(1)*(X(1)*DF(P1(X(1)),X(1))*DF(Q1(X(1)),X(1))
  291. - 2*X(1)*DF(Q1(X(1)),X(1),2)
  292. 2
  293. - X(1)*DF(Q1(X(1)),X(1))
  294. + 2*DF(P1(X(1)),X(1)) - 2*DF(Q1(X(1)),X(1))))
  295. P1(X(1))
  296. /(4*E )
  297. 2
  298. EINSTEIN(3,3) := (X(1)*SIN(X(2)) *(
  299. X(1)*DF(P1(X(1)),X(1))*DF(Q1(X(1)),X(1))
  300. - 2*X(1)*DF(Q1(X(1)),X(1),2)
  301. 2
  302. - X(1)*DF(Q1(X(1)),X(1))
  303. + 2*DF(P1(X(1)),X(1)) - 2*DF(Q1(X(1)),X(1))))
  304. P1(X(1))
  305. /(4*E )
  306. comment end of Einstein tensor program;
  307. clear gg,h,cs1,cs2,r,ricci,einstein;
  308. comment an example using the matrix facility;
  309. matrix xx,yy,zz;
  310. let xx= mat((a11,a12),(a21,a22)),
  311. yy= mat((y1),(y2));
  312. 2*det xx - 3*w;
  313. 2*(A11*A22 - A12*A21 - 5443200)
  314. zz:= xx**(-1)*yy;
  315. [ - A12*Y2 + A22*Y1 ]
  316. [--------------------]
  317. [ A11*A22 - A12*A21 ]
  318. ZZ := [ ]
  319. [ A11*Y2 - A21*Y1 ]
  320. [------------------- ]
  321. [ A11*A22 - A12*A21 ]
  322. 1/xx**2;
  323. 2
  324. A12*A21 + A22
  325. MAT((-------------------------------------------,
  326. 2 2 2 2
  327. A11 *A22 - 2*A11*A12*A21*A22 + A12 *A21
  328. - A12*(A11 + A22)
  329. -------------------------------------------),
  330. 2 2 2 2
  331. A11 *A22 - 2*A11*A12*A21*A22 + A12 *A21
  332. - A21*(A11 + A22)
  333. (-------------------------------------------,
  334. 2 2 2 2
  335. A11 *A22 - 2*A11*A12*A21*A22 + A12 *A21
  336. 2
  337. A11 + A12*A21
  338. -------------------------------------------))
  339. 2 2 2 2
  340. A11 *A22 - 2*A11*A12*A21*A22 + A12 *A21
  341. comment end of matrix examples;
  342. comment a physics example;
  343. on div;
  344. comment this gives us output in same form as Bjorken and Drell;
  345. mass ki= 0, kf= 0, p1= m, pf= m;
  346. vector ei,ef;
  347. mshell ki,kf,p1,pf;
  348. let p1.ei= 0, p1.ef= 0, p1.pf= m**2+ki.kf, p1.ki= m*k,p1.kf=
  349. m*kp, pf.ei= -kf.ei, pf.ef= ki.ef, pf.ki= m*kp, pf.kf=
  350. m*k, ki.ei= 0, ki.kf= m*(k-kp), kf.ef= 0, ei.ei= -1, ef.ef=
  351. -1;
  352. operator gp;
  353. for all p let gp(p)= g(l,p)+m;
  354. comment this is just to save us a lot of writing;
  355. gp(pf)*(g(l,ef,ei,ki)/(2*ki.p1) + g(l,ei,ef,kf)/(2*kf.p1))
  356. * gp(p1)*(g(l,ki,ei,ef)/(2*ki.p1) + g(l,kf,ef,ei)/(2*kf.p1))$
  357. write "The Compton cross-section is ",ws;
  358. 2 1 -1 1 -1
  359. The Compton cross-section is 2*EI.EF + ---*K*KP + ---*K *KP - 1
  360. 2 2
  361. comment end of first physics example;
  362. off div;
  363. comment another physics example;
  364. index ix,iy,iz;
  365. mass p1=mm,p2=mm,p3= mm,p4= mm,k1=0;
  366. mshell p1,p2,p3,p4,k1;
  367. vector q1,q2;
  368. factor mm,p1.p3;
  369. operator ga,gb;
  370. for all p let ga(p)=g(la,p)+mm, gb(p)= g(lb,p)+mm;
  371. ga(-p2)*g(la,ix)*ga(-p4)*g(la,iy)* (gb(p3)*g(lb,ix)*gb(q1)
  372. *g(lb,iz)*gb(p1)*g(lb,iy)*gb(q2)*g(lb,iz) + gb(p3)
  373. *g(lb,iz)*gb(q2)*g(lb,ix)*gb(p1)*g(lb,iz)*gb(q1)*g(lb,iy))$
  374. let q1=p1-k1, q2=p3+k1;
  375. comment it is usually faster to make such substitutions after all the
  376. trace algebra is done;
  377. write "CXN =",ws;
  378. 4 4 2 2
  379. CXN =32*MM *P1.P3 + 8*MM *(P1.K1 - P3.K1) - 16*MM *P1.P3
  380. 2
  381. + 16*MM *P1.P3*( - P1.K1 - P2.P4 + P3.K1)
  382. 2
  383. + 8*MM *( - P1.K1*P2.P4 + P2.P4*P3.K1 - 2*P2.K1*P4.K1) + 8
  384. *P1.P3*(2*P1.P2*P3.P4 + P1.P2*P4.K1 + 2*P1.P4*P2.P3
  385. + P1.P4*P2.K1 - P2.P3*P4.K1 - P2.K1*P3.P4) + 8*(
  386. - 2*P1.P2*P1.P4*P3.K1 + P1.P2*P1.K1*P3.P4
  387. - P1.P2*P3.P4*P3.K1 + P1.P4*P1.K1*P2.P3 - P1.P4*P2.P3*P3.K1
  388. + 2*P1.K1*P2.P3*P3.P4)
  389. comment end of second physics example;
  390. showtime;
  391. Time: 7344 ms
  392. end;
  393. 4: 4:
  394. Quitting
  395. Sat Jun 29 13:37:36 PDT 1991