暗殺教室の数学問題をRで描画する

暗殺教室の問題をRで描画する

追記
hoxo_m さんが、ブラウザでグリグリうごかせるファイルをアップしてくれました。
WebGLファイルの作成方法は知っていましたが、なるほどドロップボックスに
出来たファイルを置けばみんなハッピーにうごかせるのか～。

RGL model

職場にジャンプがころがっていた。
暗殺教室で数学の問題があり、その解の三次元の形状が気になった。
http://maji-w.blog.jp/archives/20064241.html
【画像】暗殺教室の数学問題が難しすぎると話題にｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗｗ : マジワロ速報

Rで描画して３Dでぐるぐる回してみたい。

隣り合う立方体形の各単位格子の中心点同士からの等距離の面は、
立方体形の各単位格子の面そのものである。
したがって、注目する１つの立方体形の単位格子の内部のみ
考えれば良い。（漫画には単位格子の頂点からの距離ばかり考えて
中心点同士の考察が書いてなかったのが気になる）

この中の点のうち、条件をみたすものを力技で判定して描画する。

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((x - y) ^ 2)
}
dist.p1 <- function(y){
      apply(p, 1, function(x)dist.p(x, y))
}

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)

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

大体５０％になった。

マウスで、ぐりぐり回せるので楽しい。