Using xyplot within custom function with panel function in R

Question

I'm trying to generate a custom xyplot in the lattice graphics package. It is a plot of two lines with range limits plotted.

# Raw dataframe in long format
df <- data.frame(
    Response = c(runif(100), rnorm(100)),
    Trial = c(rep("A", 100), rep("C", 100)),
    Year = 1:10, 
    Rep = rep(1:10, each = 10))

# Aggregate the data (take mean/min/max across "Rep" variable
gdf <- do.call(data.frame, aggregate(Response ~ Year + Trial, data = df, 
    FUN = function(x) c(avg = mean(x), mini = min(x), maxi = max(x))))


# Plot using xyplot (without making this a function)
my.panel.bands <- function(x, y, upper, lower, fill, col,
    subscripts, ..., font, fontface){
    upper <- upper[subscripts]
    lower <- lower[subscripts]

    panel.polygon(c(x, rev(x)), c(upper, rev(lower)),
    col = fill, alpha = 0.2, border = FALSE, ...)
}


f1 <- formula(Response.avg ~ Year)

p <- xyplot(x = f1, data = gdf, groups = Trial,
            col=c("red", "blue"), pch = 16,
            scales = list(x = list(rot = 45)),
            xlab = 'Year', ylab = 'Response',
            layout = c(1, 1),
            ylim = c(min(gdf$Response.mini), max(gdf$Response.maxi)),
            upper = gdf$Response.maxi, 
            lower = gdf$Response.mini,
             panel = function(x, y, ...){
                 panel.superpose(x, y, panel.groups = my.panel.bands, 
                 type = 'l', fill = c("red", "blue"),...)
               panel.xyplot(x, y, type = 'b', cex = 0.6, lty = 1, ...)
             }
)

png("panel_plot.png")
print(p)
dev.off()

However, if I try to make a custom function out of this xyplot command then I get a very different plot to what I was expecting. I'm assuming I'm doing something incorrect with passing the grouping variable or in using the panel function.

panel_plot <- function(f, df, grouper, xlabel, ylabel, 
    ylim, upper_border, lower_border, mfcol){

    p <- xyplot(x = f, data = df, groups = eval(grouper),
         col = c("red", "blue"), pch = 16,
         scales = list(x = list(rot = 45)),

         xlab = xlabel, ylab = ylabel,
         ylim = ylim,
         layout = mfcol,
         upper = upper_border,
         lower = lower_border,

         panel = function(x, y, ...){
             panel.superpose(x, y, panel.groups = my.panel.bands, 
             type = 'l', fill = c("red", "blue"),...)
           panel.xyplot(x, y, type = 'b', cex = 0.6, lty = 1, ...)
         }
    )
    return(p)
}

f1 <- formula(Response.avg ~ Year)

p <- panel_plot(f1, gdf, grouper = Trial, 
    xlabel = "Year", ylabel = "Response", 
    ylim = c(min(gdf$Response.mini),max(gdf$Response.maxi)),
    upper_border = gdf$Response.maxi, 
    lower_border = gdf$Response.mini,
    mfcol = c(1, 1))

png("panel_plot_asfunction.png")
print(p)
dev.off()

Finally, if I pass the name of the variable to the group argument as a string and modify the panel_plot() function to redefine a new variable in the data.frame, then it works as expected but this seems like a strange way to do things.

panel_plot <- function(f, df, grouper, xlabel, ylabel, 
    ylim, upper_border, lower_border, mfcol){

    df$grouper <- df[, grouper]
    p <- xyplot(x = f, data = df, groups = grouper,
    ... 

p <- panel_plot(f1, gdf, grouper = "Trial", 
    ...

How do I define the panel_plot function so that I don't have to create a dummy column and can pass the variable name (Trial) to this function so that it is not passed as a string?

I've tried using the suggestion here but using eval() on the variable name provided the unexpected figure above.

Answer 1

Actually, consider combining both solutions of your linked SO post using match.call() list and eval(call(), ...). By themselves alone neither worked on my end.

panel_plot <- function(f, df, grouper, xlabel, ylabel, 
                       ylim, upper_border, lower_border, mfcol){

  ll <- as.list(match.call(expand.dots = FALSE)[-1])

  my_panel <- function(x, y, ...){
    panel.superpose(x, y, panel.groups = my.panel.bands, 
                    type = 'l', fill = c("red", "blue"),...)
    panel.xyplot(x, y, type = 'b', cex = 0.6, lty = 1, ...)
  }

  p <- eval(call("xyplot", 
                 x = ll$f, 
                 data = ll$df,
                 groups = ll$grouper, 
                 xlab = ll$xlabel, ylab = ll$ylabel,
                 ylim = ll$ylim,
                 layout = ll$mfcol,
                 upper = ll$upper_border,
                 lower = ll$lower_border,
                 panel = my_panel
                )
           )
  return(p)
}

f1 <- formula(Response.avg ~ Year)

p <- panel_plot(f1, gdf, grouper = Trial, 
                xlabel = "Year", ylabel = "Response", 
                ylim = c(min(gdf$Response.mini), max(gdf$Response.maxi)),
                upper_border = gdf$Response.maxi, 
                lower_border = gdf$Response.mini,
                mfcol = c(1, 1))  
p

However, aesthetics are not exactly the same such as red and blue lines and points. Possibly this is because eval(call(...)) requires all arguments to be specified? Try adjusting arguments or my_panel.

---

Alternatively, use your dummy column but still pass unquoted name and evaluate column name with eval. Here, aesthetics render as desired non-function version.

panel_plot <- function(f, df, grouper, xlabel, ylabel, 
                       ylim, upper_border, lower_border, mfcol){

  df$grouper <- eval(as.name(deparse(substitute(grouper))), df, .GlobalEnv)

  p <- xyplot(x = f, data = df, groups = grouper,
  ...
}