Question

SiAll，这是对昨天的muy问题的跟进。下面我尝试添加一个链接

最新代码是：

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。

如您所见，我计算了相关系数，并希望将它们添加到图表中。添加了文本，但有两个问题：

部分correls [x]没有按照我的意愿进行评估，我得到了一个NA（虽然它在控制台中自行运行，但我总是检查一下以查找错误）。我似乎不知道如何解决这个问题，即使指针有帮助，我也很乐意做腿部工作
在某些图表中，坐标不起作用，因为它在lapply中运行，这意味着一些不可见。在这种情况下，不是第一个图表，第二个是的是）。是否可以自动定位？

再次感谢

马里奥

更新，使用面板编号建议的解决方案确实是snot工作，每个图表都是由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]))))})

再次感谢任何指针

马里奥

Answer 1

我终于解决了它，我使用了我发现的函数multiplot和ggplot2，主要是因为它对我（它的语法）更有意义，因为我喜欢它的图表外观。

以下是整个代码，包括我在“Cookbook for R”中找到的多重绘图功能（非常感谢）。

这可以进一步改进，因为现在我需要重命名用作我的数据的数据集。我意识到我可以把所有这些都包含在一个函数中，但是现在这对我来说并不是太麻烦。

我希望这有助于某人。

最后，我会说我对文本放置不是很满意，理想情况下它会寻找空白空间，但我想这不会那么容易。如果有人知道如何随意分享。

#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)

将文本表达式添加到xy图，自动定位

1 个答案: