【雑想】「暗殺教室」のアレ？

とりあえずrglライブラリの活用法を考えてる統計言語Rユーザーとしては、こういうの見掛けると脊髄反射的に動かして見たくなります。

 統計言語Rによるプログラミング例

library(rgl)
p0 <- c(0,0,0)
temp <- c(0.5, -0.5)
p <- expand.grid(temp,temp,temp)

dist.p0 <- function(x) sum(x^2)
dist.p <- function(x, y){
sum*1
}

n <- 50
x <- seq(-0.5, 0.5, length = n)
x <- expand.grid(x,x,x)

p0.range <- function(x){
all(dist.p1(x) > dist.p0(x))
}

temp3 <- x[apply(x, 1, p0.range),]

nrow(temp3) / n^3 * 100 #何％の点が条件をみたしたか

p2 <- matrix(0, nrow=3, ncol=3)
diag(p2) <- 1
p2 <- rbind(p2, -p2)

dist.p2 <- function(y){
apply(p2, 1, function(x)dist.p(x, y))
}

posible.outer <- function(x){
epsiron <- 0.02
any(c(abs(dist.p1(x) - dist.p0(x)) < epsiron, abs(dist.p2(x) - dist.p0(x)) < epsiron))
}

temp4 <- temp3[apply(temp3, 1, posible.outer),]

col.calc <- function(x){
epsiron <- 0.02
t1 <- abs(dist.p1(x) - dist.p0(x)) < epsiron
t2 <- abs(dist.p2(x) - dist.p0(x)) < epsiron
sum(t1 * 1:8) + sum(t2 * 9:14)
}

col0 <- apply(temp4, 1, col.calc)

col1 <- rainbow(14)
col <- col1[col0]
col[is.na(col)] <- "#00000000"
plot3d(temp4, col=col)

#唯一の追加行（Gifアニメーションへの変換）

movie3d(spin3d(axis=c(0,0,1),rpm=5),duration=10,fps=25,movie="~/Desktop/test05")

とりあえず敬意を評して回して見ました。実行に要した時間は、私の型落ちMac book airで30秒ほど。具体的内容については時間が出来次第、吟味する予定です…

*1:x - y) ^ 2)
}
dist.p1 <- function(y){
apply(p, 1, function(x)dist.p(x, y