次元を上げる

• 昨日の記事では、２次元におけるself-avoiding pathのシミュレーションを行った
• 袋小路に頭を突っ込んで動けなくなる現象「どん詰まり」現象を観察するとともに、それを回避する仕組みについて考えた
• 今日の記事では、次元を上げてみよう
• 次元を２から３に上げると空間が格段に広くなるので、「どん詰まり」現象が起きる確率は低くなる
• ソースとしてはこんな感じ
  • animationパッケージを使ってsaveGIF()で囲めば映画が作れる(昨日の記事を参照)

# 次元
k<-2
# 点の存在状態を点の数の行、点の位置座標とその年齢の列の行列で表すこととする
# 初期状態は、原点に年齢１の点を１つとってみる
b<-matrix(0,4,k+1)
b[1,k+1]<-1
# シミュレーション時間
T<-1000
# 描図範囲を定める定数
L<-40
library(rgl)
# 点は増殖力があるものとないものに分ける
# ひとまず、生まれたて(年齢１)の点は増殖可能とする
# そして、子供をnumChild個、自分の周囲に作る
# 何個の子供を作るかは、確率的に決まるとする

numChild<-1:2
probChild<-c(0.9,0.1)

# シミュレーション
for(i in 1:T){
	plot(b[,1:2],col=gray(b[,k+1]/max(b[,k+1])),pch=15,cex=1,xlim=c(-L,L),ylim=c(-L,L))
	Sys.sleep(0.05)
	#plot3d(b[,1:3],col=gray(b[,k+1]/max(b[,k+1])),pch=15,cex=1,xlim=c(-L,L),ylim=c(-L,L),zlim=c(-L,L))
	#plot3d(b[,1:3],pch=15,cex=1,xlim=c(-L,L),ylim=c(-L,L),zlim=c(-L,L))
	# 増殖力のある点のうち、どれか一つが増殖活動を起こすとする
	# 複数の増殖可能点があるときには、それらからランダムに選ぶこととする
	# ここで、世代ごとに増殖可能なすべての点に増殖させると「双曲鉤針編み」になる
	n<-sample(numChild,1,prob=probChild)
	active<-which(b[,k+1]==1)
	current<-sample(active,1)
	# 作る子供の数nについて、隣接するセルのうち、空いているセルのどれに作るかを決める
	for(j in 1:n){
		# 隣接セルを列挙して
		neighbors<-matrix(0,2*k,k)
		for(j in 1:k){
			neighbors[(j-1)*2+1,]<-neighbors[j*2,]<-b[current,1:k]
			neighbors[(j-1)*2+1,j]<-b[current,j]-1
			neighbors[j*2,j]<-b[current,j]+1
		}
		#print(neighbors)
		# その空き具合を確認する
		# 一定期間のみの占拠を気にするならば、このときに振り返る点の年齢に制約を入れればよいだろう
		ok<-rep(0,2*k)
		for(j in 1:(2*k)){
			for(j2 in 1:length(b[,1])){
				if(sum((neighbors[j,]-b[j2,1:k])^2)==0){
					ok[j]<-1
					break
				}
			}
		}
		#print(ok)
		#ok<-ok[-(2*k)]
		oks<-which(ok==0)
		#oks<-which((ok==0)&(neighbors[,k]>=0))
		#print(oks)
		if(length(oks)!=0){
			newb<-sample(oks,1)
			b<-rbind(b,c(neighbors[newb,],1))
		}
	}
	# 増殖したら年齢を上げる
	b[current,k+1]<-b[current,k+1]+1
	cols<-rep(0,length(b[,1]))
	for(j in 1:max(b[,k+1])){
		cols[which(b[,k+1]==j)]<-j
	}
}