Использование xyplot в пользовательской функции с функцией панели в R

Question

Я пытаюсь сгенерировать пользовательский xyplot в графическом пакете lattice. Это график из двух линий с ограничением диапазона.

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

Однако, если я попытаюсь сделать пользовательскую функцию из этой команды xyplot, я получу график, совершенно отличный от того, что я ожидал. Я предполагаю, что я делаю что-то неправильно, передавая переменную группировки или используя функцию панели.

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

Наконец, если я передам имя переменной аргументу group в виде строки и изменим функцию panel_plot(), чтобы переопределить новую переменную в data.frame, то она будет работать, как и ожидалось, но это похоже на странный способ делать вещи.

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", 
    ...

Как определить функцию panel_plot, чтобы мне не нужно было создавать фиктивный столбец, и я мог передать имя переменной (Trial) этой функции, чтобы она не передавалась в виде строки?

Я попытался использовать предложение здесь , но использование eval() для имени переменной дало неожиданный результат выше.

Answer 1

На самом деле, рассмотрите возможность объединения обоих решений вашей связанной SO-записи с использованием списка match.call() и eval(call(), ...). Сами по себе ни один не работал на моем конце.

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

Однако эстетика не совсем такая, как красные и синие линии и точки. Возможно, это связано с тем, что eval(call(...)) требует указания всех аргументов? Попробуйте настроить аргументы или my_panel .

---

В качестве альтернативы, используйте ваш фиктивный столбец, но все равно передайте имя без кавычек и оцените имя столбца с помощью eval. Здесь эстетика отображает желаемую нефункциональную версию.

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,
  ...
}