矯めつ眇めつ2

  • n次元オブジェクトをn-1次元視覚で矯めつ眇めつするのには、オブジェクト周囲に適当に視点を取ってやるのが良さそうだ。そのうえで、視点と近傍視点との間に「差分」を取って、視点間n-1次元像の違いが「気になる」ところを「着目すべき辺」とする、というような手続きがよさそうだ
  • そうするためには、n次元に凸包(convex hull)を取りたい
  • Rだとgeometry パッケージのconvhulln()関数とか、dlaunayn()関数(ドロネー図)とか
install.packages("geometry")
library(geometry)

n.pt <- 100

d <- 3

X <- matrix(rnorm(n.pt*d),ncol=d)
X <- X/sqrt(apply(X^2,1,sum))
apply(X^2,1,sum)

tried <- delaunayn(X)

library(rgl)
plot3d(X)

segs <- matrix(NA,nrow=0,ncol=d)
ex.gr <- expand.grid(1:d,1:d)
for(i in 1:length(tried[,1])){
	for(j in 1:length(ex.gr[,1])){
		if(ex.gr[j,1]!=ex.gr[j,2]){
			segs <- rbind(segs,X[c(tried[i,ex.gr[j,1]],tried[i,ex.gr[j,2]]),])
		}
	}
}

plot3d(X[,1:3])
segments3d(segs[,1:3])

tried.2 <- t(convhulln(X))

rgl.triangles(X[tried.2,1],X[tried.2,2],X[tried.2,3],col="red",alpha=.2)
for(i in 1:(8*360)) rgl.viewpoint(i/8)
  • 球面上に適当に乱点を発生させて、そこに凸包を作って、その後で、少し調整して比較的均整のとれた凸包にしてみる、とか
n.pt <- 40
d <- 3

X <- matrix(rnorm(n.pt*d),ncol=d)
X <- X/sqrt(apply(X^2,1,sum))
apply(X^2,1,sum)

xyz <- X


tried.2 <- t(convhulln(xyz))
tried.2.v <- c(tried.2)
tried.2.u <- unique(tried.2.v)

plot3d(xyz[tried.2.u,])

rgl.triangles(xyz[tried.2,1],xyz[tried.2,2],xyz[tried.2,3],col="red",alpha=.2)
for(i in 1:(8*360)) rgl.viewpoint(i/8)


length(tried.2.v)
length(tried.2.u)
m <- matrix(0,length(tried.2.u),length(tried.2.u))

for(i in 1:length(tried.2[1,])){
	for(j in 1:(length(tried.2[,1])-1)){
		v1 <- tried.2[j,i]
		V1 <- which(tried.2.u==v1)
		for(j2 in (j+1):length(tried.2[,1])){
			v2 <- tried.2[j2,i]
			V2 <- which(tried.2.u==v2)
			m[V1,V2] <- 1
			m[V2,V1] <- 1
		}
	}
}

n.iter <- 1000

xyz.2 <- xyz
s <- sample(1:length(tried.2.u),n.iter,replace=TRUE)
for(i in 1:n.iter){
	tmp.s <- s[i]
	tmp.neighbor <- which(m[tmp.s,]==1)
	tmp.xyz <- xyz.2[tried.2.u[tmp.neighbor],]
	tmp.m <- apply(tmp.xyz,2,mean)
	tmp.m <- tmp.m/sqrt(sum(tmp.m^2))
	xyz.2[tried.2.u[tmp.s],] <- tmp.m
}
open3d()
plot3d(xyz.2[tried.2.u,])
rgl.triangles(xyz.2[tried.2,1],xyz.2[tried.2,2],xyz.2[tried.2,3],col="red",alpha=.2)