r - 在对角线中针对公共(public)垂直轴变量绘制 pairs() 变量的函数

Question

我正在尝试定义一个函数来生成跨越成对图对角线的散点图。诀窍是我想在 panel.splot 函数中指定垂直轴。最终我认为这里的用途是在对角线上可视化时间序列。举一个简单的例子，虽然我想用鸢尾花数据集试试这个，并使用 Species 作为垂直轴变量。下面的图产生了一个漂亮的图:

pairs(iris[,c(1:4)])

所以现在我需要为对角线面板定义一个函数。这是我到目前为止的努力:

panel.splot <- function(x, yvar,...)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(0, 2, usr[3:4]))
  plot(yvar,x, xlim=c(min(x),max(x)))
}

但是，当我尝试运行它时，我收到一条错误消息，我不确定如何解释。

pairs(iris[,c(1:4)],diag.panel=panel.splot(x=x, yvar="Species"))

Error in plot.window(...) : invalid 'xlim' value
In addition: Warning messages:
1: In xy.coords(x, y, xlabel, ylabel, log) : NAs introduced by coercion
2: In xy.coords(x, y, xlabel, ylabel, log) : NAs introduced by coercion
3: In min(x) : no non-missing arguments to min; returning Inf
4: In max(x) : no non-missing arguments to max; returning -Inf

我找不到另一个这样的例子。许多其他功能可以创建不同类型的图，但没有一个能做到这一点。

为清楚起见，这是我想象的沿着 pairs() 调用的对角线生成的绘图类型:

plot(iris$Species,iris$Petal.Width)

Answer 1

尽管有您的示例图，但由于使用 Species 作为垂直轴变量，我对此的解释略有不同(错误)。休伯特给出了答案，但认为它可能会增加一些东西。

使用pairs()

panel.splot <- function(Y, Adjust=0.2){
                    function(x, y=Y, adjust=Adjust)
                    {
                     usr <- par("usr"); on.exit(par(usr))
                     xs <- range(x)
                     ys <- if(is.factor(y)) c(1, nlevels(y)) else range(y)
                     par(usr = c(xs[1], xs[2], ys[1], ys[2]) + c(-adjust, adjust))
                     points(x, y)
                    }
                 }

pairs(iris[, 1:4], diag.panel=panel.splot(Y=iris$Species))

产生

要用 ggpairs() 做同样的事情，你还可以定义一个用户函数

library(GGally)
library(ggplot2)    

# Define diagonal function
diag_fun <- function(data, mapping, ...){
      ggplot(data = data, mapping = mapping) + 
      geom_point(...) 
      }

ggpairs(iris, columns=1:4, 
        diag = list(continuous = diag_fun, mapping=aes(y=Species)))

哪个给

---

更新您的评论...

是的，对于对角线条目，变量作为 x 映射传递。您可以使用 coord_flip() 或在函数中反转映射。下面的函数执行此操作，并使用 annotate() 添加变量名称(附注:您应该能够将 _point geom 换成 _boxplot

diag_fun <- function(data, mapping, xnudge=0.95, ynudge=1, pts=lst(), ...){

    # create range for annotate
    lbl <- as.character(mapping$x)
    xmax <- max(data[, as.character(mapping$x)], na.rm=TRUE)
    ymax <- mean(seq(nlevels(data[,as.character(mapping$y)]))) 

    # reverse mapping so no need for coord_flip() 
    tmp <- mapping$y
    mapping$y <- mapping$x
    mapping$x <- tmp

    ggplot(data=data, mapping=mapping) + 
      do.call(geom_point, pts) +
      annotate("text", x=ynudge*ymax, y=xnudge*xmax, label=lbl, ...)
      }

所以在 ggpairs 中使用默认值

ggpairs(iris, columns=1:4,  diag = list(continuous = diag_fun, mapping=aes(y=Species)))

你可以使用wrap来传递更多的参数

ggpairs(iris, columns=1:4,  
        diag = list(continuous = 
                      wrap(diag_fun, 
                           size=10, col="red", # make changes to the text label
                           pts=list(colour="blue")), # make changes to geom_point
                    mapping=aes(y=Species)))