遺伝学・遺伝統計学関連の姉妹ブログ『ryamadaの遺伝学・遺伝統計学メモ』
京都大学大学院医学研究科ゲノム医学センター統計遺伝学分野のWiki
講義・スライド
医学生物学と数学とプログラミングの三重学習を狙う学習ツール
駆け足で読む○○シリーズ
ぱらぱらめくるシリーズ
カシオの計算機
オンライン整数列大辞典

カメによる解釈

R L-system Prusinkiewicz アニメーション
  • Figure 1.6
    • quadratic Koch island

http://www.statgenet.med.kyoto-u.ac.jp/StatGenet/Prusinkiewicz/F1-6.jpeg

# Turtle interpretation of strings

# 動きは４つあって、その並び方で決まる
# 動きを決める並びは、初期の並びから、ルールに従って成長する
# 出来上がったルールをカメが解釈して絵を描く

# ４つの動き

# 前進距離 d,d,0,0
# 前進時に線を引くか否か 1,0,0,0
# 向き変化 0,0,+D,-D

# 変化ルール
#d<-sample(1:4,1) # 移動距離
d<-3
D<-pi/2 # 角度変化

# 動き配列
# w= c(1,4,1,4,1,4,1)
# p1: 1->c(1,4,1,3,1,3,1,1,4,1,4,1,4,3,1)
x<-c(1,4,1,4,1,4,1)
replacer<-as.list(rep(c(0),4))
replacer[[1]]<-c(1,4,1,3,1,3,1,1,4,1,4,1,3,1)
replacer[[2]]<-c(2)
replacer[[3]]<-c(3)
replacer[[4]]<-c(4)

MakeSequence<-function(initX,Nstep,replacer){
	X<-as.list(rep(c(0),Nstep+1))
	x<-initX
	X[[1]]<-x
	for(i in 2:(Nstep+1)){
		tmp<-c()
		for(j in 1:length(x)){
			tmp<-c(tmp,replacer[[x[j]]])
		}
		x<-tmp
		X[[i]]<-x
	}
	X

}

Niter<-4
#X<-as.list(rep(c(0),Niter))

#X[[1]]<-x

X<-MakeSequence(x,Niter,replacer)

#for(i in 2:Niter){
#print(x)
	#tmp<-c()
	#for(j in 1:length(x)){
		#tmp<-c(tmp,replacer[[x[j]]])
	#}
	#x<-tmp
	#X[[i]]<-x
#}
#X


ResultTurtle<-function(x,d,D,ds=c(1,1,0,0),Ds=c(0,0,1,-1),Ls=c(1,0,1,1),initX=NULL,initA=NULL){
	Niter<-length(x)+1
	X<-matrix(0,Niter,3)
	L<-rep(0,Niter-1)
	# 前進距離 d,d,0,0
	# 前進時に線を引くか否か 1,0,0,0
	# 向き変化 0,0,+D,-D
	ds<-ds*d
	Ds<-Ds*D
	Ls<-Ls*1
	if(is.null(initX)){
		initX<-c(0,0)
	}
	if(is.null(initA)){
		initA<-0
	}
	X[1,]<-c(initX,initA)
	for(i in 1:length(x)){
		X[i+1,1]<-X[i,1]+ds[x[i]]*cos(X[i,3])
		X[i+1,2]<-X[i,2]+ds[x[i]]*sin(X[i,3])
		X[i+1,3]<-X[i,3]+Ds[x[i]]
		L[i]<-Ls[x[i]]
	}
	list(X=X,L=L,x=x)
}

DrawTurtle<-function(ttl,col=FALSE){
	plot(ttl$X[,1],ttl$X[,2],cex=0.1)
	for(i in 1:length(ttl$L)){
		if(ttl$L[i]==1){
			c<-1
			if(col)c<-ttl$x[i]
			segments(ttl$X[i,1],ttl$X[i,2],ttl$X[i+1,1],ttl$X[i+1,2],col=c)
		}
	}
	
}



for(i in 1:length(X)){
	resTurtle<-ResultTurtle(X[[i]],d,D)
	DrawTurtle(resTurtle)
}
  • qualratic Kock island 2

http://www.statgenet.med.kyoto-u.ac.jp/StatGenet/Prusinkiewicz/F1-7a.jpeg

# Kock island 2 Figure 1.7a

# 変化ルール
#d<-sample(1:4,1) # 移動距離
d<-1
D<-pi/2 # 角度変化

# 動き配列
# w= c(1,4,1,4,1,4,1)
# p1: 1->c(1,3,1,1,4,1,1,4,1,4,1,3,1,3,1,1,4,1,4,1,3,1,3,1,1,3,1,1,4,1)
x<-c(1,4,1,4,1,4,1)
replacer<-as.list(rep(c(0),4))
replacer[[1]]<-c(1,3,1,1,4,1,1,4,1,4,1,3,1,3,1,1,4,1,4,1,3,1,3,1,1,3,1,1,4,1)
replacer[[2]]<-c(2)
replacer[[3]]<-c(3)
replacer[[4]]<-c(4)

Niter<-2
X<-MakeSequence(x,Niter,replacer)


par(mfcol=c(2,2))
for(i in 1:length(X)){
	resTurtle<-ResultTurtle(X[[i]],d,D)
	DrawTurtle(resTurtle)
}
par(mfcol=c(1,1))
	DrawTurtle(resTurtle)
  • quadratic modification of the snowflake curve

http://www.statgenet.med.kyoto-u.ac.jp/StatGenet/Prusinkiewicz/F1-7b.jpeg

	
# Kock island 2 Figure 1.7b

# 変化ルール
#d<-sample(1:4,1) # 移動距離
d<-1
D<-pi/2 # 角度変化

# 動き配列
# w= c(4,1)
# p1: 1->c(1,3,1,4,1,4,1,3,1)
x<-c(4,1)
replacer<-as.list(rep(c(0),4))
replacer[[1]]<-c(1,3,1,4,1,4,1,3,1)
replacer[[2]]<-c(2)
replacer[[3]]<-c(3)
replacer[[4]]<-c(4)

Niter<-4
X<-MakeSequence(x,Niter,replacer)


par(mfcol=c(2,2))
for(i in 1:length(X)){
	resTurtle<-ResultTurtle(X[[i]],d,D)
	DrawTurtle(resTurtle)
}
par(mfcol=c(1,1))
DrawTurtle(resTurtle)
  • Combination of islands and lakes
  • Figure 1.8

http://www.statgenet.med.kyoto-u.ac.jp/StatGenet/Prusinkiewicz/F1-8.jpeg

# Combination of islands and lakes Figure 1.8

# 変化ルール
#d<-sample(1:4,1) # 移動距離
d<-1
D<-pi/2 # 角度変化

# 動き配列
# w= c(1,3,1,3,1,3,1)
# p1: 1->c(1,3,2,4,1,1,3,1,3,1,1,3,1,2,3,1,1,4,2,3,1,1,4,1,4,1,1,4,1,2,4,1,1,1)
# p2: 2->c(2,2,2,2,2,2)
x<-c(1,3,1,3,1,3,1)
replacer<-as.list(rep(c(0),4))
replacer[[1]]<-c(1,3,2,4,1,1,3,1,3,1,1,3,1,2,3,1,1,4,2,3,1,1,4,1,4,1,1,4,1,2,4,1,1,1)
replacer[[2]]<-c(2,2,2,2,2,2)
replacer[[3]]<-c(3)
replacer[[4]]<-c(4)

Niter<-2
X<-MakeSequence(x,Niter,replacer)


par(mfcol=c(2,2))
for(i in 1:length(X)){
	resTurtle<-ResultTurtle(X[[i]],d,D)
	DrawTurtle(resTurtle)
}
par(mfcol=c(1,1))
DrawTurtle(resTurtle)
  • Koch curves いろいろ

http://www.statgenet.med.kyoto-u.ac.jp/StatGenet/Prusinkiewicz/F1-9.jpeg

# Figure 1.9
# Koch curves
# 変化ルール
#d<-sample(1:4,1) # 移動距離
d<-1
D<-pi/2 # 角度変化
# w= c(1,4,1,4,1,4,1)
x<-c(1,4,1,4,1,4,1)

replacer<-as.list(rep(c(0),4))
replacer[[1]]<-c(1)
replacer[[2]]<-c(2)
replacer[[3]]<-c(3)
replacer[[4]]<-c(4)

par(mfcol=c(3,2))
########### a 

# 動き配列
# p1: 1->c(1,1,4,1,4,1,4,1,4,1,4,1,3,1)
replacer[[1]]<-c(1,1,4,1,4,1,4,1,4,1,4,1,3,1)
Niter<-4
X<-MakeSequence(x,Niter,replacer)

resTurtle<-ResultTurtle(X[[Niter+1]],d,D)
DrawTurtle(resTurtle)
########### b
# 動き配列
# p1: 1->c(1,1,4,1,4,1,4,1,4,1,1)
replacer[[1]]<-c(1,1,4,1,4,1,4,1,4,1,1)

Niter<-4
X<-MakeSequence(x,Niter,replacer)

resTurtle<-ResultTurtle(X[[Niter+1]],d,D)
DrawTurtle(resTurtle)

########### c
# 動き配列
# p1: 1->c(1,1,4,1,3,1,4,1,4,1,1)
replacer[[1]]<-c(1,1,4,1,3,1,4,1,4,1,1)

Niter<-3
X<-MakeSequence(x,Niter,replacer)

resTurtle<-ResultTurtle(X[[Niter+1]],d,D)
DrawTurtle(resTurtle)

########### d
# 動き配列
# p1: 1->c(1,1,4,1,4,4,1,4,1)
replacer[[1]]<-c(1,1,4,1,4,4,1,4,1)

Niter<-4
X<-MakeSequence(x,Niter,replacer)

resTurtle<-ResultTurtle(X[[Niter+1]],d,D)
DrawTurtle(resTurtle)

########### e
# 動き配列
# p1: 1->c(1,4,1,1,4,4,1,4,1)
replacer[[1]]<-c(1,4,1,1,4,4,1,4,1)

Niter<-5
X<-MakeSequence(x,Niter,replacer)

resTurtle<-ResultTurtle(X[[Niter+1]],d,D)
DrawTurtle(resTurtle)

########### f
# 動き配列
# p1: 1->c(1,4,1,3,1,4,1,4,1)
replacer[[1]]<-c(1,4,1,3,1,4,1,4,1)

Niter<-4
X<-MakeSequence(x,Niter,replacer)

resTurtle<-ResultTurtle(X[[Niter+1]],d,D)
DrawTurtle(resTurtle)


par(mfcol=c(1,1))