~ubuntu-branches/debian/squeeze/maxima/squeeze

« back to all changes in this revision

Viewing changes to share/tensor/kaluza.dem

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2006-10-18 14:52:42 UTC
  • mto: (1.1.5 upstream)
  • mto: This revision was merged to the branch mainline in revision 4.
  • Revision ID: james.westby@ubuntu.com-20061018145242-vzyrm5hmxr8kiosf
ImportĀ upstreamĀ versionĀ 5.10.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
1
 
("Deriving the Kaluza-Klein equation of motion.")$
2
 
("For reference, see http://www.vttoth.com/KK/kk.htm")$
3
 
DERIVABBREV:TRUE;
4
 
("KALUZA.MAC contains definitions and contraction properties for G4 and G5")$
5
 
load("kaluza.mac");
6
 
("Predeclaring some 4d indices")$
7
 
ASSUME(K<=4,L<=4,M<=4)$
8
 
 
9
 
("Equation of motion in empty 5-space")$
10
 
SHOW('DIFF(x([],[A]),t,2)+'CHR2([B,C],[A])*'DIFF(x([],[B]),t)*'DIFF(x([],[C]),t)=0)$
11
 
SHOW(PART(FIRST(%),1))$
12
 
SHOW(SUBST(M,C,%)+SUBST(5,C,%))$
13
 
SHOW(SUBST(L,B,%)+SUBST(5,B,%)+PART(FIRST(%TH(3)),2)=LAST(%TH(3)))$
14
 
 
15
 
("We are only interested in the case where A is a 4D index")$
16
 
SHOW(SUBST(K,A,%TH(2)))$
17
 
 
18
 
("We protect one of the Christoffel-symbols from expansion")$
19
 
SHOW(SUBST(CHR2KLM,'CHR2([L,M],[K]),%TH(2)))$
20
 
%,CHR2$
21
 
SHOW(RENAME(%))$
22
 
 
23
 
("Now we break this up into two parts depending on whether %1=5")$
24
 
MAP(LAMBDA([U],BLOCK(IF FREEOF(%1,U) THEN U ELSE U+SUBST(5,%1,U))),FIRST(%TH(2)))=LAST(%TH(2))$
25
 
ASSUME(%1<=4)$
26
 
%TH(2),G5$
27
 
%,NOUNS$
28
 
SHOW(%)$
29
 
 
30
 
("Now we're ready to isolate the electromagnetic field tensor")$
31
 
MAP(LAMBDA([U],FACTOROUT(U,G55)),%TH(2))$
32
 
SHOW(APPLY1(%,EVPOT))$
33
 
 
34
 
("Contracting and rearranging yields the equation in the usual form")$
35
 
CONTRACT(%TH(2))$
36
 
%,NOUNS$
37
 
SHOW(RENAME(%))$
38
 
 
39
 
%-PART(FIRST(%),1)$
40
 
SHOW(SUBST('CHR2([L,M],[K]),CHR2KLM,%))$
 
1
/* Copyright (C) 2004 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
 * The equation of motion of a free particle in a five dimensional
 
14
 * Kaluza-Klein metric appears as the motion of a charged particle
 
15
 * in four dimensional space in the presence of an EM field
 
16
 */
 
17
 
 
18
("
 
19
 
 
20
Deriving the Kaluza-Klein equation of motion.
 
21
For reference, see http://www.vttoth.com/KK/kk.htm")$
 
22
 
 
23
("We first load ITENSOR and set up the 5-dimensional metric.
 
24
We also set up contraction properties for both the 4-dimensional
 
25
and the 5-dimensional metric tensors.")$
 
26
 
 
27
if get('itensor,'version)=false then load(itensor);
 
28
(derivabbrev:true, dim:5, imetric:g5, defcon(g4),defcon(g5),
 
29
defcon(g4,g4,kdelta), defcon(g5,g5,kdelta))$
 
30
 
 
31
("To set up the metric components, we need some helper functions.
 
32
The function predval() determines if a predicate can be evaluated.
 
33
It returns false if the predicate would return an error. The
 
34
function difflist() applies the differential operator to elements
 
35
in a list.")$
 
36
 
 
37
predval(prd):=block([retval,saved_prederror:prederror],
 
38
    prederror:false,
 
39
    retval:ev(prd,pred)=true or ev(prd,pred)=false,
 
40
    prederror:saved_prederror,
 
41
    retval
 
42
)$
 
43
difflist(exp,lst):=if length(lst)=0 then exp
 
44
                   else difflist(idiff(exp,lst[1]),rest(lst))$
 
45
 
 
46
("Metric components are defined conditionally, allowing us to treat
 
47
the fifth index in a unique way.")$
 
48
 
 
49
a(l1,l2,[l3]):=if member(5,l3) then 0 else funmake('a,append([l1,l2],l3))$
 
50
g4(l1,l2,[l3]):=if member(5,l3) then 0 else funmake('g4,append([l1,l2],l3))$
 
51
g5(l1,l2,[l3]):=
 
52
    if member(5,l3) then 0
 
53
    else if l1#[] then
 
54
    (
 
55
        if not (predval(l1[1]<=4) and predval(l1[2]<=4)) then
 
56
            funmake('g5,append([l1,l2],l3))
 
57
        else if l1[1]<=4 and l1[2]<=4 then
 
58
            apply('g4,append([l1,l2],l3))+
 
59
                      g55*difflist(a([l1[1]],[])*a([l1[2]],[]),l3)
 
60
        else if l1[1]<=4 then g55*apply('a,append([[l1[1]],[]],l3))
 
61
        else if l1[2]<=4 then g55*apply('a,append([[l1[2]],[]],l3))
 
62
        else if l3#[] then 0 else g55
 
63
    )
 
64
    else if l2#[] then
 
65
    (
 
66
        if not (predval(l2[1]<=4) and predval(l2[2]<=4)) then
 
67
            funmake('g5,append([l1,l2],l3))
 
68
        else if l2[1]<=4 and l2[2]<=4 then apply('g4,append([l1,l2],l3))
 
69
        else if l2[1]<=4 then -apply('a,append([[],[l2[1]]],l3))
 
70
        else if l2[2]<=4 then -apply('a,append([[],[l2[2]]],l3))
 
71
        else if l3#[] then sum(difflist(a([i],[])*a([],[i]),l3),i,1,4)
 
72
        else 1/g55+sum(a([i],[])*a([],[i]),i,1,4)
 
73
    )
 
74
    else funmake('g5,append([l1,l2],l3))$
 
75
 
 
76
("Now we're ready to begin the analysis. First, we predeclare
 
77
some 4-dimensional indices:")$
 
78
assume(k<=4,l<=4,m<=4)$
 
79
 
 
80
("The equation of motion in empty 5-space:")$
 
81
depends(x,t);
 
82
ishow('diff(x([],[a]),t,2)+
 
83
      'ichr2([b,c],[a])*'diff(x([],[b]),t)*'diff(x([],[c]),t)=0)$
 
84
ishow(part(first(%),1))$
 
85
ishow(subst(m,c,%)+subst(5,c,%))$
 
86
ishow(subst(l,b,%)+subst(5,b,%)+part(first(%th(3)),2)=last(%th(3)))$
 
87
 
 
88
("We are only interested in the case where A is a 4D index:")$
 
89
ishow(subst(k,a,%th(2)))$
 
90
 
 
91
("We protect one of the Christoffel-symbols from expansion:")$
 
92
ishow(subst(chr2klm,'ichr2([l,m],[k]),%th(2)))$
 
93
%,ichr2$
 
94
ishow(rename(%))$
 
95
 
 
96
("Now we break this up into two parts depending on whether %1=5:")$
 
97
map(lambda([u],block(if freeof(%1,u) then u else u+subst(5,%1,u))),
 
98
                     first(%th(2)))=last(%th(2))$
 
99
assume(%1<=4)$
 
100
%th(2),g5$
 
101
%,nouns$
 
102
ishow(%)$
 
103
 
 
104
("Now we're ready to isolate the electromagnetic field tensor:")$
 
105
map(lambda([u],factorout(u,g55)),%th(2))$
 
106
ishow(ratsubst(-f([%1,%2],[]),a([%1],[],%2)-a([%2],[],%1),%))$
 
107
 
 
108
("Contracting and rearranging yields the equation in the usual form:")$
 
109
contract(%th(2))$
 
110
%,nouns$
 
111
ishow(rename(%))$
 
112
%-part(first(%),1)$
 
113
EQ:subst('ichr2([l,m],[k]),chr2klm,%)$
 
114
ishow(box(EQ))$
41
115
 
42
116
("But what about the 5D Christoffel-symbol?")$
43
 
SHOW(CHR2([K,L],[M]))$
44
 
RENAME(%)$
45
 
FORGET(%1<=4)$
46
 
SUBST(5,%1,%TH(2))$
47
 
%,G5,G4$
48
 
SHOW(%)$
49
 
 
50
 
ASSUME(%1<=4)$
51
 
%TH(6),G5$
52
 
SCANMAP(LAMBDA([U],APPLY1(  RATSIMP(U,G55,G4([],[%1,M]),A([K],[]))  ,EVPOT)),%)$
53
 
SHOW(%)$
54
 
 
55
 
%+%TH(5)$
56
 
%,NOUNS$
57
 
RATSUBST(CHR42([K,L],[M]),G4([],[%1,M])*(G4([L,%1],[],K)+G4([K,%1],[],L)-G4([K,L],[],%1))/2,%)$
58
 
SHOW(%)$
59
 
 
60
 
CONTRACT(%)$
 
117
/*ishow(ichr2([k,l],[m]))$*/
 
118
ishow(ichr2([l,m],[k]))$
 
119
rename(%)$
 
120
forget(%1<=4)$
 
121
subst(5,%1,%th(2))$
 
122
%,g5,g4$
 
123
ishow(%)$
 
124
 
 
125
assume(%1<=4)$
 
126
%th(6),g5$
 
127
/*ratsubst(-f([%1,k],[]),a([%1],[],k)-a([k],[],%1),%)$*/
 
128
ratsubst(-f([%1,l],[]),a([%1],[],l)-a([l],[],%1),%)$
 
129
ratsubst(-f([%1,m],[]),a([%1],[],m)-a([m],[],%1),%)$
 
130
ishow(factor(contract(expand(%))))$
 
131
 
 
132
%+%th(6)$
 
133
%,nouns$
 
134
/*ratsubst(ichr42([k,l],[m]),
 
135
         g4([],[m,%1])*(g4([l,%1],[],k)+g4([k,%1],[],l)-g4([k,l],[],%1))/2,%)$*/
 
136
ratsubst(ichr42([l,m],[k]),
 
137
         g4([],[k,%1])*(g4([m,%1],[],l)+g4([l,%1],[],m)-g4([l,m],[],%1))/2,%)$
 
138
ishow(%)$
 
139
 
 
140
contract(%)$
61
141
("The extra term is presumably the curvature caused by the EM field.")$
62
 
SHOW(MAP(FACTOR,COMBINE(DISTRIB(%TH(2)))))$
 
142
/*ishow('ichr2([k,l],[m])=map(factor,combine(distrib(%th(2)))))$*/
 
143
ishow('ichr2([l,m],[k])=map(factor,combine(distrib(%th(2)))))$
 
144
("Or, if you wish, you can apply this result to the equation of motion:")$
 
145
ishow(subst(rhs(%th(2)),lhs(%th(2)),EQ))$
 
146
 
 
147
/* End of demo -- comment line needed by MAXIMA to resume demo menu */