问题 在R中抑制安装输出


这真的开始让我感到烦恼......我尝试了一些方法,但似乎都没有

我正在从一个函数运行一个安装,它生成了许多我想要抑制的不必要的消息,但我尝试这样做的所有方法都没有用。

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

无论如何,我试过了 invisiblecapture.output 和 sink,没有一个工作...或者我可能没有正确使用它们......无论哪种方式......任何想法?


9641
2017-09-13 23:09


起源

也许 suppressMessages() 要么 suppressPackageStartupMessages() 你想要的是什么? - Chase
@Chase是对的。你在另一个问题中的功能有点复杂,不应该打电话 install_github() 每次。看那里的答案。 - Maiasaura


答案:


suppressMessages 将关闭一些消息(通过调用打印的消息) message), 但不是所有的。

其余的消息来自一个炮轰的呼叫 R CMD INSTALL 通过 system2 功能。我认为这是因为你所尝试的所有常见事情都被剥夺了(sinkcapture.output等)不工作。请注意 system2 功能自带 stderr 和 stdout 如果转向的话 FALSE 将关闭所有这些消息。不幸, system2 使用 stdout = "" 和 stderr = "" 默认情况下,似乎没有办法通过。访问这些参数 devtools 包。

因此,我设法在没有任何消息的情况下运行的一种方法是暂时覆盖 system2 在基础环境中运行。它不是特别优雅,但它的工作原理:

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

9
2017-09-14 04:33



我应用了相同的想法 system 和 install.packages 在尝试了一切之后。辉煌。 - piccolbo


这是另一种可能性。这里的优点是您不必重置 system2 打电话后 install_githubsystem2 将继续显示所有通话的默认行为  通过电话发起的那些 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'))

3
2017-09-20 00:20





另一种技术是补丁 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 功能。


2
2017-09-19 16:48