双曲放物面上での平行移動

§1.計量tensor, 接続係数, Rieman tensor,曲率R, Einstein tensor

ClearAll["Global`*"]
o={0,0,0};
x=u;y=v;z=u^2-v^2;

eu={D[x,u],D[y,u],D[z,u]};
ev={D[x,v],D[y,v],D[z,v]};

g11=eu.eu;
g12=g21=eu.ev;
g22=ev.ev;
g={{g11,g12},{g21, g22}}//Simplify;
h=Inverse[g];
MatrixForm[g]
MatrixForm[h]
var={u,v};
cris[i_,j_,k_]:=1/2Sum[h[[i,m]](D[g[[m,j]],var[[k]]]+D[g[[m,k]],var[[j]]]-D[g[[j,k]],var[[m]]]),{m,2}]//Simplify

Table[cris[i,j,k],{i,1,2},{j,1,2},{k,1,2}]
Table[{i,j,k},{i,1,2},{j,1,2},{k,1,2}]

rieman[i_,j_,k_,l_]:=D[cris[i,j,l],var[[ k]]]-D[cris[i,j,k],var[[ l]]]+Sum[cris[i,m,k] cris[m,j,l]-cris[i,m,l]cris[m,j,k],{m,1,2}]//FullSimplify
Table[rieman[i,j,k,l],{i,1,2},{j,1,2},{k,1,2},{l,1,2}]
Table[{i,j,k,l},{i,1,2},{j,1,2},{k,1,2},{l,1,2}]

ricci[j_,l_]:=Sum[rieman[i,j,i,l],{i,1,2}];
Ricci=Table[ricci[i,j],{j,1,2},{i,1,2}]//FullSimplify;
MatrixForm[%]
R=Sum[h[[i,j]]ricci[i,j],{i,1,2},{j,1,2}]//FullSimplify
Ricci-1/2 R g//FullSimplify//MatrixForm

§2. 平行移動の微分方程式を解く

(*((dA^1)/(dx^2))=-(Subscript[(Γ^1), 12])(A^1)-(Subscript[(Γ^1), 22])(A^2),((dA^2)/(dx^2))=-(Subscript[(Γ^2), 12])(A^1)-(Subscript[(Γ^2), 22])(A^2)*)
ClearAll["Global`*"]
soluconst=DSolve[{y1'[v]==4 u/(1+4 u^2+4 v^2) y2[v],
y2'[v]==-4 v/(1+4 u^2+4 v^2) y2[v],y1[0]==n,y2[0]==m},{y1[v],y2[v]},v];
FullSimplify[%]
(*u=一定で vを変化させるとき*)

ClearAll["Global`*"]
(*((dA^1)/(dx^1))=-(Subscript[(Γ^1), 11])(A^1)-(Subscript[(Γ^1), 21])(A^2),((dA^2)/(dx^1))=-(Subscript[(Γ^2), 11])(A^1)-(Subscript[(Γ^2), 21])(A^2)*)
solvconst=DSolve[{y1'[u]==-4 u/(1+4 u^2+4 v^2) y1[u],
y2'[u]==4 v/(1+4 u^2+4 v^2) y1[u],y1[0]==n,y2[0]==m},{y1[u],y2[u]},u];
FullSimplify[%](*v=一定で uを変化させるとき*)

§3. u=(Subscript[u, 0])(一定)で vを動かすとき， ((A^u),(A^v))ベクトルの平行移動

ClearAll["Global`*"]
s=ParametricPlot3D[{u,v,u^2-v^2},{u,-1,1},{v,-1,1},Mesh->{7},MeshStyle->Dashed];
meridian0=ParametricPlot3D[{u,0,u^2},{u,-1,1}];
equator=ParametricPlot3D[{0,v,-v^2},{v,-1,1}];

Manipulate[
cord={u,v,u^2-v^2};eu={1,0,2 u};ev={0,1,-2 v};
p=Point[{u,v,u^2-v^2}];
e1=Arrow[{cord,cord+1/4 eu}];
e2=Arrow[{cord,cord+1/4 ev}];
a1:= n+((4 m u v)/((Sqrt[1+4 (u^2)]) (Sqrt[1+4 (u^2)+4 (v^2)])));
a2:=((m (Sqrt[1+4 (u^2)]))/(Sqrt[1+4 (u^2)+4 (v^2)]));
r=Sqrt[(a1 eu+a2 ev).(a1 eu+a2 ev)]//N;
vec1:=Arrow[{cord,cord+1/4(a1 eu+ a2 ev)}];
Show[{Graphics3D[{PointSize[0.02],Red,p, Green,Thick,e1,Red,e2,Blue,vec1},Boxed->False],s,meridian0,equator}],
Dynamic[Graphics [{
Text[Style["uを一定にし vを変化",12,Bold],{0,0.5}],
Text[Style["させた時の平行移動.",12,Bold],{-0.,0.3}],
Text[Style["(A^u),(A^v)は,v=0の時の値.",12,Bold],{0,0.1}],
Text[Style["vector は 1/4倍で表示.",12,Bold],{0,-0.1}]}]],Delimiter,{{u,0,"(Subscript[u, 0])"},-1,1},{{n,1,"(A^u)"},-2,2},{{m,1,"(A^v)"},-2,2},{{v,0},-1,1},Delimiter,
Dynamic[Graphics [{Text[Style["現在: (Overscript[p, ⟶])=(X^u)(Overscript[(Subscript[e, u]), ⟶])+(X^v)(Overscript[(Subscript[e, v]), ⟶])",12,Bold,Blue],{0.5,0.5},Center],
Text[Style["(X^u)="<>ToString[Round[a1*100]*0.01]<>"　　(X^v)="<>ToString[Round[a2*100]*0.01],13,Bold,Blue],{0.5,0.3}],
Text[Style["|(Overscript[p, ⟶])|="<>ToString[Round[r*1000]*0.001],13,Bold,Blue],{0.5,0.15},Right]
}]],SaveDefinitions->True,
ControlPlacement->Left]

§4. v=(Subscript[v, 0])(一定)で uを動かすとき， ((A^u),(A^v))ベクトルの平行移動

ClearAll["Global`*"]
s=ParametricPlot3D[{u,v,u^2-v^2},{u,-1,1},{v,-1,1},Mesh->{7},MeshStyle->Dashed];
meridian0=ParametricPlot3D[{u,0,u^2},{u,-1,1}];
equator=ParametricPlot3D[{0,v,-v^2},{v,-1,1}];

Manipulate[
cord={u,v,u^2-v^2};eu={1,0,2 u};ev={0,1,-2 v};
p=Point[{u,v,u^2-v^2}];
e1=Arrow[{cord,cord+1/4 eu}];
e2=Arrow[{cord,cord+1/4 ev}];
b1=((n (Sqrt[1+4 (v^2)]))/(Sqrt[1+4 (u^2)+4 (v^2)]));
b2=m+((4 n u v)/((Sqrt[1+4 (v^2)]) (Sqrt[1+4 (u^2)+4 (v^2)])));
vec2=Arrow[{cord,cord+1/4(b1 eu+b2 ev)}];
r=Sqrt[(b1 eu+b2 ev).(b1 eu+b2 ev)]//N;
Show[{Graphics3D[{PointSize[0.02],Red,p, Green,Thick,e1,Red,e2,Blue,vec2},Boxed->False],s,meridian0,equator}],

Dynamic[Graphics [{
Text[Style["vを一定にし uを変化",12,Bold],{0,0.5}],
Text[Style["させた時の平行移動.",12,Bold],{-0.,0.3}],
Text[Style["(A^u),(A^v)は,u=0の時の値.",12,Bold],{0,0.1}],
Text[Style["vector は 1/4倍で表示.",12,Bold],{0,-0.1}]}]],Delimiter
,{{v,0,"(Subscript[v, 0])"},-1,1},{{n,1,"(A^1)"},-2,2},{{m,1,"(A^2)"},-2,2},{{u,0},-1,1},
Delimiter,
Dynamic[Graphics [{
Text[Style["現在: (Overscript[p, ⟶])=(X^u)(Overscript[(Subscript[e, u]), ⟶])+(X^v)(Overscript[(Subscript[e, v]), ⟶])",12,Bold,Blue],{0.5,0.5},Center],
Text[Style["(X^u)="<>ToString[Round[b1*100]*0.01]<>"　　(X^v)="<>ToString[Round[b2*100]*0.01],13,Bold,Blue],{0.5,0.3}],
Text[Style["|(Overscript[p, ⟶])|="<>ToString[Round[r*1000]*0.001],13,Bold,Blue],{0.5,0.15},Right]
}]],SaveDefinitions->True,
ControlPlacement->Left]