GR exam 2013

Print["hmm"]

Question A

Print["hmm"]

GRSetup2.nb - modified

(* Latest Version *)

metric={gtt,grr,gθθ,gϕϕ,gzz}

Gd=DiagonalMatrix[metric]

Gd[[1,2]]=grt

Gd[[2,1]]=grt

BuildMetric:=(Gu=FullSimplify[Inverse[Gd]];G={{u,d},IdentityMatrix[Nind]};)

BuildMetric

ind={t,r,θ,ϕ,z}

Nind=Length[ind]

getind[i1_]:=(If[IntegerQ[i1],i1,Position[ind,i1][[1,1]]])

lstind[i1_]:=(lsttmp2={};Do[AppendTo[lsttmp2,getind[i1[[lsttmp1,1]]]],{lsttmp1,1,Length[i1]}];lsttmp2)

up[i1_,i2_]:=(lsttmp2={};Do[AppendTo[lsttmp2,If[i1[[lsttmp1,2]]=!=i2[[lsttmp1]],If[i1[[lsttmp1,2]]===d,d,u],0]],{lsttmp1,1,Length[i1]}];lsttmp2)

MT[t1_,dim_,indpos_]:=(MTtmp1=0;If[Length[indpos]=!=dim,Print["Error in index position"]];Do[MTtmp1=Table[MTtmp1,{MTtmp3,1,Nind}],{MTtmp2,1,dim}];t1={indpos,MTtmp1})

ST[t1_,tind_,val_]:=(STtmp1=t1;If[up[tind,t1[[1]]]=!=Table[0,{Length[tind]}],Print["Error in Index Assignment!!"];];STtmp1[[2]]=ReplacePart[t1[[2]],val,lstind[tind]];STtmp1)

Edited the expression below as 7.0 seems to complain about Sum[x] whereas 6.0 would just return x (ie. if there is no sum index!)

GT[t1_,tind_]:=(GTtmp2=up[tind,t1[[1]]];GTtmp3="";GTtmp4="";GTtmp5="";GTtmp6=t1;
		Do[
			Switch[GTtmp2[[GTtmp1]],
				0,
				(GTtmp3=GTtmp3<>","<>ToString[getind[tind[[GTtmp1,1]]]];),
				u,
				(GTtmp3=GTtmp3<>","<>"tmpind"<>ToString[GTtmp1];
					GTtmp4=GTtmp4<>" Gu[["<>ToString[getind[tind[[GTtmp1,1]]]]<>", tmpind"<>ToString[GTtmp1]<>"]] ";
					GTtmp5=GTtmp5<>",{tmpind"<>ToString[GTtmp1]<>",1,Nind}"),
				d,
				(GTtmp3=GTtmp3<>","<>"tmpind"<>ToString[GTtmp1];
					GTtmp4=GTtmp4<>" Gd[["<>ToString[getind[tind[[GTtmp1,1]]]]<>", tmpind"<>ToString[GTtmp1]<>"]] ";
					GTtmp5=GTtmp5<>",{tmpind"<>ToString[GTtmp1]<>",1,Nind}";)];
			,{GTtmp1,1,Length[t1[[1]]]}];If[GTtmp4===""&&GTtmp5==="",ToExpression["GTtmp6[[2"<>GTtmp3<>"]]"],ToExpression["Sum[GTtmp6[[2"<>GTtmp3<>"]]"<>GTtmp4<>GTtmp5<>"]"]])

Trace, Outer Product and Covariant Derivative! - GREinstein.nb

Syntax:   trT[tensor,{{1,4},{2,3}}]   -  ie. contract 1 and 4 plus 2 and 3 positions

trT[t1_,lst_]:=(

dimt1=Length[Dimensions[t1[[2]]]];
tmpt1=t1;
Clear[tracetmp];

If[dimt1===2,

tracetmp=Sum[GT[tmpt1,{{s1,d},{s1,u}}],{s1,1,Nind}];

,

MT[tracetmp,dimt1-2Length[lst],Table[d,{ii,1,dimt1-2Length[lst]}]];

tmpstring1="";tmpstring2="";tmpstring3="";

Do[

If[{}===Position[lst,indno],
tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";
tmpstring3=tmpstring3<>"{i"<>ToString[indno]<>",1,Nind},";
];

tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",d},";

,{indno,1,dimt1}];

tmpstring4="";

Do[

tmpstring4=tmpstring4<>"{s"<>ToString[indno]<>",1,Nind},";

tmpstring2=StringReplace[tmpstring2,"i"<>ToString[lst[[indno,1]]]->"s"<>ToString[indno]];

tmpstring2=StringReplace[tmpstring2,"i"<>ToString[lst[[indno,2]]]<>",d}"->"s"<>ToString[indno]<>",u}"];

,{indno,1,Length[lst]}];

tmpeval="Do[tracetmp=ST[tracetmp,{"<>StringDrop[tmpstring1,-1]<>"},Sum[GT[tmpt1,{"<>StringDrop[tmpstring2,-1]<>"}],"<>StringDrop[tmpstring4,-1]<>"]],"<>StringDrop[tmpstring3,-1]<>"]";

ToExpression[tmpeval];

];

tracetmp
)

Syntax:   outerT[tensor1,tensor2]

outerT[t1_,t2_]:=(

dimt1=Length[Dimensions[t1[[2]]]];dimt2=Length[Dimensions[t2[[2]]]];
tmpt1=t1;tmpt2=t2;
Clear[outertmp];

MT[outertmp,dimt1+dimt2,Table[d,{ii,1,dimt1+dimt2}]];

tmpstring1="";tmpstring2="";

Do[

tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";
tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt1}];

tmpstring3="";tmpstring4="";

Do[

tmpstring3=tmpstring3<>"{j"<>ToString[indno]<>",d},";
tmpstring4=tmpstring4<>"{j"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt2}];

tmpeval="Do[outertmp=ST[outertmp,{"<>tmpstring1<>StringDrop[tmpstring3,-1]<>"},GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}]GT[tmpt2,{"<>StringDrop[tmpstring3,-1]<>"}]],"<>tmpstring2<>StringDrop[tmpstring4,-1]<>"]";

ToExpression[tmpeval];

outertmp

)

scalarDT[t1_]:=(

tmpt1=t1;
Clear[covDTtmp];
MT[covDTtmp,1,{d}];

tmpeval="Do[covDTtmp=ST[covDTtmp,{{i1,d}},D[tmpt1,ind[[i1]]]],{i1,1,Nind}]";

ToExpression[tmpeval];

covDTtmp

)

covDT[t1_]:=(

dimt1=Length[Dimensions[t1[[2]]]];
tmpt1=t1;
Clear[covDTtmp];
MT[covDTtmp,dimt1+1,Table[d,{ii,1,dimt1+1}]];

(* Build expression *)

tmpstring1="";tmpstring2="";tmpstring3="";

Do[

tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";

tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt1}];

Do[
tmpstring4="-Sum[GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}]GT[Γ,{{REPL,d},{s1,d},{s2,u}}],{s2,1,Nind}]";

tmpstring4=StringReplace[tmpstring4,"i"<>ToString[indno]-> "s2"];

tmpstring4=StringReplace[tmpstring4,"REPL"->"i"<>ToString[indno]];

tmpstring3=tmpstring3<>tmpstring4;

,{indno,1,dimt1}];

tmpeval="Do[covDTtmp=ST[covDTtmp,{"<>tmpstring1<>"{s1,d}},D[GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}],ind[[s1]]]"<>tmpstring3<>"],"<>tmpstring2<>"{s1,1,Nind}]";


ToExpression[tmpeval];

covDTtmp

);

.

Buildmetric

Gd=(({{-(1-((2M)/r)), 0, 0, 0}, {0, (1/((1-((2M)/r)))), 0, 0}, {0, 0, r^2, 0}, {0, 0, 0, r^2 Sin[θ]^2}}))

ind={t,r,θ,ϕ}

Nind=Length[ind]

BuildMetric;

Gd

Gu

detg=Simplify[Det[Gd]]

GRrun2.nb

Clear[Γ]

MT[Γ,3,{d,d,u}];

Clear[R4]

MT[R4,4,{d,d,d,u}];

Clear[R2]

MT[R2,2,{d,d}];

Clear[G2]

MT[G2,2,{d,d}];

Do[Γ=ST[Γ,{{ind[[i1]],d},{ind[[i2]],d},{ind[[i3]],u}},Sum[(1/2)GT[G,{{ind[[i3]],u},{ind[[ss1]],u}}](D[GT[G,{{ind[[i1]],d},{ind[[ss1]],d}}],ind[[i2]]]+D[GT[G,{{ind[[ss1]],d},{ind[[i2]],d}}],ind[[i1]]]-D[GT[G,{{ind[[i1]],d},{ind[[i2]],d}}],ind[[ss1]]]),{ss1,1,Nind}]],{i1,1,Nind},{i2,1,Nind},{i3,1,Nind}]

(* FullSimplify[Γ] *)

Γ=FullSimplify[Γ];

Do[
	R4=ST[R4,
			{{ind[[i1]],d},{ind[[i2]],d},{ind[[i3]],d},{ind[[i4]],u}},
	
			D[GT[Γ,{{ind[[i1]],d},{ind[[i3]],d},{ind[[i4]],u}}],ind[[i2]]]-D[GT[Γ,{{ind[[i2]],d},{ind[[i3]],d},{ind[[i4]],u}}],ind[[i1]]]+
			Sum[GT[Γ,{{ind[[i1]],d},{ind[[i3]],d},{ind[[ss1]],u}}]GT[Γ,{{ind[[i2]],d},{ind[[ss1]],d},{ind[[i4]],u}}]-GT[Γ,{{ind[[i2]],d},{ind[[i3]],d},{ind[[ss1]],u}}]GT[Γ,{{ind[[i1]],d},{ind[[ss1]],d},{ind[[i4]],u}}],{ss1,1,Nind}]
		
		]
		,
	{i1,1,Nind},{i2,1,Nind},{i3,1,Nind},{i4,1,Nind}]

(* FullSimplify[R4] *)

Do[R2=ST[R2,
			{{ind[[i1]],d},{ind[[i2]],d}},
			Sum[GT[R4,{{ind[[i1]],d},{ind[[ss1]],u},{ind[[i2]],d},{ind[[ss1]],d}}],{ss1,1,Nind}]
		]
	,{i1,1,Nind},{i2,1,Nind}]

(* FullSimplify[R2] *)

Ricci=Sum[GT[R2,{{ind[[ss1]],u},{ind[[ss1]],d}}],{ss1,1,Nind}];

Do[G2=ST[G2,
			{{ind[[i1]],d},{ind[[i2]],d}},
			GT[R2,{{ind[[i1]],d},{ind[[i2]],d}}]-(1/2)GT[G,{{ind[[i1]],d},{ind[[i2]],d}}]Ricci]
	,{i1,1,Nind},{i2,1,Nind}]

(* FullSimplify[G2] *)

(* FullSimplify[Ricci] *)

Einstein equations

Simplify[R2]

FullSimplify[GT[Γ,{{t,d},{t,d},{r,u}}]]

GT[Γ,{{t,d},{t,d},{t,u}}]

GT[Γ,{{t,d},{t,d},{θ,u}}]

GT[Γ,{{t,d},{t,d},{ϕ,u}}]

Question B1

Print["hmm"]

GRSetup2.nb - modified

(* Latest Version *)

metric={gtt,grr,gθθ,gϕϕ,gzz}

Gd=DiagonalMatrix[metric]

Gd[[1,2]]=grt

Gd[[2,1]]=grt

BuildMetric:=(Gu=FullSimplify[Inverse[Gd]];G={{u,d},IdentityMatrix[Nind]};)

BuildMetric

ind={t,r,θ,ϕ,z}

Nind=Length[ind]

getind[i1_]:=(If[IntegerQ[i1],i1,Position[ind,i1][[1,1]]])

lstind[i1_]:=(lsttmp2={};Do[AppendTo[lsttmp2,getind[i1[[lsttmp1,1]]]],{lsttmp1,1,Length[i1]}];lsttmp2)

up[i1_,i2_]:=(lsttmp2={};Do[AppendTo[lsttmp2,If[i1[[lsttmp1,2]]=!=i2[[lsttmp1]],If[i1[[lsttmp1,2]]===d,d,u],0]],{lsttmp1,1,Length[i1]}];lsttmp2)

MT[t1_,dim_,indpos_]:=(MTtmp1=0;If[Length[indpos]=!=dim,Print["Error in index position"]];Do[MTtmp1=Table[MTtmp1,{MTtmp3,1,Nind}],{MTtmp2,1,dim}];t1={indpos,MTtmp1})

ST[t1_,tind_,val_]:=(STtmp1=t1;If[up[tind,t1[[1]]]=!=Table[0,{Length[tind]}],Print["Error in Index Assignment!!"];];STtmp1[[2]]=ReplacePart[t1[[2]],val,lstind[tind]];STtmp1)

Edited the expression below as 7.0 seems to complain about Sum[x] whereas 6.0 would just return x (ie. if there is no sum index!)

GT[t1_,tind_]:=(GTtmp2=up[tind,t1[[1]]];GTtmp3="";GTtmp4="";GTtmp5="";GTtmp6=t1;
		Do[
			Switch[GTtmp2[[GTtmp1]],
				0,
				(GTtmp3=GTtmp3<>","<>ToString[getind[tind[[GTtmp1,1]]]];),
				u,
				(GTtmp3=GTtmp3<>","<>"tmpind"<>ToString[GTtmp1];
					GTtmp4=GTtmp4<>" Gu[["<>ToString[getind[tind[[GTtmp1,1]]]]<>", tmpind"<>ToString[GTtmp1]<>"]] ";
					GTtmp5=GTtmp5<>",{tmpind"<>ToString[GTtmp1]<>",1,Nind}"),
				d,
				(GTtmp3=GTtmp3<>","<>"tmpind"<>ToString[GTtmp1];
					GTtmp4=GTtmp4<>" Gd[["<>ToString[getind[tind[[GTtmp1,1]]]]<>", tmpind"<>ToString[GTtmp1]<>"]] ";
					GTtmp5=GTtmp5<>",{tmpind"<>ToString[GTtmp1]<>",1,Nind}";)];
			,{GTtmp1,1,Length[t1[[1]]]}];If[GTtmp4===""&&GTtmp5==="",ToExpression["GTtmp6[[2"<>GTtmp3<>"]]"],ToExpression["Sum[GTtmp6[[2"<>GTtmp3<>"]]"<>GTtmp4<>GTtmp5<>"]"]])

Trace, Outer Product and Covariant Derivative! - GREinstein.nb

Syntax:   trT[tensor,{{1,4},{2,3}}]   -  ie. contract 1 and 4 plus 2 and 3 positions

trT[t1_,lst_]:=(

dimt1=Length[Dimensions[t1[[2]]]];
tmpt1=t1;
Clear[tracetmp];

If[dimt1===2,

tracetmp=Sum[GT[tmpt1,{{s1,d},{s1,u}}],{s1,1,Nind}];

,

MT[tracetmp,dimt1-2Length[lst],Table[d,{ii,1,dimt1-2Length[lst]}]];

tmpstring1="";tmpstring2="";tmpstring3="";

Do[

If[{}===Position[lst,indno],
tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";
tmpstring3=tmpstring3<>"{i"<>ToString[indno]<>",1,Nind},";
];

tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",d},";

,{indno,1,dimt1}];

tmpstring4="";

Do[

tmpstring4=tmpstring4<>"{s"<>ToString[indno]<>",1,Nind},";

tmpstring2=StringReplace[tmpstring2,"i"<>ToString[lst[[indno,1]]]->"s"<>ToString[indno]];

tmpstring2=StringReplace[tmpstring2,"i"<>ToString[lst[[indno,2]]]<>",d}"->"s"<>ToString[indno]<>",u}"];

,{indno,1,Length[lst]}];

tmpeval="Do[tracetmp=ST[tracetmp,{"<>StringDrop[tmpstring1,-1]<>"},Sum[GT[tmpt1,{"<>StringDrop[tmpstring2,-1]<>"}],"<>StringDrop[tmpstring4,-1]<>"]],"<>StringDrop[tmpstring3,-1]<>"]";

ToExpression[tmpeval];

];

tracetmp
)

Syntax:   outerT[tensor1,tensor2]

outerT[t1_,t2_]:=(

dimt1=Length[Dimensions[t1[[2]]]];dimt2=Length[Dimensions[t2[[2]]]];
tmpt1=t1;tmpt2=t2;
Clear[outertmp];

MT[outertmp,dimt1+dimt2,Table[d,{ii,1,dimt1+dimt2}]];

tmpstring1="";tmpstring2="";

Do[

tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";
tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt1}];

tmpstring3="";tmpstring4="";

Do[

tmpstring3=tmpstring3<>"{j"<>ToString[indno]<>",d},";
tmpstring4=tmpstring4<>"{j"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt2}];

tmpeval="Do[outertmp=ST[outertmp,{"<>tmpstring1<>StringDrop[tmpstring3,-1]<>"},GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}]GT[tmpt2,{"<>StringDrop[tmpstring3,-1]<>"}]],"<>tmpstring2<>StringDrop[tmpstring4,-1]<>"]";

ToExpression[tmpeval];

outertmp

)

scalarDT[t1_]:=(

tmpt1=t1;
Clear[covDTtmp];
MT[covDTtmp,1,{d}];

tmpeval="Do[covDTtmp=ST[covDTtmp,{{i1,d}},D[tmpt1,ind[[i1]]]],{i1,1,Nind}]";

ToExpression[tmpeval];

covDTtmp

)

covDT[t1_]:=(

dimt1=Length[Dimensions[t1[[2]]]];
tmpt1=t1;
Clear[covDTtmp];
MT[covDTtmp,dimt1+1,Table[d,{ii,1,dimt1+1}]];

(* Build expression *)

tmpstring1="";tmpstring2="";tmpstring3="";

Do[

tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";

tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt1}];

Do[
tmpstring4="-Sum[GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}]GT[Γ,{{REPL,d},{s1,d},{s2,u}}],{s2,1,Nind}]";

tmpstring4=StringReplace[tmpstring4,"i"<>ToString[indno]-> "s2"];

tmpstring4=StringReplace[tmpstring4,"REPL"->"i"<>ToString[indno]];

tmpstring3=tmpstring3<>tmpstring4;

,{indno,1,dimt1}];

tmpeval="Do[covDTtmp=ST[covDTtmp,{"<>tmpstring1<>"{s1,d}},D[GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}],ind[[s1]]]"<>tmpstring3<>"],"<>tmpstring2<>"{s1,1,Nind}]";


ToExpression[tmpeval];

covDTtmp

);

.

Buildmetric

Gd=(({{-Exp[2f[r]], 0, 0, 0}, {0, (1/(1-m[r]/r)), 0, 0}, {0, 0, r^2, 0}, {0, 0, 0, r^2 Sin[θ]^2}}))

ind={t,r,θ,ϕ}

Nind=Length[ind]

BuildMetric;

Gd

Gu

detg=Simplify[Det[Gd]]

GRrun2.nb

Clear[Γ]

MT[Γ,3,{d,d,u}];

Clear[R4]

MT[R4,4,{d,d,d,u}];

Clear[R2]

MT[R2,2,{d,d}];

Clear[G2]

MT[G2,2,{d,d}];

Do[Γ=ST[Γ,{{ind[[i1]],d},{ind[[i2]],d},{ind[[i3]],u}},Sum[(1/2)GT[G,{{ind[[i3]],u},{ind[[ss1]],u}}](D[GT[G,{{ind[[i1]],d},{ind[[ss1]],d}}],ind[[i2]]]+D[GT[G,{{ind[[ss1]],d},{ind[[i2]],d}}],ind[[i1]]]-D[GT[G,{{ind[[i1]],d},{ind[[i2]],d}}],ind[[ss1]]]),{ss1,1,Nind}]],{i1,1,Nind},{i2,1,Nind},{i3,1,Nind}]

(* FullSimplify[Γ] *)

Γ=FullSimplify[Γ];

Do[
	R4=ST[R4,
			{{ind[[i1]],d},{ind[[i2]],d},{ind[[i3]],d},{ind[[i4]],u}},
	
			D[GT[Γ,{{ind[[i1]],d},{ind[[i3]],d},{ind[[i4]],u}}],ind[[i2]]]-D[GT[Γ,{{ind[[i2]],d},{ind[[i3]],d},{ind[[i4]],u}}],ind[[i1]]]+
			Sum[GT[Γ,{{ind[[i1]],d},{ind[[i3]],d},{ind[[ss1]],u}}]GT[Γ,{{ind[[i2]],d},{ind[[ss1]],d},{ind[[i4]],u}}]-GT[Γ,{{ind[[i2]],d},{ind[[i3]],d},{ind[[ss1]],u}}]GT[Γ,{{ind[[i1]],d},{ind[[ss1]],d},{ind[[i4]],u}}],{ss1,1,Nind}]
		
		]
		,
	{i1,1,Nind},{i2,1,Nind},{i3,1,Nind},{i4,1,Nind}]

(* FullSimplify[R4] *)

Do[R2=ST[R2,
			{{ind[[i1]],d},{ind[[i2]],d}},
			Sum[GT[R4,{{ind[[i1]],d},{ind[[ss1]],u},{ind[[i2]],d},{ind[[ss1]],d}}],{ss1,1,Nind}]
		]
	,{i1,1,Nind},{i2,1,Nind}]

(* FullSimplify[R2] *)

Ricci=Sum[GT[R2,{{ind[[ss1]],u},{ind[[ss1]],d}}],{ss1,1,Nind}];

Do[G2=ST[G2,
			{{ind[[i1]],d},{ind[[i2]],d}},
			GT[R2,{{ind[[i1]],d},{ind[[i2]],d}}]-(1/2)GT[G,{{ind[[i1]],d},{ind[[i2]],d}}]Ricci]
	,{i1,1,Nind},{i2,1,Nind}]

(* FullSimplify[G2] *)

(* FullSimplify[Ricci] *)

Einstein equations

FullSimplify[R2]

tmp1=FullSimplify[GT[R2,{{t,u},{t,d}}]]

tmp2=FullSimplify[GT[R2,{{r,u},{r,d}}]]

tmp3=Expand[FullSimplify[GT[R2,{{θ,u},{θ,d}}]]]

Expand[FullSimplify[GT[R2,{{ϕ,u},{ϕ,d}}]]]

a1=Simplify[Coefficient[tmp1,f''[r]]]

a2=Simplify[Coefficient[tmp1,f'[r]]]

a3=Simplify[Coefficient[tmp1,f'[r]^2]]

a4=Simplify[tmp1-{a1,a2,a3}.{f''[r],f'[r],f'[r]^2}]

b1=Simplify[Coefficient[tmp2,f''[r]]]

b2=Simplify[Coefficient[tmp2,f'[r]]]

b3=Simplify[Coefficient[tmp2,f'[r]^2]]

b4=Simplify[tmp2-{b1,b2,b3}.{f''[r],f'[r],f'[r]^2}]

c1=Simplify[Coefficient[tmp3,f''[r]]]

c2=Simplify[Coefficient[tmp3,f'[r]]]

c3=Simplify[Coefficient[tmp3,f'[r]^2]]

c4=Simplify[tmp3-{c1,c2,c3}.{f''[r],f'[r],f'[r]^2}]

Simplify[a1-(1/2)(a1+b1+2 c1)]

Simplify[a2-(1/2)(a2+b2+2 c2)]

Simplify[a3-(1/2)(a3+b3+2 c3)]

Simplify[a4-(1/2)(a4+b4+2 c4)]

Simplify[b1-(1/2)(a1+b1+2 c1)]

Simplify[b2-(1/2)(a2+b2+2 c2)]

Simplify[b3-(1/2)(a3+b3+2 c3)]

Simplify[b4-(1/2)(a4+b4+2 c4)]

FullSimplify[G2]

v={{u},{T[r],0,0,0}};

Simplify[trT[outerT[v,v],{{1,2}}]]

v={{u},{(1/(Exp[f[r]])),0,0,0}};

Simplify[trT[outerT[v,v],{{1,2}}]]

T2=Simplify[{{d,d},ρ[r]outerT[v,v][[2]]+P[r](Gd+outerT[v,v][[2]])}]

tmp=Simplify[trT[covDT[T2],{{2,3}}]]

Simplify[Solve[Simplify[G2[[2,1,1]]==8 π Gn T2[[2,1,1]]],m'[r]][[1]]]

Simplify[Solve[Simplify[G2[[2,2,2]]==8 π Gn T2[[2,2,2]]],f'[r]][[1]]]

Question B2

Print["hmm"]

GRSetup2.nb - modified

(* Latest Version *)

metric={gtt,grr,gθθ,gϕϕ,gzz}

Gd=DiagonalMatrix[metric]

Gd[[1,2]]=grt

Gd[[2,1]]=grt

BuildMetric:=(Gu=FullSimplify[Inverse[Gd]];G={{u,d},IdentityMatrix[Nind]};)

BuildMetric

ind={t,r,θ,ϕ,z}

Nind=Length[ind]

getind[i1_]:=(If[IntegerQ[i1],i1,Position[ind,i1][[1,1]]])

lstind[i1_]:=(lsttmp2={};Do[AppendTo[lsttmp2,getind[i1[[lsttmp1,1]]]],{lsttmp1,1,Length[i1]}];lsttmp2)

up[i1_,i2_]:=(lsttmp2={};Do[AppendTo[lsttmp2,If[i1[[lsttmp1,2]]=!=i2[[lsttmp1]],If[i1[[lsttmp1,2]]===d,d,u],0]],{lsttmp1,1,Length[i1]}];lsttmp2)

MT[t1_,dim_,indpos_]:=(MTtmp1=0;If[Length[indpos]=!=dim,Print["Error in index position"]];Do[MTtmp1=Table[MTtmp1,{MTtmp3,1,Nind}],{MTtmp2,1,dim}];t1={indpos,MTtmp1})

ST[t1_,tind_,val_]:=(STtmp1=t1;If[up[tind,t1[[1]]]=!=Table[0,{Length[tind]}],Print["Error in Index Assignment!!"];];STtmp1[[2]]=ReplacePart[t1[[2]],val,lstind[tind]];STtmp1)

Edited the expression below as 7.0 seems to complain about Sum[x] whereas 6.0 would just return x (ie. if there is no sum index!)

GT[t1_,tind_]:=(GTtmp2=up[tind,t1[[1]]];GTtmp3="";GTtmp4="";GTtmp5="";GTtmp6=t1;
		Do[
			Switch[GTtmp2[[GTtmp1]],
				0,
				(GTtmp3=GTtmp3<>","<>ToString[getind[tind[[GTtmp1,1]]]];),
				u,
				(GTtmp3=GTtmp3<>","<>"tmpind"<>ToString[GTtmp1];
					GTtmp4=GTtmp4<>" Gu[["<>ToString[getind[tind[[GTtmp1,1]]]]<>", tmpind"<>ToString[GTtmp1]<>"]] ";
					GTtmp5=GTtmp5<>",{tmpind"<>ToString[GTtmp1]<>",1,Nind}"),
				d,
				(GTtmp3=GTtmp3<>","<>"tmpind"<>ToString[GTtmp1];
					GTtmp4=GTtmp4<>" Gd[["<>ToString[getind[tind[[GTtmp1,1]]]]<>", tmpind"<>ToString[GTtmp1]<>"]] ";
					GTtmp5=GTtmp5<>",{tmpind"<>ToString[GTtmp1]<>",1,Nind}";)];
			,{GTtmp1,1,Length[t1[[1]]]}];If[GTtmp4===""&&GTtmp5==="",ToExpression["GTtmp6[[2"<>GTtmp3<>"]]"],ToExpression["Sum[GTtmp6[[2"<>GTtmp3<>"]]"<>GTtmp4<>GTtmp5<>"]"]])

Trace, Outer Product and Covariant Derivative! - GREinstein.nb

Syntax:   trT[tensor,{{1,4},{2,3}}]   -  ie. contract 1 and 4 plus 2 and 3 positions

trT[t1_,lst_]:=(

dimt1=Length[Dimensions[t1[[2]]]];
tmpt1=t1;
Clear[tracetmp];

If[dimt1===2,

tracetmp=Sum[GT[tmpt1,{{s1,d},{s1,u}}],{s1,1,Nind}];

,

MT[tracetmp,dimt1-2Length[lst],Table[d,{ii,1,dimt1-2Length[lst]}]];

tmpstring1="";tmpstring2="";tmpstring3="";

Do[

If[{}===Position[lst,indno],
tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";
tmpstring3=tmpstring3<>"{i"<>ToString[indno]<>",1,Nind},";
];

tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",d},";

,{indno,1,dimt1}];

tmpstring4="";

Do[

tmpstring4=tmpstring4<>"{s"<>ToString[indno]<>",1,Nind},";

tmpstring2=StringReplace[tmpstring2,"i"<>ToString[lst[[indno,1]]]->"s"<>ToString[indno]];

tmpstring2=StringReplace[tmpstring2,"i"<>ToString[lst[[indno,2]]]<>",d}"->"s"<>ToString[indno]<>",u}"];

,{indno,1,Length[lst]}];

tmpeval="Do[tracetmp=ST[tracetmp,{"<>StringDrop[tmpstring1,-1]<>"},Sum[GT[tmpt1,{"<>StringDrop[tmpstring2,-1]<>"}],"<>StringDrop[tmpstring4,-1]<>"]],"<>StringDrop[tmpstring3,-1]<>"]";

ToExpression[tmpeval];

];

tracetmp
)

Syntax:   outerT[tensor1,tensor2]

outerT[t1_,t2_]:=(

dimt1=Length[Dimensions[t1[[2]]]];dimt2=Length[Dimensions[t2[[2]]]];
tmpt1=t1;tmpt2=t2;
Clear[outertmp];

MT[outertmp,dimt1+dimt2,Table[d,{ii,1,dimt1+dimt2}]];

tmpstring1="";tmpstring2="";

Do[

tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";
tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt1}];

tmpstring3="";tmpstring4="";

Do[

tmpstring3=tmpstring3<>"{j"<>ToString[indno]<>",d},";
tmpstring4=tmpstring4<>"{j"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt2}];

tmpeval="Do[outertmp=ST[outertmp,{"<>tmpstring1<>StringDrop[tmpstring3,-1]<>"},GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}]GT[tmpt2,{"<>StringDrop[tmpstring3,-1]<>"}]],"<>tmpstring2<>StringDrop[tmpstring4,-1]<>"]";

ToExpression[tmpeval];

outertmp

)

scalarDT[t1_]:=(

tmpt1=t1;
Clear[covDTtmp];
MT[covDTtmp,1,{d}];

tmpeval="Do[covDTtmp=ST[covDTtmp,{{i1,d}},D[tmpt1,ind[[i1]]]],{i1,1,Nind}]";

ToExpression[tmpeval];

covDTtmp

)

covDT[t1_]:=(

dimt1=Length[Dimensions[t1[[2]]]];
tmpt1=t1;
Clear[covDTtmp];
MT[covDTtmp,dimt1+1,Table[d,{ii,1,dimt1+1}]];

(* Build expression *)

tmpstring1="";tmpstring2="";tmpstring3="";

Do[

tmpstring1=tmpstring1<>"{i"<>ToString[indno]<>",d},";

tmpstring2=tmpstring2<>"{i"<>ToString[indno]<>",1,Nind},";

,{indno,1,dimt1}];

Do[
tmpstring4="-Sum[GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}]GT[Γ,{{REPL,d},{s1,d},{s2,u}}],{s2,1,Nind}]";

tmpstring4=StringReplace[tmpstring4,"i"<>ToString[indno]-> "s2"];

tmpstring4=StringReplace[tmpstring4,"REPL"->"i"<>ToString[indno]];

tmpstring3=tmpstring3<>tmpstring4;

,{indno,1,dimt1}];

tmpeval="Do[covDTtmp=ST[covDTtmp,{"<>tmpstring1<>"{s1,d}},D[GT[tmpt1,{"<>StringDrop[tmpstring1,-1]<>"}],ind[[s1]]]"<>tmpstring3<>"],"<>tmpstring2<>"{s1,1,Nind}]";


ToExpression[tmpeval];

covDTtmp

);

.

Buildmetric

Gd=(({{-1, 0, 0, 0}, {0, a[t]^2, 0, 0}, {0, 0, a[t]^2, 0}, {0, 0, 0, a[t]^2}}))

ind={t,x,y,z}

Nind=Length[ind]

BuildMetric;

Gd

Gu

detg=Simplify[Det[Gd]]

GRrun2.nb

Clear[Γ]

MT[Γ,3,{d,d,u}];

Clear[R4]

MT[R4,4,{d,d,d,u}];

Clear[R2]

MT[R2,2,{d,d}];

Clear[G2]

MT[G2,2,{d,d}];

Do[Γ=ST[Γ,{{ind[[i1]],d},{ind[[i2]],d},{ind[[i3]],u}},Sum[(1/2)GT[G,{{ind[[i3]],u},{ind[[ss1]],u}}](D[GT[G,{{ind[[i1]],d},{ind[[ss1]],d}}],ind[[i2]]]+D[GT[G,{{ind[[ss1]],d},{ind[[i2]],d}}],ind[[i1]]]-D[GT[G,{{ind[[i1]],d},{ind[[i2]],d}}],ind[[ss1]]]),{ss1,1,Nind}]],{i1,1,Nind},{i2,1,Nind},{i3,1,Nind}]

(* FullSimplify[Γ] *)

Γ=FullSimplify[Γ];

Do[
	R4=ST[R4,
			{{ind[[i1]],d},{ind[[i2]],d},{ind[[i3]],d},{ind[[i4]],u}},
	
			D[GT[Γ,{{ind[[i1]],d},{ind[[i3]],d},{ind[[i4]],u}}],ind[[i2]]]-D[GT[Γ,{{ind[[i2]],d},{ind[[i3]],d},{ind[[i4]],u}}],ind[[i1]]]+
			Sum[GT[Γ,{{ind[[i1]],d},{ind[[i3]],d},{ind[[ss1]],u}}]GT[Γ,{{ind[[i2]],d},{ind[[ss1]],d},{ind[[i4]],u}}]-GT[Γ,{{ind[[i2]],d},{ind[[i3]],d},{ind[[ss1]],u}}]GT[Γ,{{ind[[i1]],d},{ind[[ss1]],d},{ind[[i4]],u}}],{ss1,1,Nind}]
		
		]
		,
	{i1,1,Nind},{i2,1,Nind},{i3,1,Nind},{i4,1,Nind}]

(* FullSimplify[R4] *)

Do[R2=ST[R2,
			{{ind[[i1]],d},{ind[[i2]],d}},
			Sum[GT[R4,{{ind[[i1]],d},{ind[[ss1]],u},{ind[[i2]],d},{ind[[ss1]],d}}],{ss1,1,Nind}]
		]
	,{i1,1,Nind},{i2,1,Nind}]

(* FullSimplify[R2] *)

Ricci=Sum[GT[R2,{{ind[[ss1]],u},{ind[[ss1]],d}}],{ss1,1,Nind}];

Do[G2=ST[G2,
			{{ind[[i1]],d},{ind[[i2]],d}},
			GT[R2,{{ind[[i1]],d},{ind[[i2]],d}}]-(1/2)GT[G,{{ind[[i1]],d},{ind[[i2]],d}}]Ricci]
	,{i1,1,Nind},{i2,1,Nind}]

(* FullSimplify[G2] *)

(* FullSimplify[Ricci] *)

Einstein equations

FullSimplify[Γ]

trT[covDT[scalarDT[ϕ[t]]],{{1,2}}]

FullSimplify[R2]

FullSimplify[G2]

eq=((3 ((a'[t])^2))/((a[t])^2))==8π Gn(1/2)V

FullSimplify[DSolve[eq,a[t],t]]