2011-01-19

高次トーラス

トーラス

前の記事でトーラスは２重周期だった
数字を見たら、一般化しようということで、２重をk重にしてみよう
(2重周期の)トーラスの座標を作るときには、まず、大きな円を描き、その円周上の点に、円周と垂直に交わるように小さな円を描いた
これを繰り返していけばよい
(２重周期の)トーラスは３次元空間に作られる
k重周期のトーラスはk+1次元空間に作られる
i重目はi-1重目より半径を短くするのがよいだろう(そうしなくてもよいのかもしれない。定義次第か…)
座標の与え方は多次元球の角座標から正規直交座標に直すのと同じように、cos,sinのうち、sinの分を新規に導入する軸の座標そのものとし、cosの分をすでに与えた座標(の増分)に応じて与えることとする

# トーラスk次
k<-3
Rs<-1:k
Rs[1]<-1
Rs[2]<-0.9
Rs[3]<-0.6
r<-0.9
Rs<-r^(1:k)
#P1,P2の最小公倍数を大きくすれば、何度も巡回してようやく元に戻る
Ps<-rpois(k,30)
#P1<-7
#P2<-17
Ps[1]<-3
Ps[2]<-11
Ps[3]<-23
library(schoolmath) 
#素数を周期に与えるため
# 20以下の素数は8個
Ps<-sample(primes(1,100)[3:9],k)
Ps
n<-1000
t<-seq(from=0,to=1,length.out=n)*2*pi

# 多次元単位球面の角座標から、直交座標の座標を作る
# 多次元周期トーラス上の座標を得る
MultDimTorus<-function(Rs,v){
	C<-cos(v)
	S<-sin(v)
	ret<-rep(0,length(v)+1)
	preret<-ret
	for(i in 1:length(v)){
		if(i==1){
			ret[1]<-Rs[1]*C[1]
			ret[2]<-Rs[1]*S[1]
		}else{
			incr<-ret-preret
			preret<-ret
			incr<-incr/sqrt(sum(incr^2))
			ret<-ret+Rs[i]*C[i]*incr
			ret[i+1]<-Rs[i]*S[i]
			
		}
	}
	return(ret)
}

Xs<-matrix(0,length(t),k+1)
for(i in 1:length(t)){
	Xs[i,]<-MultDimTorus(Rs,t[i]*Ps)
}
plot3d(Xs[,1],Xs[,2],Xs[,3],cex=0.1,col=gray((1:length(t))/length(t)),xlim=xlim,ylim=ylim,zlim=zlim)
plot3d(Xs[,1],Xs[,2],Xs[,3],cex=0.1,col=gray((1:length(t))/length(t)))
##########
#　参考に。
# 単位k次元球の角座標(k-1個の角)からk個の正規直交座標を出す関数は以下
# 多次元単位球面の角座標から、直交座標の座標を作る
sphereCoords<-function(v){
	C<-cos(v)
	S<-sin(v)
	ret<-c(1,S)

	for(i in 1:length(v)){
		for(j in i:length(v)){
			ret[i]<-ret[i]*C[j]
		}
	}
	return(ret)
}

メモ
？？？？？？
曲線が乗っている多様体のトポロジータイプと、微分方程式の周期関数の次数とが関係するのか？トポロジータイプと変数同士の関係を描いたグラフとは一緒？
？？？？？？
未確認。
$X_i=k\cos(t + \frac{i}{N}*2\pi)$ のとき
$S\sum_{i=1}^N X_i)$ として $\frac{dS}{dt}$ であるように $\frac{dX_i}{dt}=\sum_{i=1}^N a_{ij} X_j$ としたいとする
$a_{i,i+\delta}=a_{i,i+\delta-N}$ が条件か…
$X_i=k\cos(t+\frac{i}{N}*2\pi)$ の条件を外すと $\sum_{j=1}^N a_{ij}$ が条件か…
$\frac{dX_i}{dt}=\sum_{i=1}^N a_{ij} X_i\times X_j$ とすると $a_{ij}=-a_{ji}$ が条件か…