12

这真的开始困扰我......我尝试了一些方法，但似乎都没有工作

我正在从一个函数运行安装，该函数会生成许多我想抑制的不必要的消息，但是我尝试执行此操作的所有方法都没有奏效。

我试图抑制的代码是 : install_github('ROAUth', 'duncantl')，它需要devtools预先加载包。

无论如何，我尝试了invisible，capture.output并且sink，其中没有一个工作......或者我没有正确使用它们......无论哪种方式......有什么想法吗？

4

3 回答 3

10

suppressMessages will turn some messages off (those that were printed though calls to message), but not all.

The rest of the messages are coming from a shelled out call to R CMD INSTALL via the system2 function. I think it is because this is shelled out that all the usual things you tried (sink, capture.output, etc.) are not working. Note that the system2 function comes with stderr and stdout arguments which, if turned to FALSE would turn off all those messages. Unfortunately, system2 uses stdout = "" and stderr = "" by default and there seems to be no way to access these arguments through the devtools package.

So one way I managed to run without any messages is to temporarily overwrite the system2 function in the base environment. It's not particularly elegant but it works:

# store a copy of system2
assign("system2.default", base::system2, baseenv())

# create a quiet version of system2
assign("system2.quiet", function(...)system2.default(..., stdout = FALSE,
                                                     stderr = FALSE), baseenv())

# overwrite system2 with the quiet version
assignInNamespace("system2", system2.quiet, "base")

# this is now message-free:
res <- eval(suppressMessages(install_github('ROAUth', 'duncantl'))) 

# reset system2 to its original version
assignInNamespace("system2", system2.default, "base")
于 2012-09-14T04:33:21.053 回答
3

这是另一种可能性。此处的优点是您不必system2在调用install_github:后重置system2将继续对所有调用显示其默认行为，但由调用发起的调用除外install_github()：

# store a copy of system2
assign("system2.default", base::system2, baseenv())

# create a quiet version of system2
assign("system2.quiet", function(...)system2.default(..., stdout = FALSE,
                                                     stderr = FALSE), baseenv())
# redefine system2 to use system2.quiet if called from "install_github"
assignInNamespace("system2",
    function(...) {
        cls <- sys.calls()
        from_install_github <- 
            any(sapply(cls, "[[", 1) == as.name("install_github"))
        if(from_install_github) {
            system2.quiet(...)
        } else {
            system2.default(...)
        }},
    "base")


## Try it out
library(devtools)
suppressMessages(install_github('ROAUth', 'duncantl'))
于 2012-09-20T00:20:26.697 回答
3

另一种技术是修补devtools函数，以便它们允许您将stdout参数传递给system2. 也不是很优雅，但也许你可以说服包作者以devtools这种方式进行修改。这是我的补丁build和install功能：

library(devtools)

# New functions.
my.install<-function (pkg = ".", reload = TRUE, quick = FALSE, args = NULL, ...) 
{
    pkg <- as.package(pkg)
    message("Installing ", pkg$package)
    devtools:::install_deps(pkg)
    built_path <- devtools:::build(pkg, tempdir(),...) # pass along the stdout arg
    on.exit(unlink(built_path))
    opts <- c(paste("--library=", shQuote(.libPaths()[1]), sep = ""), 
        "--with-keep.source")
    if (quick) {
        opts <- c(opts, "--no-docs", "--no-multiarch", "--no-demo")
    }
    opts <- paste(paste(opts, collapse = " "), paste(args, collapse = " "))
    devtools:::R(paste("CMD INSTALL ", shQuote(built_path), " ", opts, sep = ""),...) # pass along the stdout arg
    if (reload) 
        devtools:::reload(pkg)
    invisible(TRUE)
}

my.build<-function (pkg = ".", path = NULL, binary = FALSE, ...) 
{
    pkg <- as.package(pkg)
    if (is.null(path)) {
        path <- dirname(pkg$path)
    }
    if (binary) {
        cmd <- paste("CMD INSTALL ", shQuote(pkg$path), " --build", 
            sep = "")
        ext <- if (.Platform$OS.type == "windows") 
            "zip"
        else "tgz"
    }
    else {
        cmd <- paste("CMD build ", shQuote(pkg$path), " --no-manual --no-resave-data", 
            sep = "")
        ext <- "tar.gz"
    }
    devtools:::R(cmd, path, ...) # pass along the stdout arg
    targz <- paste(pkg$package, "_", pkg$version, ".", ext, sep = "")
    file.path(path, targz)
}

# Patch package.
unlockBinding("install", as.environment("package:devtools"))
unlockBinding("build", as.environment("package:devtools"))
assignInNamespace('install', my.install, ns='devtools', envir=as.environment("package:devtools"));
assignInNamespace('build', my.build, ns='devtools', envir=as.environment("package:devtools"));
lockBinding("install", as.environment("package:devtools"))
lockBinding("build", as.environment("package:devtools"))

# Run with no messages.
suppressMessages(install_github('ROAUth','duncantl',stdout=NULL))

本质上，你在三个地方传递了...，两次在install函数中，一次在build函数中。

于 2012-09-19T16:48:15.843 回答