異次元接続

• こちらでポイントクラウドデータをグラフ化して、そこに交通量ベクトルを計測する話を書いた
• ポイントクラウドの次元を局所推定する、みたいなトピックの一環
• 方法がうまく行っているのかを確かめるために、異なる次元に移り変わるような分布とそこからの標本をシミュレーションしてみる
• ,,とか…

# -infty <= x <= infty
# 0 <= y <= max(0,sign(x)*abs(x)^0.5)
# 0 <= z <= max(0,sign(x+y-k)*(x+y-k)^2)
n.pt <- 100000
d <- 3
r <- 1.5
k <- 1
xyz <- matrix(runif(n.pt*d,min=-1,max=1),ncol=d)*r
n.pt.2 <- 100
xyz <- rbind(xyz,cbind(runif(n.pt.2,min=-1,max=1)*r,rep(0,n.pt.2),rep(0,n.pt.2)))
n.pt.3 <- 5000
xyz <- rbind(xyz,cbind(matrix(runif(n.pt.3*2,min=-1,max=1),ncol=2)*r,rep(0,n.pt.3)))
ss <- which(xyz[,2]>=0 & xyz[,2]<=apply(cbind(sign(xyz[,1])*xyz[,1]^2,rep(0,length(xyz[,1]))),1,max))
plot(xyz[ss,])

s <- which(xyz[,2]>=0 & xyz[,2]<=apply(cbind(sign(xyz[,1])*abs(xyz[,1])^0.5,rep(0,length(xyz[,1]))),1,max) & xyz[,3]>=0 & xyz[,3]<=apply(cbind(sign(xyz[,1]+xyz[,2]-k)*(xyz[,1]+xyz[,2]-k)^2,rep(0,length(xyz[,1]))),1,max))
xyz. <- xyz[s,]
library(rgl)
xyz.. <- rbind(xyz.,rep(-r,d),rep(r,d))
plot3d(xyz..)

XYZ <- xyz. + rnorm(length(xyz.),0,0.01)
XYZ <- XYZ[sample(1:length(xyz.[,1]),500),]

tr.o <- my.traffic(XYZ)

RGB <- matrix(0,length(XYZ[,1]),3)
for(i in 1:length(XYZ[,1])){
	if(!is.null(tr.o$eigen.out[[i]])){
		RGB[i,] <- tr.o$eigen.out[[i]][[1]]/sum(tr.o$eigen.out[[i]][[1]])
		#RGB[i,] <- tr.o$eigen.out[[i]][[1]]
	}
	
}
RGB.. <- RGB
for(i in 1:3){
	RGB..[,i] <- (RGB..[,i]-min(RGB..[,i]))/(max(RGB..[,i])-min(RGB..[,i]))
}
RGBmax <- apply(RGB,2,max)
RGB. <- t(RGB)/RGBmax
RGB.[which(RGB.<0)] <- 0
col <- rgb(RGB.[1,],RGB.[2,],RGB.[3,])
#col <- rgb((1-RGB..[,1])^3,(1-RGB..[,2])^2,(1-RGB..[,3])^2)
plot3d(XYZ,col=col)