多次元球面上の回転運動

回ること

• 平面上に円を描いて、その円周上を等速回転するのは、円周上を同一の角速度で移動すること
• k+1次元球の球面(k次元の閉じた空間)の上ではどうなるだろうか
• 定義の仕方は色々ありそうだが、回転を表す行列による移動の繰り返しであると考えることとする
• k+1次元空間の回転を、「長さを変えない変換」であるとすれば、その変換は正規直交基底を列ベクトルとする行列で表される
• Rで正規直交基底をランダムに作ってみよう

# 正規直交基底をランダムに作る
NormalBase<-function(n){ # n次元
	I<-X<-diag(rep(1,n))
# ペアワイズに適当な角度を定める
	thetas<-runif(n*(n-1)/2)*2*pi
	T<-matrix(0,n,n)
	T[lower.tri(T)]<-thetas
# ペアワイズに適当に回転させることを全ペアについて実施
	for(i in 1:(n-1)){
		for(j in (i+1):n){
			R<-I
			R[i,i]<-R[j,j]<-cos(T[j,i])
			R[i,j]<-sin(T[j,i])
			R[j,i]<--R[i,j]
			X<-R%*%X
		}
	}
	X
}

• 等角度で「回転」していくので、離散的に点を取って隣接ベクトル間の角度の変化を見れば、増加量は一定である
• しかし、初期位置ベクトルとなす角に関しては、３(２？）次元までは一定だが、それより高次元では、増えたり減ったり(遠くなったり近くなったり)する

d<-4 # 次元
# 正規直交基底
X<-NormalBase(d)
# 特異値分解すると、繰り返しの処理を実数パラメタのべき乗で処理できる
e.out<-eigen(X)

Niter<-1000
xs<-matrix(0,Niter,d)
xs[1,]<-runif(d) # 単位ベクトル化
dt<-0.01

acoss<-rep(0,Niter) # 初期位置ベクトルとの角度を格納
acoss2<-acoss # 前後位置ベクトル間の角度を格納

for(i in 2:Niter){
	xs[i,]<-Re(((e.out[[2]])%*%diag((e.out[[1]])^(i*dt))%*%solve(e.out[[2]]))%*%xs[1,])
	acoss[i]<-acos(sum(xs[i,]*xs[1,])/(sqrt(sum(xs[i,]^2))*sqrt(sum(xs[1,]^2))))
	acoss2[i]<-acos(sum(xs[i,]*xs[i-1,])/(sqrt(sum(xs[i,]^2))*sqrt(sum(xs[i-1,]^2))))
}

matplot(xs,type="l")
library(rgl)
xlim<-ylim<-zlim<-c(min(xs),max(xs))
plot3d(xs[,1],xs[,2],xs[,3],xlim=xlim,ylim=ylim,zlim=zlim)
plot((acoss[1:2000]))
plot(as.data.frame(xs))

回転のへそ

• 奇数次元ユークリッド空間における回転は回転軸を持つ(Wiki)
• 今、上記の方法でk次元空間の回転行列を作る
• その行列は(行列式)がkが奇数のときには0となる
• このことはを満足する自明でない解がkが奇数の時には存在する(そして偶数のときには存在しない)ことを意味する
• 上記の定義方法で言うことろの回転がkが奇数のときには(単位球面上に)固定点を持ち、kが偶数のときには、『球面上のすべての点は、球面上の自身とは異なる点に移される(１対１対応)』、また、kが偶数のときには『球面上のすべての点に非ゼロのベクトルを与えることができて、そのベクトルによる移動は球面の異なる点への移動を意味し、球面全体から、球面全体へマッピングされる』
• 回転は回転群で(こちら)やこちら
• 直交軸の入れ替えだけだと、偶数次元では「対称変換」と「回転変換」の両方の可能性がある

# 正規直交基底をランダムに作る

NormalBase<-function(n){
	I<-X<-diag(rep(1,n))

	thetas<-runif(n*(n-1)/2)*2*pi
	T<-matrix(0,n,n)
	T[lower.tri(T)]<-thetas

	for(i in 1:(n-1)){
		for(j in (i+1):n){
			R<-I
			R[i,i]<-R[j,j]<-cos(T[j,i])
			R[i,j]<-sin(T[j,i])
			R[j,i]<--R[i,j]
			X<-R%*%X
		}
	}
	X
}


for(i in 2:30){
	d<-i # 次元
# 正規直交基底
X<-NormalBase(d)
# 特異値分解すると、繰り返しの処理を実数パラメタのべき乗で処理できる
printed<-paste("i=",i," det=",det(X-diag(rep(1,d))))
print(printed)
}

• こちらなど