フラクタル メモ

# 4/25の講義内容の順序に沿って、いくつかの対象をRにて実行することを以下に示す
# 順に実行せよ
# 5/9のセミナー時間はその実行に成功していることを前提に始める

# コッホ曲線を描くRコードが以下のURLから得られる(以下にそれを示している)
# https://bmscblog.wordpress.com/2013/10/04/fractals-with-r-part-4-the-koch-snowflake/

# Rを起動しプロンプトにコマンド全体をコピーペーストし、絵が描かれることを確かめよ
# コードの読み方はここでは説明しないが、興味があれば、解読を試みよ
#Script by A. Roberts, 2013.
#To run the script, copy and paste it onto the R command line, and press ,<enter>.

KochSnowflakeExample <- function(){
iterate <- function(T,i){
A = T[ ,1]; B=T[ ,2]; C = T[,3];
if (i == 1){
d = (A + B)/2; h = (C-d); d = d-(1/3)*h;
e = (2/3)*B + (1/3)*A; f = (1/3)*B + (2/3)*A;
}

if (i == 2){
d = B; e = (2/3)*B + (1/3)*C; f = (2/3)*B + (1/3)*A;
}

if (i == 3){
d = (B + C)/2; h = (A-d); d = d-(1/3)*h;
e = (2/3)*C + (1/3)*B; f = (1/3)*C + (2/3)*B;
}

if (i == 4){
d = C; e = (2/3)*C + (1/3)*A; f = (2/3)*C + (1/3)*B;
}

if (i == 5){
d = (A + C)/2; h = (B-d); d = d-(1/3)*h;
e = (2/3)*A + (1/3)*C; f = (1/3)*A + (2/3)*C;
}

if (i == 6){
d = A; e = (2/3)*A + (1/3)*C; f = (2/3)*A + (1/3)*B;
}

if (i == 0){
d = A; e = B; f = C;
}

Tnew = cbind(d,e,f)
return(Tnew); #Return a smaller triangle.
}

draw <- function(T, col=rgb(0,0,0),border=rgb(0,0,0)){
polygon(T[1,],T[2,],col=col,border=border)
}

Iterate = function(T,v,col=rgb(0,0,0),border=rgb(0,0,0)){
for (i in v) T = iterate(T,i);
draw(T,col=col,border=border);
}

#The vertices of the initial triangle:
A = matrix(c(1,0),2,1);
B = matrix(c(cos(2*pi/3), sin(2*pi/3)),2,1);
C = matrix(c(cos(2*pi/3),-sin(2*pi/3)),2,1);
T0 = cbind(A,B,C);

plot(numeric(0),xlim=c(-1.1,1.1),ylim=c(-1.1,1.1),axes=FALSE,frame=FALSE,ann=FALSE);
par(mar=c(0,0,0,0),bg=rgb(1,1,1));
par(usr=c(-1.1,1.1,-1.1,1.1));

#Draw snowflake:
for (i in 0:6) for (j in 0:6) for (k in 0:6) for (l in 0:6) Iterate(T0,c(i,j,k,l));
}
KochSnowflakeExample(); #Run the example.

# らせんを描く
# アルキメデスのらせんは、角度thetaに応じて半径が長くなるらせん
# 角度が2pi (360度)増えるとその分だけ半径が長くなるので
# どの角度方向を見ても、必ず角度2pi分の長さの長い点が存在する

# 角度をたくさん発生させる
# ランダムに発生させる
# 0から20までの乱数
theta <- runif(100000) * 20
q <- 2
# 半径は角度に比例する
rtheta <- q*theta
x <- rtheta * cos(theta)
y <- rtheta * sin(theta)

plot(x,y)
abline(h=0) # y=0の直線を引く h(orizontal)
abline(v=0) # x=0の直線を引く v(ertical)

# Logarithmic らせん
# -100から+100の乱数
theta <- runif(100000) * 200 -100

# 半径は
a <- 1
b <- 0.05
rtheta2 <- a * exp(b*theta)
x <- rtheta2 * cos(theta)
y <- rtheta2 * sin(theta)

plot(x,y)
abline(h=0) # y=0の直線を引く h(orizontal)
abline(v=0) # x=0の直線を引く v(ertical)

# 自己相似
# -100から+10の乱数

theta <- theta[which(theta < 10)]

# 半径は
a <- 1
b <- 0.05
rtheta2 <- a * exp(b*theta)
x <- rtheta2 * cos(theta)
y <- rtheta2 * sin(theta)

dev.new()
plot(x,y)
abline(h=0) # y=0の直線を引く h(orizontal)
abline(v=0) # x=0の直線を引く v(ertical)
# 同じ絵〜自己相似
# 注意：プロットの軸の値が小さくなっていることに注意


n = 10
base_angle = pi*(1+sqrt(5)) 
r = sqrt(n) 
theta = n*base_angle
x = r*cos(theta)
y = r*sin(theta)

plot(x,y)

# べき乗則は生物現象に限らず、広く自然現象を理解することに役立つ法則である
# それをタイトルにした文庫本がある
# 『歴史は「べき乗則」で動く――種の絶滅から戦争までを読み解く複雑系科学-ハヤカワ文庫NF』
# 以下のリンクは、教員がその本について簡単にコメントしたものである。目を通せ
# http://d.hatena.ne.jp/ryamada/20120315/1331758041
# 時間の余裕があれば、通読することはなにがしかのアイディアを得るために有用であろう

# フラクタル図形はいろいろなところに現れる。
# フラクタル図形を描く、簡便な繰り返しアルゴリズムにL-systemと呼ばれるものがある
# 以下のリンク先には、L-systemに関する記述、そのRコードが現れる。実行してみよ
"http://d.hatena.ne.jp/ryamada/searchdiary?word=%2A%5BL-system%5D"