Gauss-Bonnetの定理の検証(双曲放物面上)

§1.計量tensor, 接続係数, Rieman tensor,スカラー曲率Rの計算

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;(*metric tensor*)
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(*Cristoffel symbol*)

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
(*Rieman tensor*)
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(*Ricci Tensor*)
MatrixForm[%]
R=Sum[h[[i,j]]ricci[i,j],{i,1,2},{j,1,2}]//FullSimplify(*スカラー曲率*)

§2. 曲率の積分（∫Kd(θ^1)∧d(θ^2)）の計算

ClearAll["Global`*"];
a=1;b=1;p=0;q=0;(*楕円(((u-p))^2)/(a^2)+(((v-q))^2)/(b^2)=1*)

eu={1,0,2 u};ev={0,1,-2 v};
g={{eu.eu,eu.ev},{ev.eu, ev.ev}}//Simplify;
h=Inverse[g]

dS=Sqrt[Det[g]]；(*面積要素*)
K=-(4/(((1+4 (u^2)+4 (v^2)))^2));(*「スカラー曲率」の1/2*)
int1=Integrate[K*dS,{v,-b Sqrt[1-(u-p)^2/a^2]+q,b Sqrt[1-(u-p)^2/a^2]+q},Assumptions->-a+p<=u<=a+p];
int2=Integrate[int1,{u,-a+p,a+p}]
square=%//N  (*square=∫K\[DifferentialD](θ^1)∧\[DifferentialD](θ^2)=∫(K\[DifferentialD]S)du∧\[DifferentialD]v*)

§3. 測地的曲率の線積分（∫(Subscript[k, g])ds）の計算

ClearAll[u,v];
a=1;b=1;p=0;q=0;
u[t_]=p+a Cos[t];
v[t_]=q+b Sin[t];
Cord[t_]={u[t],v[t],u[t]^2-v[t]^2};
e0[t_]=D[Cord[t],t];
e[t_]=e0[t]/Norm[e0[t]];(*接単位ベクトル*)


s=ParametricPlot3D[{u,v,u^2-v^2},{u,-1,1},{v,-1,1},Mesh->{7},MeshStyle->Dashed,PlotStyle->Opacity[0.5]];
meridian0=ParametricPlot3D[{u,0,u^2},{u,-1,1}];
equator=ParametricPlot3D[{0,v,-v^2},{v,-1,1}];
dT=2Pi/20;(*tの分割幅*)
es=Table[Arrow[{Cord[i],Cord[i]+1/4*e[i]}],{i,0,2Pi,dT}];(*接単位ベクトルの集合*)
trace=ParametricPlot3D[Cord[t],{t,0,2Pi}];
Eu[t_]={1,0,2 u[t]};
Ev[t_]={0,1,-2 v[t]};
covariants[t_]={Eu[t].e[t],Ev[t].e[t]};(*接単位ベクトルe[t]の共変成分*)
g={{Eu[t].Eu[t],Eu[t].Ev[t]},{Ev[t].Eu[t], Ev[t].Ev[t]}}//Simplify;
h=Inverse[g];
Au[t_]=Sum[h[[1,k]]*covariants[t][[k]],{k,1,2}];(*接単位ベクトルe[t]の反変成分*)
Av[t_]=Sum[h[[2,k]]*covariants[t][[k]],{k,1,2}];
ep[t_]=Au[t]Eu[t]+Av[t]Ev[t];


Bu[t_]=Au[t]+dT*(-4u[t] /(1+4 u[t]^2+4 v[t]^2) (-a Sin[t])Au[t]
+4u[t] /(1+4 u[t]^2+4 v[t]^2) (b Cos[t])Av[t]);(*e[t]を(du,dv)平行移動したベクトルee[t]のeu成分*)

Bv[t_]=Av[t]+dT*(4v[t] /(1+4 u[t]^2+4 v[t]^2) (-a Sin[t])Au[t]
-4v[t] /(1+4 u[t]^2+4 v[t]^2) (b Cos[t])Av[t]);
ee[t_]=Bu[t]Eu[t+dT]+Bv[t]Ev[t+dT];(*e[t]を(du,dv)平行移動したベクトル*)

esp=Table[Arrow[{Cord[i+dT],Cord[i+dT]+1/4*ee[i]}],{i,0,2Pi-dT,dT}];
dK[i_]=ArcCos[ee[i].e[i+dT]/Norm[ee[i]]]//N;
totalK=Sum[dK[i],{i,0,2Pi-dT,dT}]
totalK+square

上で dT を小さくすると
∫Kd(θ^1)∧d(θ^2)=∫(Subscript[k, g])ds(KはGauss曲率,(Subscript[k, g])は測地的曲率)
となります．

§４. 可視化(注- 重いです)

Manipulate[
u=p+a Cos[t];
v=q+b Sin[t];
cord={u,v,u^2-v^2};
eu={1,0,2 u};ev={0,1,-2 v};
pt=Point[cord];
e1=Arrow[{cord,cord+1/4 ep[t]}];
Show[{Graphics3D[{PointSize[0.02],Red,pt, Thick,e1,Blue,es,Green,esp},Boxed->False],s,meridian0,equator,trace}],
{{t,0},0,2Pi},SaveDefinitions->True
]