37

我想编写一个同时调用plot()and的函数，legend()如果用户可以指定许多附加参数，然后将这些参数传递给plot()or 或，那将是理想的legend()。我知道我可以使用以下两个功能之一来实现这一点...：

foo.plot <- function(x,y,...) {
    plot(x,y,...)
    legend("bottomleft", "bar", pch=1)
}

foo.plot(1,1, xaxt = "n")

这传递xaxt = "n"给情节。但是有没有一种方法可以在不预先指定函数头中的参数的情况下传递title = "legend"给调用？legend()

接受答案的更新：我认为 VitoshKa 的方式是完成我想要的最优雅的方式。但是，我必须解决一些小问题，直到它按我的意愿工作。

起初，我检查了我要传递哪些参数legend以及要传递哪些参数plot。为此的第一步是查看哪些参数legend是唯一的，legend而不是情节和/或标准的一部分：

legend.args <- names(formals(legend))
plot.args <- c(names(formals(plot.default)), names(par()))
dput(legend.args[!(legend.args %in% plot.args)])

我dput()在这里使用，因为这条线plot.args <- c(names(formals(plot.default)), names(par()))总是调用一个我不想要的新空图。所以，我dput在下面的函数中使用了输出。

接下来，我必须处理重叠的参数（通过 获取它们dput(largs.all[(largs.all %in% pargs.all)])）。对于一些人来说这是微不足道的（例如，，x），y其他人则被传递给两个函数（例如，pch）。但是，在我的实际应用程序中，我什至使用了其他策略（例如，不同的变量名称用于adj，但未在此示例中实现）。

最后，do.call必须以两种方式更改该功能。首先，what 部分（即，称为函数）需要是一个字符（即，'plot'而不是plot）。并且参数列表的构造必须略有不同。

foo.plot <- function(x,y,...) {
    leg.args.unique <- c("legend", "fill", "border", "angle", "density", "box.lwd", "box.lty", "box.col", "pt.bg", "pt.cex", "pt.lwd", "xjust", "yjust", "x.intersp", "y.intersp", "text.width", "text.col", "merge", "trace", "plot", "ncol", "horiz", "title", "inset", "title.col", "title.adj")
    leg.args.all <- c(leg.args.unique, "col", "lty", "lwd", "pch", "bty", "bg", "cex", "adj", "xpd")
    dots <- list(...)
    do.call('plot', c(list(x = x, y = x), dots[!(names(dots) %in% leg.args.unique)]))
    do.call('legend', c(list("bottomleft", "bar"), dots[names(dots) %in% leg.args.all]))
}


foo.plot(1,1,pch = 4, title = "legendary", ylim = c(0, 5))

在此示例中，pch传递给两者plot和legend，title仅传递给legend，并且ylim仅传递给plot。

根据 Gavin Simpson 的评论更新 2（另请参阅 Vitoshka 的回答中的评论）：（
i）这是正确的。
(ii) 它总是可以是一个字符。但是如果你有一个与函数同名的变量，那么你需要在中引用函数名do.call：

min.plot <- function(x,y,plot=TRUE) if(plot == TRUE) do.call(plot, list(x = x, y = y))
min.plot(1,1)
Error in do.call(plot, list(x = x, y = y)) : 
  'what' must be a character string or a function

（iii）您可以使用c(x = 1, y = 1, list())并且效果很好。但是，我真正所做的（不是在我给出的示例中，而是在我的实际函数中）如下：c(x = 1, y = 1, xlim = c(0, 2), list(bla='foo'))
请将其与以下情况进行比较：c(list(x = 1, y = 1, xlim = c(0, 2)), list(bla='foo'))
在第一种情况下，列表包含两个元素和xlim（每个都是标量），在后一种情况下该列表只有（这是长度为 2 的向量，这是我想要的）。xlim1xlim2xlim

所以，对于我的例子，你的所有观点都是正确的。但是，对于我的实际功能（有更多变量），我遇到了这些问题，并想在这里记录它们。抱歉不准确。

4

4 回答 4

25

自动方式：

foo.plot <- function(x,y,...) {
    lnames <- names(formals(legend))
    pnames <- c(names(formals(plot.default)), names(par()))
    dots <- list(...)
    do.call('plot', c(list(x = x, y = x), dots[names(dots) %in% pnames]))
    do.call('legend', c("bottomleft", "bar", pch = 1, dots[names(dots) %in% lnames]))
}

pch 必须从 lnames 中过滤，以避免在legend用户提供“pch”的情况下调用重复，但你明白了。由 Carl W 于 2012 年 1 月编辑：“do.call”仅适用于引号中的函数，如 Henrik 的更新。我在这里对其进行了编辑以避免将来的混乱。

于 2010-11-08T21:47:33.033 回答
18

这些事情变得棘手，如果不在函数中指定额外的参数，就没有简单的解决方案。如果您...同时使用plotand调用，则在传入特定参数legend时最终会收到警告。legend例如，使用：

foo.plot <- function(x,y,...) {
    plot(x,y,...)
    legend("bottomleft", "bar", pch = 1, ...)
}

您会收到以下警告：

> foo.plot(1, 1, xjust = 0.5)
Warning messages:
1: In plot.window(...) : "xjust" is not a graphical parameter
2: In plot.xy(xy, type, ...) : "xjust" is not a graphical parameter
3: In axis(side = side, at = at, labels = labels, ...) :
  "xjust" is not a graphical parameter
4: In axis(side = side, at = at, labels = labels, ...) :
  "xjust" is not a graphical parameter
5: In box(...) : "xjust" is not a graphical parameter
6: In title(...) : "xjust" is not a graphical parameter

有一些方法可以解决这个问题，请参阅plot.default并将其本地函数定义为诸如axis等之类的函数的包装器，box您将拥有诸如localPlot()包装器、内联函数之类的东西并调用它而不是plot()直接调用它。

bar.plot <- function(x, y, pch = 1, ...) {
    localPlot <- function(..., legend, fill, border, angle, density,
                          xjust, yjust, x.intersp, y.intersp,
                          text.width, text.col, merge, trace, plot = TRUE, ncol,
                          horiz, title, inset, title.col, box.lwd,
                          box.lty, box.col, pt.bg, pt.cex, pt.lwd) plot(...)
    localPlot(x, y, pch = pch, ...)
    legend(x = "bottomleft", legend = "bar", pch = pch, ...)
}

（'plot'参数需要默认值的原因超出了我的理解，但是如果不给它默认值，它将无法工作TRUE。）

现在这可以在没有警告的情况下工作：

bar.plot(1, 1, xjust = 0.5, title = "foobar", pch = 3)

例如，您如何处理图形参数bty将取决于您 -bty将影响绘图框类型和图例框类型。另请注意，我的处理方式'pch'不同，因为如果有人在调用中使用该参数bar.plot()，您将是 i) 在图例/情节中使用不同的字符，并且您会收到关于'pch'匹配两次的警告或错误。

如您所见，这开始变得非常棘手......

Joris 的回答提供了一个有趣的解决方案，我评论它让我想起了函数中的控制列表参数，例如lme(). 这是我的 Joris' Answer 版本，实现了这个控制列表的想法：

la.args <- function(x = "bottomleft", legend = "bar", pch = 1, ...)
    c(list(x = x, legend = legend, pch = pch), list(...))

foo.plot <- function(x,y, legend.args = la.args(), ...) {
    plot(x, y, ...)
    do.call(legend, legend.args)
}

像这样工作，使用 Jori 的第二个示例调用，适当修改：

foo.plot(1,1, xaxt = "n", legend.args=la.args(bg = "yellow", title = "legend"))

您可以在设置la.args()函数时尽可能完整 - 这里我只为 Joris 设置的参数设置默认值，并连接任何其他参数。如果la.args()包含所有带有默认值的图例参数会更容易。

于 2010-11-08T15:36:06.967 回答
6

一种解决方法是将参数列表与do.call. 这不是最漂亮的解决方案，但它确实有效。

foo.plot <- function(x,y,legend.args,...) {
    la <- list(
        x="bottomleft",
        legend="bar",
        pch=1
    )
    if (!missing(legend.args)) la <- c(la,legend.args)
    plot(x,y,...)
    do.call(legend,la)
}
foo.plot(1,1, xaxt = "n")    
foo.plot(1,1, xaxt = "n",legend.args=list(bg="yellow",title="legend"))

一个缺点是您不能在legend.args 列表中指定例如pch=2。你可以用一些 if 子句来解决这个问题，我会留给你进一步摆弄它。

编辑：查看 Gavin Simpson 的答案以获得更好的这个想法。

于 2010-11-08T15:34:26.730 回答
3

我们可以构建一个formalize函数，使任何函数与点兼容：

formalize <- function(f){
  # add ... to formals
  formals(f) <- c(formals(f), alist(...=))
  # release the ... in the local environment
  body(f)    <- substitute({x;y},list(x = quote(list2env(list(...))),y = body(f)))
  f
}

foo.plot <- function(x,y,...) {
  legend <- formalize(legend) # definition is changed locally
  plot(x,y,...)
  legend("bottomleft", "bar", pch = 1, ...)
}    

foo.plot(1,1, xaxt = "n", title = "legend")

但是它会显示警告，因为 plot 正在接收它不期望的参数。

我们可以suppressWarnings在 plot 调用中使用（但它显然会抑制所有警告），或者我们可以设计另一个函数来使plot函数（或任何函数）在本地更能容忍点：

casualize <- function(f){
  f_name <- as.character(substitute(f))
  f_ns   <- getNamespaceName(environment(f))
  body(f) <- substitute({
      # extract all args
      args <- as.list(match.call()[-1]);
      # relevant args only
      args <- args[intersect(names(formals()),names(args))]
      # call initial fun with relevant args
      do.call(getExportedValue(f_ns, f_name),args)})
  f
}

foo.plot <- function(x,y,...) {
  legend <- formalize(legend)
  plot   <- casualize(plot)
  plot(x,y,...)
  legend("bottomleft", "bar", pch = 1, ...)
}

foo.plot(1,1, xaxt = "n", title = "legend")

现在它工作正常！

于 2018-09-19T10:35:34.250 回答