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）传递给该函数，这样就不会将其作为串？

我尝试使用建议here，但在变量名称上使用eval()提供了上面的意外数字。

Answer 1

实际上，请考虑使用match.call()列表和eval(call(), ...)组合linked SO post的两个解决方案。独自一人都没有对我有帮助。

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

在R

1 个答案: