あっちこっちな分布に関する予測

• 昨日、トーラス状の分布や、それと関連した分布のことを書いた
• 条件付き確率密度を推定する…というような枠組みで考えてみる
• 説明分布（例では２次元分布）と被説明分布（例では２次元分布）の同時分布についてkNN法で密度分布を推定するとする
• さらに説明変数セットについて何かしらの値が与えられたとして、「決め打ち」にした説明変数セットのベクトルを条件とした、限定のない被説明変数セットの（今回は計算量のこともあり、観測点のみを用いたが…）尤度をkNNで推定してみよう
• 説明変数によって、狭い範囲に推定できることもあれば、狭まらないこともある

library(FNN)

knn.density <- function(z,X,k=10){
	d <- length(z)
	tmp <- t(t(X)-z)
	D <- sqrt(apply(tmp^2,1,sum))
	D.s <- sort(D)
	(1:k)/length(X[,1])/(pi^(d/2)/gamma(d/2+1)*D.s[1:k]^d)
}

# 適当にXX(説明変数データ)を作る
X <- (runif(500)-0.3)*pi*2
X <- cbind(X,sin(X)+rnorm(X,0,0.1*(abs(X)*abs(X-3))))
plot(X)
X2 <- (runif(500)-0.3)*pi*2
X2 <- cbind(X2,-sin(X2)+rnorm(X2,0,0.1*(abs(X2+1)*abs(X2-3))))

XX <- rbind(X,X2)
plot(XX)
# YY被説明変数データ)を作る
Y <- (X-2)*(X+1)
Y2 <- (X2-3)*(X2+1)

YY <- cbind(XX[,1]-XX[,2],apply(XX^2,1,sum))

# XXとYYとの関係性の良さを図で示す
YY.0 <- YY + min(YY)+3

plot(rbind(XX,YY.0),pch=20,cex=2)

for(i in 1:length(XX[,1])){
	segments(XX[i,1],XX[i,2],YY.0[i,1],YY.0[i,2],col=2)
}

sh.x <- sample(1:length(XX[,1]))

# 同時分布を作る
XXYY <- cbind(XX,YY)

# 条件付き確率を納める
cond.prob <- rep(0,length(YY[,1]))
# kNN法のk
k <- 10

for(ii in 1:length(sh.x)){
for(i in 1:length(YY[,1])){
	tmp <- c(XX[sh.x[ii],],YY[i,])
	cond.prob[i] <- knn.density(tmp,XXYY,k)[k]
}

plot(YY,pch=20,col=gray((max(cond.prob)-cond.prob)/(max(cond.prob)-min(cond.prob))))
}