0

siAll さん、これは昨日の多くの質問のフォローアップです。以下にリンクを追加しようとしました

前の質問

最新のコードは次のとおりです。

mypanel <- function(x,y,...) {
  panel.xyplot(x, y, ...)
  panel.grid(x=-1, y=-1)
  panel.lmline(x,y,col="red",lwd=1,lty=1)
  panel.text(200,20,bquote(rho == .(correls[x])),cex=.8, font = 2,col="black")
} 

correls <- as.vector(cor(x=mtcars[,2:3],y=mtcars[,1]))
correls<- round(coeff,3)
names(correls)<-names(mtcars[,2:3])

data <- mtcars[,2:3]
charts <- lapply(names(data), function(x) { xyplot (mtcars[,1] ~ mtcars[,x], 
                                                    panel=mypanel,ylab="MPG", xlab=x)})

コードにはラティスだけでなくデータセット mtcars も必要であり、LtticeExtra も必要になる可能性があると思います。

ご覧のとおり、相関係数を計算してグラフに追加したいと思います。テキスト gest が追加されましたが、2 つの問題があります。

  1. correls[x] の部分が思い通りに評価されていません。NA が返されます (コンソールでは単独で動作しますが、エラーを見つけるために常にチェックしています)。私はそれを修正する方法を知らないようです.ポインターでも役立つでしょう.脚の仕事を喜んで行います
  2. 一部のチャートでは座標が機能しません。これはラップリーで実行されているため、一部が表示されないことを意味します。この場合、最初のチャートではなく、2 番目のチャートでは有効です)。場所を自動にすることは可能ですか？何を探すべきか、何を使うべきかを示す単なる指針としていただければ幸いです

再度、感謝します

マリオ

更新、パネル番号で提案されたソリューションは機能しません。各チャートはlapplyによって個別に作成されるため、常に1であるため、必要なものが得られません。コードを修正して、配置と開始座標を処理しようとしました。ただし、常に表示されるとは限らず、何らかの理由で correl からの間違った要素も表示されるため、チャート1などを使用して手動でチャートを印刷する必要があることがわかります。

ここに最新のコードがあります

mypanel <- function(x,y,...) {
  panel.xyplot(x, y, ...)
  panel.grid(x=-1, y=-1)
  panel.lmline(x,y,col="red",lwd=1,lty=1)
  panel.text(xmax[x],ymax,bquote(rho == .(correls[x])),pos=4,cex=1, font = 2,col="black")
} 

correls <- as.vector(cor(x=mtcars[,2:10],y=mtcars[,1]))
correls<- round(correls,3)
names(correls)<-names(mtcars[,2:10])
xmax <-sapply(mtcars[,2:10],max)
names(xmax) <- names(mtcars[,2:10])
xmax<-floor(xmax)
ymax <- floor(max(mtcars[,1]))


data <- mtcars[,2:10]
charts <- lapply(names(data), function(x) { xyplot (mtcars[,1] ~ mtcars[,x], 
                                                    panel=mypanel,ylab="MPG", xlab=x,
                                                    xlim=c(0,ceiling(max(mtcars[,x])))
                                                  ,ylim=c(0,ceiling(max(mtcars[,1]))))})

ポインタをありがとう

マリオ

4

1 に答える 1

0

私は最終的にそれを解決し、私が見つけた関数 multiplot と ggplot2 を使用しました。これは主に、それが私にとってより意味があり (その構文)、チャートの外観が気に入ったためです。

「Cookbook for R」で見つけた multiplot 関数を含むコード全体を次に示します (どうもありがとうございました)。

これは、データとして使用されるデータセットの名前を変更する必要があるため、さらに改善できます。そのすべてを関数に含めることができることはわかっていますが、今のところ、これはそれほど面倒ではありません。

これが誰かに役立つことを願っています。

最後に、私はテキストの配置についてはあまり満足していないと言いたいです。理想的には空白を探しますが、それはそれほど簡単ではないと思います。誰かが方法を知っている場合は、自由に共有してください。

#You need to create an object called my data with your data.frame
#the process will create charts of correlations for the first column versus all others
#and then arrange them in a lattice patter.
#It uses the multiplot function that I found as well as ggplot2

mydata<-mtcars

library(ggplot2)
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  require(grid)

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)

  numPlots = length(plots)

  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }

  if (numPlots==1) {
    print(plots[[1]])

  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

mychart <- function(x) {
  c <- round(cor(mydata[,1],mydata[x]),3)
  xmax <-ceiling(max(mydata[,x]))
  xmin <- floor(min(mydata[,x]))
  xpos = floor(max(mydata[,x])*(8/10))
  ypos = floor(max(mydata[,1])*(8/10))
  t = paste("rho ==",c,sep="")
  t1 <- annotate("text",x=xpos,y=ypos,label=t,parse=TRUE,color="red")
  p <- qplot(mydata[,x],mydata[,1],xlab=x,ylab=names(mydata)[1],color=I("blue"))
  s <- stat_smooth(aes(x=mydata[,x],y=mydata[,1]),method="lm",color="red",se=FALSE)
  a <- annotate("text",x=xpos,y=ypos,label=t,parse=TRUE,color="red")
  p<- p+s+a+xlim(xmin,xmax)

}


charts <- NULL
l1 <- NULL
for (i in 2:(length(mydata))) {
  charts[[i]]<- mychart(names(mydata)[i])
}

numcols <- ceiling(sqrt(length(mydata)-1))

multiplot(plotlist=charts[2:length(mydata)],cols=numcols)
于 2013-01-18T04:13:26.293 に答える