ryamadaのコンピュータ・数学メモ

統計学・遺伝学関連の姉妹ブログ『ryamadaの遺伝学・遺伝統計学メモ』
医学生物学と数学とプログラミングの三重学習を狙う学習ツール
 数学用語集(TOMAC)

2013-05-26 ぱらぱらめくる『エキゾチックな球面』

■[ぱらぱらめくるシリーズ][球][トポロジー][微分幾何]ぱらぱらめくる『エキゾチックな球面』 20:50

エキゾチックな球面 (ちくま学芸文庫)

エキゾチックな球面 (ちくま学芸文庫)

作者: 野口廣
出版社/メーカー: 筑摩書房
発売日: 2010/08/09
メディア: 文庫
クリック: 17回
この商品を含むブログ (12件) を見る

1. イリノイにて
- トポロジーにまつわる数学者
2. アルプスの山々
- 標高関数、トーラスの標高関数…複雑な等高線を持つ(複数ピークとか)、その背後には位相的に複雑な多様体があると考えることができる？複素数の導入のような…
- 危険地点…モース関数：へんてこりんな危険地点(サルの腰掛のような)は考えなくてもよい、ということを言う関数
- オイラー標数：位相空間の構造を特徴づける不変量
3. ハンドル体
- 球にハンドルをつけてできる閉多様体
- 滑らかな多様体上を歩く蟻、ラプラスの魔、多様体上のベクトル場
- 微分トポロジーと組み合わせトポロジー
- 微分トポロジーからホモトピー論
4. バンドル
- 位相空間と古典群・(リー)群(直交群とか)
- 特性類
5. コボルディズム:同一次元のコンパクトな多様体のequivalence relation
6. 古典数学
- 幾何・関数表示・リーマン面
- 代数多様体・複素多様体・可微分多様体・多様体
7. 微分トポロジー
- エキゾチックな球面
- 三角形分割
8. 組み合わせトポロジー
9. 回路のトポロジー

コメントを書く

トラックバック

2013-05-20 エキゾチックな球面とトーラス

ryamada2013-05-20

■[微分幾何][トポロジー][球][トーラス][R]球面と球面の直積のメビウスの輪的なひねり 09:04

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

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

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

張り合わせをねじる、そのまま貼るか、ひねって貼るか、というのが昨日の話題で、「ひねって貼る」には、一対一対応をとらないと行けなくて、それが「素直なひねり」になっているとよいね、という話だった。そういう意味で、球面版のメビウスの輪、的な話

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)))

コメントを書く

トラックバック

2013-05-19 エキゾチックな球面

ryamada2013-05-19

■[微分幾何][トポロジー][四元数][クオータニオン][R][onion]多次元球のいろいろな張り合わせ 15:07

多次元視覚のことをやっている(こちら)
そうすると、視覚で取った情報から各点の微分に関する情報を取り出して、それによって対象を理解しようか、という話になる
じゃあ、ということで多様体上の微分のことが気になるのだが、そこには「球は球でも微分の状態が違うことがある」という話題がある
エキゾチックな球面という話である(こちら)
多次元球面ならどんなものでもエキゾチックな球面があるかというとそうでもないらしい
歴史的に最初に登場した７次元球面の話でこれをなぞってみることにする(７次元のエキゾチック球面)
５次元空間 $￥mathbf{R}^5$ の球面 $S4$ ; $(x_1,x_2,...,x_5);￥sum_{i=1}^5 x_i^2=1$ と４次元空間 $￥mathbf{R}^4$ の球面 $S3$ ; $(y_1,y_2,...,y_4);￥sum_{j=1}^4 y_i^2=1$ とを考える
$S4 ￥times S3$ という直積空間は、 $S4$ , $S3$ 上の点のペアのすべてを網羅する空間。自由度4+3=7
ここでは $z=(￥mathbf{x},￥mathbf{y});￥sum_{i=1}^{5+4} z_i^2 =2$ となっている
さて。
$S4$ を $x_5=0$ という赤道でその上半分 $S4_{x_5 > 0}$ と下半分 $S4_{x_5 < 0}$ に分けることにする
この切り口は $￥sum_{i=1}^4 x_i^2=1$ なる球面である。上で述べた $S3$ と区別するべく $S3_0$ と書くことにする
この切り口 $S3_0$ に対応する直積空間 $S3_0 ￥times S3$ があるから、 $S4$ の赤道で切り離すというときには直積空間全体を２分割している
切り離したら、つなぎたい(貼りあわせなおしたい)
貼りなおすときには上半分と下半分とが「きれいに１対１対応」するようにすることを考える
切り口のすべての点の対応関係を４元数を使ってうまいことやろう、という話
$(x_1,x_2,x_3,x_4,y_1,y_2,y_3,y_4)$ という８つの数( $x_5=0$ であるので除いてある)を４つと４つ( $(x_1,x_2,x_3,x_4),(y_1,y_2,y_3,y_4)$ に分けて、それを $x_1 + i x_2 + j x_3 + k x_4$ というような四元数に対応付けよう。 $q(x),q(y)$ としよう
$q(x),q(y)$ のノルムは１
今、四元数の性質から、q(x),q(y)のハミルトニアン積 $q(x)q(y)$ もやはり四元数でそのノルムが１だから
上半分の $(x,y)$ と下半分の $(x,y’)$ (ただし $y’$ はハミルトニアン積( $q(x)q(y)$ の４成分の係数が作る長さ４のベクトルとする)が１対１対応付けできる
(その貼りあわせも素直な対応関係だから微分可能で、そうすると、微分の仕方の違う球面ができる、という話)
Rでやってみよう。Rには四元数・八元数をハンドリングするonionパッケージがある(ハミルトニアン積の関数がどれだか分らなかったのであまりメリットを得ていないのだが…)
適当に回転させてその軌道が貼り合わせによって変わることをみる

install.packages("onion")
library(onion)
# ばらばらとした小さな回転角の回転行列を作る(カッコ悪い出来になっている)
Small.Rotation <- function(d,n.iter=100,r=0.01){
	R <- diag(rep(1,d))
	for(i in 1:n.iter){
		s <- sample(1:d,2)
		t <- rnorm(1) * r
		tmp.R <- diag(rep(1,d))
		tmp.R[s[1],s[1]] <- tmp.R[s[2],s[2]] <- cos(t)
		tmp.R[s[1],s[2]] <- -sin(t)
		tmp.R[s[2],s[1]] <- sin(t)
		R <- tmp.R %*% R
	}
	R
}
# 四元数のハミルトン積
Hamiloton.prod.quat <- function(u,v){
	x <- Re(u)*Re(v)-i(u)*i(v) -j(u)*j(v)-k(u)*k(v)
	y <- Re(u)*i(v)+i(u)*Re(v)+j(u)*k(v)-k(u)*j(v)
	z <- Re(u)*j(v)-i(u)*k(v)+j(u)*Re(v)+k(u)*i(v)
	w <- Re(u)*k(v)+i(u)*j(v)-j(u)*i(v)+k(u)*Re(v)
	quaternion(Re=x,i=y,j=z,k=w)
}
# S4,S3のそれぞれの座標を作る
d5 <- 5
d4 <- 4
# 回転しながらn.pt個の点を作る
d5 <- 5
d4 <- 4
n.pt <- 1000
X5 <- matrix(0,n.pt,d5)
X4 <- matrix(0,n.pt,d4)
X5[1] <- X4[1] <- 1
X5.ori <- X5
X4.ori <- X4
# 貼りあわせを越えたときに１を立てる
hariawase <- rep(0,n.pt)

# 回転行列
R5 <- Small.Rotation(d5)
R4 <- Small.Rotation(d4)

# 1点1点作る
for(i in 2:n.pt){
# 仮に回転後の座標を作る
	tmp5 <- R5 %*% X5[i-1,]
	tmp4 <- R4 %*% X4[i-1,]
# 貼り合わせを越えるとは第５成分の正負が替わることなのでそれを判定
	if(tmp5[5] * X5[i-1,5] < 0){
# 二つの四元数を作る
		hariawase[i] <- 1
		tmp.u <- tmp5
# 四元数のノルムが１であるときに貼りあわせるのでそのためにちょっと調整する
		tmp.u <- tmp.u/sqrt(sum(tmp5[1:4]^2))
		u <- quaternion(Re=tmp.u[1],i=tmp.u[2],j=tmp.u[3],k=tmp.u[4])
		v <- quaternion(Re=tmp4[1],i=tmp4[2],j=tmp4[3],k=tmp4[4])
		uv <- Hamiloton.prod.quat(u,v)
		#tmp.X5 <- c(X5[i-1,1:4],-X5[i-1,5])
		#tmp.X4 <- c(Re(uv),i(uv),j(uv),k(uv))
		X5[i,] <- tmp5
		X4[i,] <- c(Re(uv),i(uv),j(uv),k(uv))

	}else{# 乗り越えてない
		X5[i,] <- tmp5
		X4[i,] <- tmp4
	}
# 変な張り合わせでなければ普通に回転行列を作用させるだけ
	X5.ori[i,] <- R5 %*% X5.ori[i-1,]
	X4.ori[i,] <- R4 %*% X4.ori[i-1,]

}
# 回転の様子をペアワイズプロットで見る
plot(as.data.frame(cbind(X5,X4)),cex=0.01)
plot(as.data.frame(cbind(X5.ori,X4.ori)),cex=0.01)
# 回転の様子をmatplot()で見る
matplot(cbind(X5,X4),type="l")
matplot(cbind(X5.ori,X4.ori),type="l")
# 貼りあわせの仕方の違いがどう表れるかを見る
plot(X5[,1],X5.ori[,1])
plot(X4[,1],X4.ori[,1])

コメントを書く

トラックバック

ryamadaのコンピュータ・数学メモ - 球面と球面の直積のメビウスの...

2013-03-06 薔薇

■[折り紙][数学][トポロジー][薔薇][Rose]薔薇の折り紙 19:56

薔薇の折り紙には「川崎ローズ」とそこからの派生の「福山ローズ」があるという(こちら)
いかにも、な感じがしたので「バラ、折り紙、トポロジー」で検索すると、こんな素敵な本もあるという

バラと折り紙と数学と

バラと折り紙と数学と

作者: 川崎敏和
出版社/メーカー: 森北出版
発売日: 1998/08
メディア: 単行本
購入: 2人クリック: 57回
この商品を含むブログ (7件) を見る

さらに数学で"rose"といえば
- 『円の集まり（無限個でもよい）を一点で貼り合わせて得られる位相空間』というらしい(こちら)
トーラスは分割表(こちら…多次元分割表の代数統計の話)、では、ローズは？？？

コメントを書く

トラックバック

2013-02-23 正単体の空間充填曲線

■[正単体][幾何][トポロジー][順序][空間充填曲線]順序を入れる 17:17

こちらでカテゴリの生起確率ベクトルの空間を正単体としてとって、そこに階層化したルールに基づく順序を入れる話がある
３カテゴリ、２次元、2-正単体＝正三角形の場合に、２辺を貼り合わせて、円錐(の側面)に作り上げると、順序は円錐の側面を無限に短いピッチでらせん状に回る曲線としてあらわされる(ことをものすごく大雑把に)書いた
じゃあ、nカテゴリ、n-1次元、n-1正単体も適当に貼り合わせて連続な線で正単体空間を充填することは可能？
正三角形でできたのは、２次元→１次元のように、次元を下げる作業がごく簡単だったから？
もしできるとして、そんな貼り合わせと、基底との関係とか、どうなる？

コメントを書く

トラックバック