Sweave関数について少し...・その2
その続き…
最近、Sweave関数もLaTexも使って無いので、動かないかもしれませんが…
で、グラフが描けるようになると、次はtableも少し凝ってみたりして、
- xtableの各行を墨塗りで色分けする
- xtableの特定のセルに色をつける
普通はこんな感じと思います。
> library(xtable) > xtable(x) % latex table generated in R 2.14.0 by xtable 1.6-0 package % Sat Dec 10 22:47:18 2011 \begin{table}[ht] \begin{center} \begin{tabular}{rrrrrr} \hline & A & B & C & D & E \\ \hline a & 3 & 4 & 5 & 5 & 2 \\ b & 4 & 2 & 4 & 3 & 5 \\ c & 4 & 4 & 2 & 1 & 3 \\ d & 1 & 5 & 1 & 3 & 3 \\ e & 3 & 4 & 2 & 3 & 5 \\ \hline \end{tabular} \end{center} \end{table}
でも、行数が増えると少し見づらくなるので、n行毎に背景を墨塗りしたくなりました。
あと、セルに色をつけたいとか…
> xtable.col <- function(dat,text.col=FALSE,hline.start=5,hline.stop=nrow(dat),hline.by=5,digits=NULL,caption=NULL,out=TRUE,floating=FALSE,...){ + library(xtable) + if(is.data.frame(dat)) dat <- as.matrix(dat) + if(!is.null(digits)){ + dat <- apply(dat,c(1,2),function(x){ + y <- round(as.numeric(sub("@.*","",x)),digits) + if(sum(grep("@",x))>0) y <- paste(y,sub(".*@","",x),sep="@") + return(y) + }) + } + if(!is.null(caption)) caption <- paste("\n\n\\caption{",caption,"}\n\n",sep="") + cat("\n\n\n\n% delete line start\n\n\n\n") + ifelse(hline.start < nrow(dat) + ,hline <- seq(hline.start,hline.stop,by=hline.by) + ,hline <- nrow(dat) + ) + if(rev(hline)[1] < nrow(dat)) hline <- c(hline,nrow(dat)) + tex <- print(xtable(dat,digits=digits),hline.after=c(-1,0,hline),floating=floating,...) + cat("\n\n\n\n% delete line end\n\n\n\n") + tex <- unlist(strsplit(tex,split="\n")) + if(length(hline) > 1){ + x <- grep("hline",tex)[-c(1:2)] + for(i in seq(1,length(x),by=2)){ + if(i!=length(x)) + tex[seq(x[i]+1,x[i+1]-1)] <- paste("\\rowcolor[gray]{0.9}",tex[seq(x[i]+1,x[i+1]-1)],sep="") + } + tex <- tex[-x[-length(x)]] + } + tex <- sub("^[[:space:]]*","",sub("[[:space:]]*$","",tex)) + tex <- tex[-grep("^%",tex)] + tex <- tex[nchar(tex)>0] + if(text.col) + while(length(grep("([^[:space:]]*)@([^[:space:]]*)(.*)",tex))>0) tex <- gsub("([^[:space:]]*)@([^[:space:]]*)(.*)","\\\\textcolor{\\2}{\\1}\\3",tex) + tex <- paste(paste(tex,collapse="\n"),if(!is.null(caption))caption,"\n\n",sep="") + if(out) cat(tex) + return(tex) + }
こんな関数を準備して、matrixかdata.frameに適用します。
このとき、色をつけたいセルは"@色"をpaste関数で指定しておきます。
> dat <- data.frame(matrix(rnorm(12),ncol=3,dimnames=list(1:4,LETTERS[1:3]))) > # @redで赤に指定 > dat[2,3] <- paste(dat[2,3],"red",sep="@") > dat A B C 1 1.5499489 0.10679942 1.33112203043735 2 0.2980515 -0.27075401 -0.290728695678007@red 3 -1.5915671 -0.07261504 0.510817423730298 4 -0.3947731 -0.69614812 -0.660419346061289 > > xtable.col(dat,digit=2,hline.start=2,text.col=TRUE) % delete line start % latex table generated in R 2.14.0 by xtable 1.6-0 package % Sat Dec 17 13:09:16 2011 \begin{tabular}{rlll} \hline & A & B & C \\ \hline 1 & 0.02 & 1.64 & 1.28 \\ 2 & 0.2 & 0.69 & 0.13@red \\ \hline 3 & -1.59 & -1.41 & -0.79 \\ 4 & -0.3 & -0.16 & -1.66 \\ \hline \end{tabular} % delete line end \begin{tabular}{rlll} \hline & A & B & C \\ \hline 1 & 0.02 & 1.64 & 1.28 \\ 2 & 0.2 & 0.69 & \textcolor{red}{0.13} \\ \rowcolor[gray]{0.9}3 & -1.59 & -1.41 & -0.79 \\ \rowcolor[gray]{0.9} 4 & -0.3 & -0.16 & -1.66 \\ \hline \end{tabular} [1] "\\begin{tabular}{rlll}\n\\hline\n& A & B & C \\\\\n\\hline\n1 & 0.02 & 1.64 & 1.28 \\\\\n2 & 0.2 & 0.69 & \\textcolor{red}{0.13} \\\\\n\\rowcolor[gray]{0.9}3 & -1.59 & -1.41 & -0.79 \\\\\n\\rowcolor[gray]{0.9} 4 & -0.3 & -0.16 & -1.66 \\\\\n\\hline\n\\end{tabular}\n\n"
で、出力したsnwファイルから、% delete line start ~ % delete line end、までをrubyで整形してplatex -> dvipdfmxしてました。
当時は、xtable関数そのものを書き換える力もなく、こんなスパゲティーコードでした。
恥ずかしい限りです…
