ノンパラメトリック回帰

  • ここのところ、James-Stein推定とか、Shrinkageとか、スプラインとかをいじっていて(こちら)、それらの根は同じなのだが、たとえば、ggplot2の回帰曲線なんかも同じ枠組みらしい
  • Local (polynomial) regressionで、その中で、「近傍」をk-nearest neighborで採用するなどしているらしい
  • 実験
    • 多人数、多観測マーカー
    • 観測値はマーカーごとに特性が異なるけれど、年齢影響を受ける
  • 表示
    • 個人ごとに、観測値の高低でソートしなおして、プロット


library(ggplot2)
n <- 300 # 人数
age <- runif(n) # 年齢を適当に
n.gene <- 1000 # 遺伝子数
X <- matrix(0,n,n.gene) # 個人別・遺伝子発現量
for(i in 1:n.gene){ # 遺伝子ごとに発現量を作る
	X[,i] <- (rnorm(1)+runif(1)*4)*3*(age+3)^2 + rnorm(n,runif(1),
runif(1)*300)*age
	# 年齢に影響を受けさせる
	# 年齢増とともに平均発現量は多くなることが多いが、少なくなること
もある
	# 乱雑項にも年齢影響を入れる
}
# クオンタイルするために、個人の中での発現量でソート
X.sorted <- t(apply(X,1,sort))

# プロットするクオンタイルを選ぶ
n.qs <- 30
qs <- round(seq(from=1,to=n.gene,length=n.qs))
# matplotする
matplot(age,X.sorted[,qs],type="p",cex=1,pch=20)
# ggplot2を使ってスムージング・回帰曲線を引く
mydat <-data.frame(age = rep(age,n.qs),gs=c((X.sorted[,qs])),qs=rep(qs,
each=n))
r <- ggplot(data = mydat, aes(x = age, y = gs, color = qs, group = qs))
r + geom_smooth() #(left)
  • 同じサンプルセットに2つの観察があったら、その2つが作る2曲線を比べたくなる
    • 曲線間の距離を定義する?
n.f <- 100
n.m <- 100
age.f <- rnorm(n.f,0.7,2)
age.m <- rnorm(n.m,0.7,3)

k.f <- runif(1)
k.m <- runif(1)
g.f <- age.f*k.m + apply(matrix(mean(age.f)-age.f,ncol=1),1,max,0)*k.f+rnorm(n.f)
g.m <- age.m*k.m + rnorm(n.m)

mydat <- data.frame(age=c(age.f,age.m),sex=c(rep(1,n.f),rep(2,n.m)),g=c(g.f,g.m))
r <- ggplot(data = mydat, aes(x = age, y = g, color = sex, group = sex))
r + geom_smooth() #(left)

g.f.2 <- age.f*k.m + apply(matrix(mean(age.f)-age.f,ncol=1),1,max,0)*k.f+rnorm(n.f)
g.m.2 <- age.m*k.m + rnorm(n.m)

mydat <- data.frame(age=c(age.f,age.m,age.f,age.m),sex=c(c(rep(1,n.f),rep(2,n.m)),c(rep(3,n.f),rep(4,n.m))),g=c(g.f,g.m,g.f.2,g.m.2))
r.2 <- ggplot(data = mydat, aes(x = age, y = g, color = sex, group = sex))
r.2 + geom_smooth() #(left)

mydat <- data.frame(age=c(age.f,age.f),gene=c(rep(1,n.f),rep(2,n.f)),g=c(g.f,g.f.2))
r.3 <- ggplot(data = mydat, aes(x = age, y = g, color = gene, group = gene))
r.3 + geom_smooth() #(left)