Exercises lecture 4

ClearAll["Global`*"];SetDirectory[NotebookDirectory[]]

Exercise 1: Consider this list of points on a plane: points= {{1,6},{4,1.5},{0.5,2.5},{3,3},{1,5}}. Find by trying out systematically all permutations of the points the minimal path that starts from the origin, touches all the points once and comes back to the origin.
Check your result by using the built-in function  FindShortestTour. Plot the resulting path through the points.

points= {{1,6},{4,1.5},{0.5,2.5},{3,3},{1,5}};
distance[p1_,p2_]:=Sqrt[(p1[[1]]-p2[[1]])^2+(p1[[2]]-p2[[2]])^2];

newmod[a_,b_]=If[Mod[a,b]==0,b,Mod[a,b]];
np=Length[points];
list=Permutations[points];
len=Length[list];tour={};
start={0,0};Do[AppendTo[tour,distance[start,list[[i,1]]]+Sum[distance[list[[i,j]],list[[i,j+1]]],{j,np-1}]+distance[list[[i,np]],start]],{i,len}]
len
minpath=Min[tour]
pos=Flatten[Position[tour,minpath]]
Table[list[[pos[[i]]]],{i,Length[pos]}]

tour1=FindShortestTour[Join[{start},points]]
tour1[[2]]

full=Join[{start},points,{start}];fullbest=Table[full[[tour1[[2,i]]]],{i,Length[full]}]

ListPlot[fullbest,Joined->True]

Exercise 2: Find the Ricci scalar for 3D spatial non-flat metric. You can use either the metric in Cartesian form

Clear[metric];
metric:=DiagonalMatrix[
a^2*{1,1,1}/(1+k/4*(x^2+y^2+z^2))^2]

coord={x,y,z};

or in spherical form

Clear[metric];
metric:=DiagonalMatrix[
a^2*{1/(1-k*r^2),r^2,r^2*Sin[theta]^2}]

coord={r,theta,phi};

Clear[metric];
metric:=DiagonalMatrix[
a^2*{1,1,1}/(1+k/4*(x^2+y^2+z^2))^2]

coord={x,y,z};

raise[metric_, s_] := Inverse[metric] . s;
lower[metric_, s_] := metric . s;
Clear[grad]; grad[s_List, var_] := Outer[D, s, var];

Clear[gradScal]; gradScal[s_, var_] := Map[D[s, #] &, var]


div[s_, var_] := Inner[D, s, var, Plus];

Clear[christoffel]; christoffel[metric_, var_] := Inverse[metric] . (grad[metric, var] +
     			Transpose[grad[metric, var], {1, 3, 2}] - Transpose[grad[metric, var], {2, 3, 1}])/2
     			
chrContracted[metric_, var_] := gradScal[Log[(-Det[metric])^(1/2)], var]
     			

Clear[ricci]; ricci[metric_, var_] :=
 div[Transpose[christoffel[metric, var], {3, 2, 1}], var] - grad[chrContracted[metric, var], var] +
  		chrContracted[metric, var] . christoffel[metric, var] -
  		Table[Sum[(christoffel[metric, var] . christoffel[metric, var])[[i, j, kk, i]],
    				{i, Length[var]}], {j, Length[var]}, {kk, Length[var]}]
		
    				
Simplify[Tr[raise[metric, ricci[metric, coord]]]]

Clear[metric];
metric:=DiagonalMatrix[
a^2*{1/(1-k*r^2),r^2,r^2*Sin[theta]^2}]

coord={r,theta,phi};

raise[metric_, s_] := Inverse[metric] . s;
lower[metric_, s_] := metric . s;
Clear[grad]; grad[s_List, var_] := Outer[D, s, var];

Clear[gradScal]; gradScal[s_, var_] := Map[D[s, #] &, var]


div[s_, var_] := Inner[D, s, var, Plus];

Clear[christoffel]; christoffel[metric_, var_] := Inverse[metric] . (grad[metric, var] +
     			Transpose[grad[metric, var], {1, 3, 2}] - Transpose[grad[metric, var], {2, 3, 1}])/2
     			
chrContracted[metric_, var_] := gradScal[Log[(-Det[metric])^(1/2)], var]
     			

Clear[ricci]; ricci[metric_, var_] :=
 div[Transpose[christoffel[metric, var], {3, 2, 1}], var] - grad[chrContracted[metric, var], var] +
  		chrContracted[metric, var] . christoffel[metric, var] -
  		Table[Sum[(christoffel[metric, var] . christoffel[metric, var])[[i, j, kk, i]],
    				{i, Length[var]}], {j, Length[var]}, {kk, Length[var]}]
		
    				
Simplify[Tr[raise[metric, ricci[metric, coord]]]]