share/tensor/kaluza.dem

   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))$
 115
 116 ("But what about the 5D Christoffel-symbol?")$
 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(%)$
 141 ("The extra term is presumably the curvature caused by the EM field.")$
 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 */