SO (4) 上の数点を順番に結んで第１ホモトピー類を計算する．

(*so(4) Lie alg.*)
L=Table[-KroneckerDelta[a,c]*KroneckerDelta[b,d]+KroneckerDelta[b,c]*KroneckerDelta[a,d],{a,4},{b,4},{c,4},{d,4}];
(*構造定数*)
Ls={L[[1,2]],L[[2,3]],L[[3,1]],L[[1,4]],L[[2,4]],L[[3,4]]};
MatrixForm/@Ls
xs=Array[x,{6}];
fso4=Table[xs/.Solve[l1.l2-l2.l1==xs.Ls,xs]//First,{l1,Ls},{l2,Ls}]

(*spin(4) Lie alg.*)
{σ0,σx,σy,σz}=Table[KroneckerProduct[IdentityMatrix[2],σ],{σ,Table[PauliMatrix[i],{i,0,3}]}];
{τ0,τx,τy,τz}=Table[KroneckerProduct[σ,IdentityMatrix[2]],{σ,Table[PauliMatrix[i],{i,0,3}]}];
γ1=σx.τx;
γ2=σy.τx;
γ3=σz.τx;
γ4=τy;
γs={γ1,γ2,γ3,γ4};
Σ=Table[(a.b-b.a)/(-4),{a,γs},{b,γs}];
Σs={Σ[[1,2]],Σ[[2,3]],Σ[[3,1]],Σ[[1,4]],Σ[[2,4]],Σ[[3,4]]};
MatrixForm/@(2 I Σs)
(*構造定数*)
xs=Array[x,{6}];
fspin4=Table[xs/.Solve[l1.l2-l2.l1==xs.Σs,xs]//First,{l1,Σs},{l2,Σs}]

fspin4==fso4

θs={};
num=6;
Rs(*ランダムに6点選ぶ*)=Table[MatrixExp[Table[2 Pi*RandomReal[],{i,6}].Ls],{j,num}];
AppendTo[Rs,Rs[[1]]];
Do[
R=Rs[[j+1]].Inverse[Rs[[j]]];
{Eval,Evec}=Eigensystem[R];
Evec=Normalize/@Evec;
l=Evec\[Transpose].DiagonalMatrix[I*Arg[Eval]].Evec\[Conjugate]//Chop;
xs=Array[x,{6}];
AppendTo[θs,xs/.Solve[l==xs.Ls,xs]//First];
,{j,num}];
qs=Table[MatrixExp[θ.Σs],{θ,θs}];
q=IdentityMatrix[4];
Do[q=qtmp.q,{qtmp,qs}]
q=q//Chop;
q//MatrixForm

(*ホモトピー類が非自明な例*)
θs={};
num=4;
Rs={MatrixExp[{0,0,0,0,0,0}.Ls],MatrixExp[{Pi/2,0,0,0,0,Pi/2}.Ls],MatrixExp[{Pi,0,0,0,0,Pi}.Ls],MatrixExp[{-Pi/2,0,0,0,0,Pi/2}.Ls]};
AppendTo[Rs,Rs[[1]]];
Do[
R=Rs[[j+1]].Inverse[Rs[[j]]];
{Eval,Evec}=Eigensystem[R];
Evec=Normalize/@Evec;
l=Evec\[Transpose].DiagonalMatrix[I*Arg[Eval]].Evec\[Conjugate]//Chop;
xs=Array[x,{6}];
AppendTo[θs,xs/.Solve[l==xs.Ls,xs]//First];
,{j,num}];
qs=Table[MatrixExp[θ.Σs],{θ,θs}];
q=IdentityMatrix[4];
Do[q=qtmp.q,{qtmp,qs}]
q=q//Chop;
q//MatrixForm