我的一切都在一个!(—2019年9月1日更新以处理RStudio控制台)

#' current script file (in full path)
#' @description current script file (in full path)
#' @examples
#' works with Rscript, source() or in RStudio Run selection, RStudio Console
#' @export
ez.csf <- function() {
    # http://stackoverflow.com/a/32016824/2292993
    cmdArgs = commandArgs(trailingOnly = FALSE)
    needle = "--file="
    match = grep(needle, cmdArgs)
    if (length(match) > 0) {
        # Rscript via command line
        return(normalizePath(sub(needle, "", cmdArgs[match])))
    } else {
        ls_vars = ls(sys.frames()[[1]])
        if ("fileName" %in% ls_vars) {
            # Source'd via RStudio
            return(normalizePath(sys.frames()[[1]]$fileName))
        } else {
            if (!is.null(sys.frames()[[1]]$ofile)) {
            # Source'd via R console
            return(normalizePath(sys.frames()[[1]]$ofile))
            } else {
                # RStudio Run Selection
                # http://stackoverflow.com/a/35842176/2292993
                pth = rstudioapi::getActiveDocumentContext()$path
                if (pth!='') {
                    return(normalizePath(pth))
                } else {
                    # RStudio Console
                    tryCatch({
                            pth = rstudioapi::getSourceEditorContext()$path
                            pth = normalizePath(pth)
                        }, error = function(e) {
                            # normalizePath('') issues warning/error
                            pth = ''
                        }
                    )
                    return(pth)
                }
            }
        }
    }
}

我在一个高性能计算集群环境中工作。我在不同的地方开发代码，而不是在生产运行的地方。在开发过程中，我通常从命令行交互式地调用R(而不是使用RStudio)。有很多来源(“foo.R”)正在进行。

在生产运行期间，我通常编写一个bash脚本，尝试不同的参数，并在单独的目录中运行每一组参数。bash脚本利用了工作负载管理器(即SLURM)。在这种环境中，设置环境变量很简单。考虑到这一点，下面的解决方案最适合我。

其他。R

my_message <- function(){
return("R is awkward")
}

foo。R

srcpath = Sys.getenv("R_SRC")
# Check if runnning w/o setting R_SRC - presumably done in directory of development, i.e. /path/to/R/code
if(srcpath == ""){
    srcpath="./"
}
source(sprintf("%s/other.R", srcpath))
string = my_message()
print(string)

如果从R交互式shell中运行，并且在/path/到/R/code中运行，那么简单

> source("foo.R")

如果不是从交互式shell运行，也不是从/path/to/R/code运行，首先设置环境变量R_SRC，然后调用Rscript

$ export R_SRC=/path/to/R/code/
$ Rscript /path/to/R/code/foo.R

Steamer25的方法是有效的，但前提是路径中没有空白。在macOS上，至少cmdArgs[match]返回类似/base/some~+~dir~+~带~+~空格/ for /base/some\ dir\带\空格/。

我通过在返回之前用一个简单的空格替换“~+~”来解决这个问题。

thisFile <- function() {
  cmdArgs <- commandArgs(trailingOnly = FALSE)
  needle <- "--file="
  match <- grep(needle, cmdArgs)
  if (length(match) > 0) {
    # Rscript
    path <- cmdArgs[match]
    path <- gsub("\\~\\+\\~", " ", path)
    return(normalizePath(sub(needle, "", path)))
  } else {
    # 'source'd via R console
    return(normalizePath(sys.frames()[[1]]$ofile))
  }
}

显然，你仍然可以像aprstar那样扩展else块。

只是在上面的答案的基础上，作为安全检查，您可以添加一个包装器，当sys.frame(1)失败时(如果interactive() == TRUE可能会失败)，或者源脚本不在主脚本所期望的位置时，它会要求用户找到文件。

fun_path = tryCatch(expr = 
                      {file.path(dirname(sys.frame(1)$ofile), "foo.R")},
                    error = function(e){'foo.R'}
                    )
if(!file.exists(fun_path))
{
  msg = 'Please select "foo.R"'
  # ask user to find data
  if(Sys.info()[['sysname']] == 'Windows'){#choose.files is only available on Windows
    message('\n\n',msg,'\n\n')
    Sys.sleep(0.5)#goes too fast for the user to see the message on some computers
    fun_path  = choose.files(
      default = file.path(gsub('\\\\', '/', Sys.getenv('USERPROFILE')),#user
                          'Documents'),
      caption = msg
    )
  }else{
    message('\n\n',msg,'\n\n')
    Sys.sleep(0.5)#goes too fast for the user to see the message on some computers
    fun_path = file.choose(new=F)
  }
}
#source the function
source(file = fun_path, 
       encoding = 'UTF-8')

我对上面的实现有问题，因为我的脚本是从符号链接目录操作的，或者至少这就是为什么我认为上面的解决方案不适合我。按照@ennuikiller的回答，我将Rscript包装在bash中。我使用pwd -P设置路径变量，它解析符号链接目录结构。然后将路径传递给Rscript。

Bash.sh

#!/bin/bash

# set path variable
path=`pwd -P`

#Run Rscript with path argument
Rscript foo.R $path

foo。R

args <- commandArgs(trailingOnly=TRUE)
setwd(args[1])
source(other.R)

我为此做了一个包，在CRAN和GitHub上可用，名为“this.path”。当前版本是1.2.0，发布于2023-01-16，你可以在这里找到它:

https://CRAN.R-project.org/package=this.path

https://github.com/ArcadeAntics/this.path

从CRAN安装:

跑龙套::install.packages(“this.path”)

或从GitHub安装开发版本:

utils：：install.packages（“this.path”， repos = “https://raw.githubusercontent.com/ArcadeAntics/PACKAGES”）

然后使用它:

this.path: this.path ()

or

库(this.path)

this.path ()

下面的答案是我的原始答案，仅供参考，尽管它的功能比上面可用的最新版本少了很多。改进包括:

this.path() now works within VSCode handling filenames with spaces when running an R script from a shell under Unix-alikes handling both uses of running an R script from a shell (-f file and --file=file) correctly normalizes the path when using source with argument chdir = TRUE handling of file URLs with source (that is, "file://absolute or relative path" and "file:///absolute path") better handling of a connection instead of a character string within source this.path is compatible with URLs in source, that is:

source("https://host/path/to/file")

如果这一点。如果在文件中使用了Path，它将返回“https://host/path/to/file”。这也适用于以“http://”，“ftp://”和“ftps://”开头的URL。举个例子，试试:

source("https://raw.githubusercontent.com/ArcadeAntics/this.path/main/tests/this.path_w_URLs.R")

compatibility with package testthat and knitr, particularly testthat::source_file and knitr::knit introduces function here, similar to here::here, for specifying an absolute file path, relative to the executing script's directory on Windows, in Rgui, added support for all languages listed by list.dirs(system.file(package = "translations"), full.names = FALSE, recursive = FALSE) saving the normalized path within its appropriate environment the first time this.path is called within a script, making it faster to use subsequent times within the same script and being independent of working directory. This means that setwd will no longer break this.path when using relative paths within source or when running R from a shell (as long as setwd is used AFTER the first call to this.path within that script)

最初的回答:

我的回答比Jerry T的回答好多了。我发现的问题是，他们通过检查变量ofile是否在堆栈上的第一帧中找到来猜测是否进行了源调用。这将不适用于嵌套的源调用，也不适用于来自非全局环境的源调用。另外，顺序是错误的。在检查shell参数之前，我们必须寻找源调用。以下是我的解决方案:

this.path <- function (verbose = getOption("verbose"))
{
    # loop through functions that lead here from most recent to
    # earliest looking for an appropriate source call (a call to
    # function source / / sys.source / / debugSource in RStudio)
    #
    # an appropriate source call is one in which the file argument has
    # been evaluated (forced)
    #
    # for example, this means `source(this.path())` is an inappropriate
    # source call. the argument 'file' is stored as a promise
    # containing the expression "this.path()". when the value of 'file'
    # is requested, the expression is evaluated at which time there
    # should be two functions on the calling stack being 'source' and
    # 'this.path'. clearly, you don't want to request the 'file'
    # argument from that source call because the value of 'file' is
    # under evaluation right now! the trick is to ask if 'file' has
    # already been evaluated, the easiest way of which is to ask if a
    # variable exists, one which is only created after the expression
    # is necessarily evaluated.
    #
    # if that variable does exist, then argument 'file' has been forced
    # and the source call is deemed appropriate. For 'source', the
    # filename we want is the variable 'ofile' from that function's
    # evaluation environment. For 'sys.source', the filename we want is
    # the variable 'file' from that function's evaluation environment.
    #
    # if that variable does NOT exist, then argument 'file' hasn't been
    # forced and the source call is deemed inappropriate. the 'for'
    # loop moves to the next function up the calling stack
    #
    # unfortunately, there is no way to check the argument 'fileName'
    # has been forced for 'debugSource' since all the work is done
    # internally in C. Instead, we have to use a 'tryCatch' statement.
    # When we ask for an object by name using 'get', R is capable of
    # realizing if a variable is asking for its own definition (a
    # recursive promise). The exact error is "promise already under
    # evaluation" which indicates that the promise evaluation is
    # requesting its own value. So we use the 'tryCatch' to get the
    # argument 'fileName' from the evaluation environment of
    # 'debugSource', and if it does not raise an error, then we are
    # safe to return that value. If not, the condition returns false
    # and the 'for' loop moves to the next function up the calling
    # stack


    debugSource <- if (.Platform$GUI == "RStudio")
        get("debugSource", "tools:rstudio", inherits = FALSE)
    for (n in seq.int(to = 1L, by = -1L, length.out = sys.nframe() - 1L)) {
        if (identical(sys.function(n), source) &&
            exists("ofile", envir = sys.frame(n), inherits = FALSE))
        {
            path <- get("ofile", envir = sys.frame(n), inherits = FALSE)
            if (!is.character(path))
                path <- summary.connection(path)$description
            if (verbose)
                cat("Source: call to function source\n")
            return(normalizePath(path, mustWork = TRUE))
        }
        else if (identical(sys.function(n), sys.source) &&
                 exists("exprs", envir = sys.frame(n), inherits = FALSE))
        {
            path <- get("file", envir = sys.frame(n), inherits = FALSE)
            if (verbose)
                cat("Source: call to function sys.source\n")
            return(normalizePath(path, mustWork = TRUE))
        }
        else if (identical(sys.function(n), debugSource) &&
                 tryCatch({
                     path <- get("fileName", envir = sys.frame(n), inherits = FALSE)
                     TRUE
                 }, error = function(c) FALSE))
        {
            if (verbose)
                cat("Source: call to function debugSource in RStudio\n")
            return(normalizePath(path, mustWork = TRUE))
        }
    }


    # no appropriate source call was found up the calling stack


    # if (running R from RStudio)
    if (.Platform$GUI == "RStudio") {


        # ".rs.api.getActiveDocumentContext" from "tools:rstudio"
        # returns a list of information about the document where your
        # cursor is located
        #
        # ".rs.api.getSourceEditorContext" from "tools:rstudio" returns
        # a list of information about the document open in the current
        # tab
        #
        # element 'id' is a character string, an identification for the document
        # element 'path' is a character string, the path of the document


        context <- get(".rs.api.getActiveDocumentContext",
            "tools:rstudio", inherits = FALSE)()
        active <- context[["id"]] != "#console"
        if (!active) {
            context <- get(".rs.api.getSourceEditorContext",
                "tools:rstudio", inherits = FALSE)()
            if (is.null(context))
                stop("'this.path' used in an inappropriate fashion\n",
                     "* no appropriate source call was found up the calling stack\n",
                     "* R is being run from RStudio with no documents open\n",
                     "  (or source document has no path)")
        }


        path <- context[["path"]]
        Encoding(path) <- "UTF-8"
        if (nzchar(path)) {
            if (verbose)
                cat(if (active)
                    "Source: active document in RStudio\n"
                else "Source: source document in RStudio\n")
            return(normalizePath(path, mustWork = TRUE))
        }
        else stop("'this.path' used in an inappropriate fashion\n",
                  "* no appropriate source call was found up the calling stack\n",
                  if (active)
                      "* active document in RStudio does not exist"
                  else "* source document in RStudio does not exist")
    }


    # if (running R from RStudio before .Platform$GUI is changed)
    # this includes code evaluated in the site-wide startup profile file,
    # user profile, and function .First (see ?Startup) 
    else if (isTRUE(Sys.getpid() == as.integer(Sys.getenv("RSTUDIO_SESSION_PID"))) {
        stop("RStudio has not finished loading")
    }


    # if (running R from a shell)
    else if (.Platform$OS.type == "windows" && .Platform$GUI == "RTerm" ||  # on Windows
             .Platform$OS.type == "unix"    && .Platform$GUI == "X11")      # under Unix-alikes
    {


        argv <- commandArgs()
        # remove all trailing arguments
        m <- match("--args", argv, 0L)
        if (m)
            argv <- argv[seq_len(m)]
        argv <- argv[-1L]


        # get all arguments starting with "--file="
        FILE <- argv[startsWith(argv, "--file=")]
        # remove "--file=" from the start of each string
        FILE <- substring(FILE, 8L)
        # remove strings "-"
        FILE <- FILE[FILE != "-"]
        n <- length(FILE)
        if (n) {
            FILE <- FILE[[n]]
            if (verbose)
                cat("Source: shell argument 'FILE'\n")
            return(normalizePath(FILE, mustWork = TRUE))
        } else {
            stop("'this.path' used in an inappropriate fashion\n",
                  "* no appropriate source call was found up the calling stack\n",
                  "* R is being run from a shell where argument 'FILE' is missing")
        }
    }


    # if (running R from RGui on Windows)
    else if (.Platform$OS.type == "windows" && .Platform$GUI == "Rgui") {


        # "getWindowsHandles" from "utils" (Windows exclusive) returns
        # a list of external pointers containing the windows handles.
        # The thing of interest are the names of this list, these are
        # the names of the windows belonging to the current R process.
        # Since Rgui can have files besides R scripts open (such as
        # images), a regular expression is used to subset only windows
        # handles with names that start with "R Console" or end with
        # " - R Editor". From there, similar checks are done as in the
        # above section for 'RStudio'


        x <- names(utils::getWindowsHandles(pattern = "^R Console| - R Editor$",
            minimized = TRUE))


        if (!length(x))
            stop("no windows in Rgui; should never happen, please report!")


        active <- !startsWith(x[[1L]], "R Console")
        if (active)
            x <- x[[1L]]
        else if (length(x) >= 2L)
            x <- x[[2L]]
        else stop("'this.path' used in an inappropriate fashion\n",
                  "* no appropriate source call was found up the calling stack\n",
                  "* R is being run from Rgui with no documents open")
        if (x == "Untitled - R Editor")
            stop("'this.path' used in an inappropriate fashion\n",
                 "* no appropriate source call was found up the calling stack\n",
                 if (active)
                     "* active document in Rgui does not exist"
                 else "* source document in Rgui does not exist")
        path <- sub(" - R Editor$", "", x)
        if (verbose)
            cat(if (active)
                "Source: active document in Rgui\n"
            else "Source: source document in Rgui\n")
        return(normalizePath(path, mustWork = TRUE))
    }


    # if (running R from RGui on macOS)
    else if (.Platform$OS.type == "unix" && .Platform$GUI == "AQUA") {
        stop("'this.path' used in an inappropriate fashion\n",
             "* no appropriate source call was found up the calling stack\n",
             "* R is being run from AQUA which is currently unimplemented\n",
             "  consider using RStudio until such a time when this is implemented")
    }


    # otherwise
    else stop("'this.path' used in an inappropriate fashion\n",
              "* no appropriate source call was found up the calling stack\n",
              "* R is being run in an unrecognized manner")
}