如何在点阵图中添加多个模型评估参数？

Question

我正在尝试在lattice 图中自动添加多个模型评估参数。我正在使用以下代码

library(lattice)
library(tidyverse)
library(hydroGOF)

#Calculation of model evaluation parameters
summ <- iris %>% 
  group_by(Species) %>% 
  summarise(Rsq = cor(Sepal.Length, Petal.Length)^2,
            RMSE = RMSE(Sepal.Length, Petal.Length),
            NSE = NSE(Sepal.Length, Petal.Length)) %>% 
  mutate_if(is.numeric, round, digits=2)

#Make multipanel plot 
xyplot(Petal.Length ~ Sepal.Length | Species, data = iris, pch = 23, 
       layout=c(3,1), type = c("p", "r"),
       scales=list(cex=c(1.4,1.4), alternating=1, relation = "free"),
       xlab = list(label="Sepal Length", fontsize=20),
       ylab = list(label="Petal Length", fontsize=20))

这给了我以下情节

现在我怎样才能使用lattice 包获得以下情节

编辑

虽然将马赛克 package 中的 panel.lmbands 添加到解决方案 (1) 和 (3) 中，但我无法使用解决方案 (2) 实现它。这是代码

library(mosaic)
p2 <- xyplot(Petal.Length ~ Sepal.Length | Species, data = iris, pch = 23, 
             layout=c(3,1), 
             band.lty = c(conf =2, pred = 1), 
             band.lwd =c(conf =1, pred = 1),
             npts = 500,
             panel = panel.lmbands,
             scales=list(cex=c(1.4,1.4), alternating=1, relation = "free"),
             xlab = list(label="Sepal Length", fontsize=20),
             ylab = list(label="Petal Length", fontsize=20),
             panel = function(x, ...) {
               i <- panel.number()
               panel.xyplot(x, ...)
               panel.key(as.expression(summ$ann[[i]]), points = FALSE)
             })
p2

它返回我以下错误

xyplot.formula 中的错误（Petal.Length ~ Sepal.Length | Species, data = iris, : 由多个实际参数匹配的形式参数“面板”

预期的输出将如下所示

Answer 1

格有三种方法。 summ 在 (1) 中计算，除了 RMSE 在 hydroGOF 中是 rmse 之外，我们添加了一个包含注释的 ann 列。 summ 也用于 (2) 和 (3)。 (1) 中的 p 使用与问题中相同的代码，并且在 (3) 中再次使用它而无需更改。全部使用来自 latticeExtra 的panel.key，（3）也使用来自 latticeExtra 的layer。

1) trellis.focus 我们可以在事后使用trellis.focus/trellis.unfocus 来修改面板。

library(latticeExtra)
library(dplyr)
library(hydroGOF)

#Calculation of model evaluation parameters
summ <- iris %>% 
  group_by(Species) %>% 
  summarise(Rsq = cor(Sepal.Length, Petal.Length)^2,
            RMSE = rmse(Sepal.Length, Petal.Length),
            NSE = NSE(Sepal.Length, Petal.Length)) %>% 
  mutate_if(is.numeric, round, digits=2)

summ$ann <- lapply(1:nrow(summ), function(i) with(summ[i, ], 
  c(bquote(R^2 == .(Rsq)), bquote(RMSE == .(RMSE)), bquote(NSE == .(NSE))))
)

#Make multipanel plot 
p <- xyplot(Petal.Length ~ Sepal.Length | Species, data = iris, pch = 23, 
       layout=c(3,1), type = c("p", "r"),
       scales=list(cex=c(1.4,1.4), alternating=1, relation = "free"),
       xlab = list(label="Sepal Length", fontsize=20),
       ylab = list(label="Petal Length", fontsize=20))
p
for(i in 1:nrow(summ)) {
  trellis.focus("panel", i, 1)
  pno <- panel.number()
  panel.key(as.expression(summ$ann[[i]]), points = FALSE)
  trellis.unfocus()
}

2) 面板函数 我们定义了指示面板函数，它利用panel.number() 来绘制正确的文本。

p2 <- xyplot(Petal.Length ~ Sepal.Length | Species, data = iris, pch = 23, 
       layout=c(3,1), type = c("p", "r"),
       scales=list(cex=c(1.4,1.4), alternating=1, relation = "free"),
       xlab = list(label="Sepal Length", fontsize=20),
       ylab = list(label="Petal Length", fontsize=20),
       panel = function(x, ...) {
         i <- panel.number()
         panel.xyplot(x, ...)
         panel.key(as.expression(summ$ann[[i]]), points = FALSE)
       })
p2

3) latticeExtra::layer 在 latticeExtra 中使用 layer 的层允许使用 + 以与 ggplot2 中类似的方式将层添加到格子图中。

p3 <- p
for(i in 1:nrow(summ)) {
  p3 <- p3 + 
    layer(panel.key(as.expression(ann), points = FALSE), 
      data = list(ann = summ$ann[[i]]), packets = i)
}
p3

以上任何一个都给出这个：