| blob | 5459269c924921443cddb3395974427750c74b5a |
1 /* Copyright (C) 2005 Viktor T. Toth <http://www.vttoth.com/>
2 *
3 * This program is free software; you can redistribute it and/or
4 * modify it under the terms of the GNU General Public License as
5 * published by the Free Software Foundation; either version 2 of
6 * the License, or (at your option) any later version.
7 *
8 * This program is distributed in the hope that it will be
9 * useful, but WITHOUT ANY WARRANTY; without even the implied
10 * warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
11 * PURPOSE. See the GNU General Public License for more details.
12 *
13 * Exploring the Riemann and Weyl tensors
14 *
15 */
16 ("Exploring the Riemann and Weyl tensors")$
17 if get('itensor,'version)=false then load(itensor);
18 ("Define a standard metric")$
19 remcomps(g);
20 imetric(g);
21 decsym(g,2,0,[sym(all)],[]);
22 decsym(g,0,2,[],[sym(all)]);
23 ("Let us prove some basic identities of the curvature tensor")$
24 ishow(icurvature([i,j,k],[l])+icurvature([i,k,j],[l]))$
25 canform(%);
26 ishow(icurvature([i,j,k],[l])+icurvature([j,k,i],[l])+icurvature([k,i,j],[l]))$
27 %,ichr2$
28 ("Sometimes we need to simplify repeatedly...")$
29 canform(%th(2))$
30 nterms(%);
31 canform(contract(rename(%th(2))))$
32 nterms(%);
33 canform(contract(rename(%th(2))));
34 ("Now define the covariant Riemann-tensor")$
35 remcomps(R);
36 kill(R);
37 components(R([i,j,k,l],[]),'icurvature([i,j,k],[m])*g([l,m],[]));
38 ("which is antisymmetric in its middle two indices")$
39 R([i,j,k,l],[])+R([i,k,j,l],[])$
40 %,icurvature$
41 %,ichr2$
42 canform(contract(contract(expand(%))))$
43 canform(contract(rename(%)));
44 decsym(R,4,0,[anti(2,3)],[]);
45 ("and also antisymmetric in its first and last index")$
46 R([i,j,k,l],[])+R([l,j,k,i],[])$
47 %,icurvature$
48 canform(contract(rename(%)))$
49 %,ichr2$
50 canform(contract(canform(simpmetderiv(canform(%)))))$
51 canform(contract(rename(%)))$
52 allsym:true;
53 canten(%th(2));
54 allsym:false;
55 decsym(R,4,0,[anti(1,4)],[]);
56 ("But it is equal to itself with the first and last index pair swapped")$
57 R([i,j,k,l],[])-R([j,i,l,k],[]),noeval;
58 ishow(canform(%))$
59 %,R$
60 %,icurvature$
61 canform(contract(rename(%)))$
62 %,ichr2$
63 canform(contract(canform(simpmetderiv(canform(%)))))$
64 canform(contract(rename(%)))$
65 allsym:true;
66 canten(%th(2));
67 allsym:false;
68 ("Contraction of R in the first and last indices yields zero")$
69 ishow(canform(icurvature([k,i,j],[k])))$
70 %,ichr2$
71 canform(rename(expand(%)))$
72 canform(contract(rename(%)))$
73 ishow(simpmetderiv(%))$
74 ishow(rename(canform(conmetderiv(%,imetric))))$
75 ("Now let us define the Ricci-tensor")$
76 components(R([i,j],[]),'icurvature([i,j,k],[k]));
77 ("The Ricci tensor is symmetrical")$
78 ishow(canform(R([i,j],[])-R([j,i],[])))$
79 %,icurvature$
80 ishow(canform(%))$
81 %,ichr2$
82 ishow(rename(canform(rename(expand(%)))))$ /* Terms remain! But see Frankel, p. 300 */
83 rename(contract(rename(contract(rename(canform(simpmetderiv(%)))))))$
84 rename(canform(factor(simpmetderiv(canform(%)))));
85 decsym(R,2,0,[sym(all)],[]);
86 decsym(R,0,2,[],[sym(all)]);
87 ("This is the curvature scalar")$
88 components(R([],[]),R([i,j],[])*g([],[i,j]));
89 ("Now we can define the Weyl-tensor")$
90 ("To do this, we need an improved definition of the Riemann tensor")$
91 ("This definition will not mess up index ordering")$
92 remcomps(R);
93 ("First, a helper function")$
94 coni(x):=not atom(x) and op(x)="-"$
95 ("R() is now defined as a function taking two lists as parameters")$
96 R(cov,con):=
97 (
98 if length(con) > 0 then
99 (
100 cov:append(cov, map("-", con)),
101 con:[]
102 ),
103 if length(cov) = 4 then
104 block(
105 [tmp:idummy()],
106 if coni(cov[1]) then g([],[tmp,-cov[1]])*'R([tmp,cov[2],cov[3],cov[4]],[])
107 else if coni(cov[2]) then g([],[tmp,-cov[2]])*'R([cov[1],tmp,cov[3],cov[4]],[])
108 else if coni(cov[3]) then g([],[tmp,-cov[3]])*'R([cov[1],cov[2],tmp,cov[4]],[])
109 else if coni(cov[4]) then 'icurvature([cov[1],cov[2],cov[3]],[-cov[4]])
110 else g([tmp,cov[4]],[])*'icurvature([cov[1],cov[2],cov[3]],[tmp])
111 )
112 else if length(cov) = 2 then
113 (
114 [tmp:idummy()],
115 if coni(cov[1]) then g([],[tmp,-cov[1]])*'R([tmp,cov[2]],[])
116 else if coni(cov[2]) then g([],[tmp,-cov[2]])*'R([tmp,cov[1]],[])
117 else 'icurvature([cov[1],cov[2],tmp],[tmp])
118 )
119 else if length(cov) = 0 then
120 (
121 [tmp:idummy()],
122 'R([tmp],[tmp])
123 )
124 else funmake(R,append([[cov,con]], der))
125 )$
126 ("Now we can define the Weyl tensor itself")$
127 remcomps(W);
128 components(W([i,j,k,l],[]),'R([i,j,k,l],[])+1/('dim-1)/('dim-2)*'R([],[])*(g([j,i],[])*g([l,k],[])-g([j,l],[])*g([i,k],[]))+1/('dim-2)*(g([k,i],[])*'R([l,j],[])-g([k,l],[])*'R([i,j],[])-g([j,i],[])*'R([l,k],[])+g([j,l],[])*'R([i,k],[])));
129 ("Let us prove that the Weyl-tensor is trace free in all its indices")$
130 ("We work in arbitrary dimensions")$
131 dim:'dim;
132 ("This hand-crafted simplification function works well on W")$
133 simpW(x):=
134 (
135 x:canform(factor(canform(contract(canform(x))))),
136 x:ev(x,R),
137 x:canform(factor(canform(x))),
138 x:ev(x,icurvature),
139 x:canform(x),
140 x:ev(x,ichr2),
141 x:canform(contract(simpmetderiv(canform(contract(canform(x)))))),
142 flipflag:not flipflag,
143 x:simpmetderiv(canform(contract(simpmetderiv(x,stop))),stop),
144 flipflag:not flipflag,
145 canform(conmetderiv(canform(contract(simpmetderiv(canform(x),stop))),imetric))
146 )$
147 ("And here we go...")$
148 ishow(W([i,j,k,l],[])*g([-i,-j],[]))$
149 simpW(%);
150 ishow(W([i,j,k,l],[])*g([-i,-k],[]))$
151 simpW(%);
152 ishow(W([i,j,k,l],[])*g([-i,-l],[]))$
153 simpW(%);
154 ishow(W([i,j,k,l],[])*g([-j,-k],[]))$
155 simpW(%);
156 ishow(W([i,j,k,l],[])*g([-j,-l],[]))$
157 simpW(%);
158 ishow(W([i,j,k,l],[])*g([-k,-l],[]))$
159 simpW(%);
161 /* End of demo -- comment line needed by MAXIMA to resume demo menu */