何気に加わってしまった、R Advent Calender。
みなさんのブログを見ていると、そのレベルの高さに驚いてしまいます。
自分から何が発信できるだろうか…と悩んでみたものの、無い袖も振れず…
ということで、開き直ることにしました。
私は14日目の担当で、折り返し地点を回ったところでしょうか?
みなさん、レベルが高くて気が引けます。
当初、animationパッケージの話をしようとしていたのですが、hoxo_mさんに先をこされ、その記事は既にこちらの日記で公開してしまいました。
じゃあ、どうしようかと迷っていたのですが、image関数について書こうと思いました。
image関数は数値のmatrixやdata.frameを2次元上にplotする関数です。
このとき、引数colを指定すると各セルに色付けができます。
defaultはmatrixに入る数値になるので、普通なら以下の様になります。
> (x <- matrix(1:12,ncol=3)) [,1] [,2] [,3] [1,] 1 5 9 [2,] 2 6 10 [3,] 3 7 11 [4,] 4 8 12 > jpeg("image.default.jpg") > image(x) > dev.off()
カラーコードをつけたいときは、fieldsパッケージのimage.plot関数があります。
> library(fields) > jpeg("image.plot.jpg") > image.plot(x) > dev.off()
で、ここからが本題なのですが、
- オブジェクトxは左上を起点に列方向に数値が増えて、右下が終点になる
- image関数もimage.plot関数も左下が起点となり、行方向に数値が増えて、右上が終点になる。
ことに気がつきます。
で、ニーズはスプレッドシートをそのまま二次元に展開したいので、数値の並びを変更したいわけです。
つまり、
[,1] [,2] [,3] ---> [,1] [,2] [,3] [,4] [1,] 1 5 9 [1,] 4 3 2 1 [2,] 2 6 10 [2,] 8 7 6 5 [3,] 3 7 11 [3,] 12 11 10 9 [4,] 4 8 12
という変更が必要。
で、こうします。
> (y <- t(x[nrow(x):1,ncol(x):1])[ncol(x):1,]) [,1] [,2] [,3] [,4] [1,] 4 3 2 1 [2,] 8 7 6 5 [3,] 12 11 10 9 > jpeg("image2.jpg",width=720) > layout(t(1:2)) > image(y) > image.plot(y) > dev.off()
ただ、これだけだとアレなので、それぞれの値も記入してみます。
要はグラフは0 ~ 1の間でプロットされていて、等間隔ということ。
> image_text <- function(x,...){ + at_v <- 1/(2*(ncol(x)-1)) + at_v <- seq(0,1+2*at_v,by=at_v)-at_v + at_h <- 1/(2*(nrow(x)-1)) + at_h <- seq(0,1+2*at_h,by=at_h)-at_h + xy <- do.call("rbind",lapply(at_v[seq(2,length(at_v),by=2)] + ,function(x,y) cbind(x,y),y=rev(at_h[seq(2,length(at_h),by=2)]))) + image(t(x[nrow(x):1,ncol(x):1])[ncol(x):1,]) + text(xy,labels=x) + abline(v=at_v[seq(3,length(at_v)-1,by=2)] + ,h=at_h[seq(3,length(at_h)-1,by=2)],col=8) + return(list(v=at_v,h=at_h)) + } > > jpeg("image3.jpg",width=720) > image_text(x) > dev.off()
こんな感じです。
で、何に使えるの？という話ですが…
判別分析のパラメータを振った結果をみたり…
> library(kernlab) > data(spam) > index <- sample(1:dim(spam)[1]) > spamtrain <- spam[index[1:floor(2 * dim(spam)[1]/3)], ] > spamtest <- spam[index[((2 * ceiling(dim(spam)[1]/3)) + 1):dim(spam)[1]], ] > filter <- lapply(seq(2,ncol(spamtrain)-1,by=5),function(i){ + x <- spamtrain[,c(1:i,ncol(spamtrain))] + x <- lapply(seq(0.1,1,by=0.1),function(j) ksvm(type~.,data=x,kernel="rbfdot" + ,kpar=list(sigma=j),C=5,cross=3)) + }) > accuracy <- t(sapply(seq(filter),function(i) sapply(seq(filter[[i]]),function(j){ + x <- predict(filter[[i]][[j]],spamtest[,-58]) + x <- table(x,spamtest[,58]) + sum(x[c(1,4)])/sum(x) + }))) > dimnames(accuracy) <- list(paste("n",seq(2,ncol(spamtrain)-1,by=5),sep="") + ,paste("s",seq(0.1,1,by=0.1),sep="")) > head(round(accuracy,2),3) s0.1 s0.2 s0.3 s0.4 s0.5 s0.6 s0.7 s0.8 s0.9 s1 n2 0.70 0.70 0.70 0.70 0.70 0.70 0.69 0.69 0.70 0.70 n7 0.82 0.82 0.83 0.82 0.82 0.82 0.82 0.82 0.82 0.82 n12 0.84 0.85 0.85 0.85 0.86 0.86 0.86 0.86 0.86 0.85 > > jpeg("image3.jpg",width=720) > at <- image_text(round(accuracy,2),axes=FALSE,xlab="sigma",ylab="params") > mtext(text=colnames(accuracy),side=1,line=0,at=at$v[seq(2,length(at$v),by=2)]) > mtext(text=rownames(accuracy),side=2,line=0,at=rev(at$h[seq(2,length(at$h),by=2)]),las=1) > dev.off()
相関係数のマトリクスを視覚化したり…
> x <- cor(spam[,1:10]) > x[lower.tri(x)] <- NA > jpeg("image4.jpg") > at <- image_text(round(x,2),axes=FALSE) > mtext(text=colnames(x),side=1,line=0,at=at$v[seq(2,length(at$v),by=2)]) > mtext(text=colnames(x),side=2,line=0,at=rev(at$h[seq(2,length(at$h),by=2)]),las=1) > dev.off()
こんなことに使ってました。
前の日記で書いた色の話はまた別の機会に。
