球面と球面の直積のメビウスの輪的なひねり

  • 昨日球面と球面の直積としてエキゾチックな球面ということを書いた
  • 球面と球面の直積っていうのは、「普通の多次元球」を描いて、その球面上の点の上に別の次元を使った球面を描くような感じ

  • もっと次元を下げれば、いわゆるドーナツ型トーラス

  • これを上半、下半に分けるというのは、こんな感じにすることで

  • 張り合わせをねじる、そのまま貼るか、ひねって貼るか、というのが昨日の話題で、「ひねって貼る」には、一対一対応をとらないと行けなくて、それが「素直なひねり」になっているとよいね、という話だった。そういう意味で、球面版のメビウスの輪、的な話
rsphere <- function(n,d,r,m=rep(0,d)){
	X <- matrix(rnorm(n*d),ncol=d)
	X <- (X)/sqrt(apply(X^2,1,sum))*r
	t(t(X)+m)
}
d1 <-3
d2 <- 2

r1 <- 1
r2 <- 0.5

n.pt1 <- 10000

X1 <- rsphere(n.pt1,d1,r1)
plot3d(X1)

s <- 1:10
n.pt2 <- 1000
X2 <- rsphere(n.pt2,d2,r2)

X2on1 <- matrix(0,0,d1)
for(i in 1:length(s)){
	tmp <- t(t(X2)+X1[s[i],1:d2])
	tmp <- cbind(tmp,rep(X1[i,3],n.pt2))
	X2on1 <- rbind(X2on1, tmp)
}

XX <- rbind(X1,X2on1)
XX <- rbind(XX,rep(max(XX),d1))
XX <- rbind(XX,rep(min(XX),d1))

plot3d(XX,col=c(rep(1,n.pt1),rep(2,length(X2on1[,1])),rep(0,2)))
  • 次元を下げればトーラス
d1 <-2
d2 <- 2

r1 <- 1
r2 <- 0.5

n.pt1 <- 1000

X1 <- rsphere(n.pt1,d1,r1)

s <- 1:100
n.pt2 <- 1000
X2 <- rsphere(n.pt2,d2,r2)

X2on1 <- matrix(0,0,3)
for(i in 1:length(s)){
	tmp.x1 <- X1[s[i],1] + X2[,1] * X1[s[i],1]/r1
	tmp.x2 <- X1[s[i],2] + X2[,1] * X1[s[i],2]/r1
	tmp.x3 <- X2[,2]
	X2on1 <- rbind(X2on1, cbind(tmp.x1,tmp.x2,tmp.x3))
}
X2on1 <- rbind(X2on1,rep(max(X2on1),3))
X2on1 <- rbind(X2on1,rep(min(X2on1),3))
plot3d(X2on1)
  • 上・下の色分け
d1 <-2
d2 <- 2

r1 <- 1
r2 <- 0.5

n.pt1 <- 1000

X1 <- rsphere(n.pt1,d1,r1)

s <- 1:100
n.pt2 <- 1000
X2 <- rsphere(n.pt2,d2,r2)

X2on1 <- matrix(0,0,3)
ue.shita <- rep(0,length(n.pt2))
delta <- 0.1
for(i in 1:length(s)){
	if(X1[s[i],2] > 0){#上半
		tmp.x1 <- X1[s[i],1] + X2[,1] * X1[s[i],1]/r1
		tmp.x2 <- X1[s[i],2] + X2[,1] * X1[s[i],2]/r1 + delta
		tmp.x3 <- X2[,2]
		ue.shita[i] <- 2
	}else{
		tmp.x1 <- X1[s[i],1] + X2[,1] * X1[s[i],1]/r1
		tmp.x2 <- X1[s[i],2] + X2[,1] * X1[s[i],2]/r1
		tmp.x3 <- X2[,2]
		ue.shita[i] <- 3
	}
	
	X2on1 <- rbind(X2on1, cbind(tmp.x1,tmp.x2,tmp.x3))
}
X2on1 <- rbind(X2on1,rep(max(X2on1),3))
X2on1 <- rbind(X2on1,rep(min(X2on1),3))
plot3d(X2on1,col=c(rep(c(ue.shita),each=n.pt),rep(1,2)))