Search code examples
rlattice

How to add multiple model evaluation parameters in lattice plot?

I am trying to automatically add multiple model evaluation parameters in lattice plot. I am using the following code

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

which gives me the following plot enter image description here

Now how can I have the following plot using lattice package enter image description here

Edit

While adding panel.lmbands from mosaic package to solutions (1) and (3) works but I was unable to achieve it using solution (2). Here is the code

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

It returns me following error

Error in xyplot.formula(Petal.Length ~ Sepal.Length | Species, data = iris, : formal argument "panel" matched by multiple actual arguments

The expected output will look like the following

enter image description here

Solution

  • There are three approaches with lattice. summ is calculated in (1) as in the question except RMSE is rmse in hydroGOF and we add an ann column which contains the annotations. summ is also used in (2) and (3). p in (1) uses the same code as in the question and it is used again without change in (3). All use panel.key from latticeExtra and (3) also uses layer from latticeExtra.

    1) trellis.focus We can use trellis.focus/trellis.unfocus to modify panels after the fact.

    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 function We define the indicated panel function which makes use of panel.number() to draw the correct text.

    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 Layers using layer in latticeExtra allow one to add layers to a lattice plot using + in a similar way that is done in 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

    Any of the above give this:

    screenshot