R 确定执行脚本的路径

我有一个名为

foo.R

的脚本，其中包含另一个脚本

other.R

，该脚本位于同一目录中：

#!/usr/bin/env Rscript
message("Hello")
source("other.R")

但是我想

R

找到

other.R

，无论当前工作目录是什么

---

换句话说，

foo.R

需要知道自己的路径。如何才能做到这一点？

您可以将r脚本包装在bash脚本中，并将脚本的路径作为bash变量检索，如下所示：

#!/bin/bash
     # [environment variables can be set here]
     path_to_script=$(dirname $0)

     R --slave<<EOF
        source("$path_to_script/other.R")

     EOF

#/bin/bash
#[可在此设置环境变量]
路径\到\脚本=$（目录名$0）
R--slave您可以使用
commandArgs
函数来获取Rscript传递给实际R解释器的所有选项，并在其中搜索
--file=
。如果脚本是从路径启动的，或者是以完整路径启动的，则下面的
脚本.name
将以
'/'
开头。否则，它必须与
cwd
相关，您可以将这两条路径合并以获得完整路径

编辑：听起来你只需要上面的
script.name
，然后去掉路径的最后一个部分。我已经删除了不需要的
cwd（）
示例，清理了主脚本并发布了我的
other.R
。只需将此脚本和
other.R
脚本保存到同一目录中，
chmod+x
它们，然后运行主脚本

main.R：

输出：

这就是我相信dehmann在寻找的。
frame\u files是SuperssingFire答案的精简版本：

frame_files <- lapply(sys.frames(), function(x) x$ofile)
frame_files <- Filter(Negate(is.null), frame_files)
PATH <- dirname(frame_files[[length(frame_files)]])

source_local <- function(fname){
    argv <- commandArgs(trailingOnly = FALSE)
    base_dir <- dirname(substring(argv[grep("--file=", argv)], 8))
    source(paste(base_dir, fname, sep="/"))
}

source\u local这对我很有用。只需将其从命令行参数中变灰，去掉不需要的文本，执行dirname并最终从中获取完整路径：

args <- commandArgs(trailingOnly = F)  
scriptPath <- normalizePath(dirname(sub("^--file=", "", args[grep("^--file=", args)])))

args当从R控制台“源”调用时，我无法使Suppressingfire的解决方案工作。

当使用Rscript时，我无法让hadley的解决方案工作

两全其美

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

这个文件这个问题有一个简单的解决方案。此命令：

script.dir <- dirname(sys.frame(1)$ofile)

script.dir我已经将这个问题的答案打包并扩展为一个新函数
thisfile（）
in。也适用于编织
knitr
请参见包装的
查找SourceTraceback（）
，其中

在所有调用帧中查找由source（）生成的所有“srcfile”对象。
这样就可以找出source（）当前编写了哪些文件的脚本

#/usr/bin/env Rscript
打印（“你好”）
#可悲的解决方法，但有效：(
programDir我喜欢这种方法：

this.file <- sys.frame(tail(grep('source',sys.calls()),n=1))$ofile
this.dir <- dirname(this.file)

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

Bash.sh

foo.R

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

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)

args我喜欢steamer25的解决方案，因为它对我来说似乎是最健壮的。但是，在RStudio（在windows中）中调试时，路径设置不正确。原因是如果在RStudio中设置了断点，则源文件使用另一个“调试源”命令，该命令设置的脚本路径稍有不同。以下是我当前使用的最终版本，它解释了调试时RStudio中的这种交替行为：

# @return full path to this script
get_script_path <- function() {
    cmdArgs = commandArgs(trailingOnly = FALSE)
    needle = "--file="
    match = grep(needle, cmdArgs)
    if (length(match) > 0) {
        # Rscript
        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 {
            # Source'd via R console
            return(normalizePath(sys.frames()[[1]]$ofile))
        }
    }
}

#@返回此脚本的完整路径
获取脚本（路径0）{
#Rscript
返回值（normalizePath（子（指针，“，cmdArgs[match]））
}否则{
ls_vars=ls（sys.frames（）[[1]]
如果（“文件名”%in%ls\u vars）{
#来源：RStudio
返回（normalizePath（sys.frames（）[[1]]$fileName））
}否则{
#通过R控制台发送源代码
返回（normalizePath（sys.frames（）[[1]]$ofile））
}
}
}
我将使用@steamer25方法的变体。关键是，即使我的会话是通过Rscript启动的，我还是希望获得最后一个源代码脚本。以下代码段包含在文件中时，将提供一个变量
thisScript
，其中包含脚本的规范化路径。
我承认（ab）使用了source'ing，所以有时我调用Rscript，并且
--file
参数中提供的脚本会生成另一个脚本，而另一个脚本又会生成另一个脚本。。。总有一天我会投资把我的乱七八糟的代码变成一个包

thisScript <- (function() {
  lastScriptSourced <- tail(unlist(lapply(sys.frames(), function(env) env$ofile)), 1)

  if (is.null(lastScriptSourced)) {
    # No script sourced, checking invocation through Rscript
    cmdArgs <- commandArgs(trailingOnly = FALSE)
    needle <- "--file="
    match <- grep(needle, cmdArgs)
    if (length(match) > 0) {
      return(normalizePath(sub(needle, "", cmdArgs[match]), winslash=.Platform$file.sep, mustWork=TRUE))
    }
  } else {
    # 'source'd via R console
    return(normalizePath(lastScriptSourced, winslash=.Platform$file.sep, mustWork=TRUE))
  }
})()

thisScriptfrom的答案是最正确、最精彩的IMHO。然而，它仍然是一个包含虚拟函数的黑客。我在这里引用它是为了让别人更容易找到它

sourceDirMy all-in-one！（-2019年9月1日更新以处理RStudio控制台）

当前脚本文件（完整路径）
#'@description当前脚本文件（完整路径）
#“@示例
#'与Rscript、source（）或RStudio运行选择中的RStudio控制台一起使用
#“@出口
ez.0）{
#通过命令行Rscript
返回值（normalizePath（子（指针，“，cmdArgs[match]））
}否则{
ls_vars=ls（sys.frames（）[[1]]
如果（“文件名”%in%ls\u vars）{
#来源：RStudio
返回（normalizePath（sys.frames（）[[1]]$fileName））
}否则{
如果（！is.null（sys.frames（）[[1]]$ofile））{
#通过R控制台发送源代码
返回（normalizePath（sys.frames（）[[1]]$ofile））
}否则{
#RStudio运行选择
# http://stackoverflow.com/a/35842176/2292993
pth=rstudioapi:：getActiveDocumentContext（）$path
如果（pth！=''）{
返回（标准化路径（pth））
}否则{
#RStudio控制台
tryCatch({
pth=rstudioapi:：getSourceEditorContext（）$path
pth=标准化路径（pth）
#!/bin/bash

# set path variable
path=`pwd -P`

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

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

# @return full path to this script
get_script_path <- function() {
    cmdArgs = commandArgs(trailingOnly = FALSE)
    needle = "--file="
    match = grep(needle, cmdArgs)
    if (length(match) > 0) {
        # Rscript
        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 {
            # Source'd via R console
            return(normalizePath(sys.frames()[[1]]$ofile))
        }
    }
}

thisScript <- (function() {
  lastScriptSourced <- tail(unlist(lapply(sys.frames(), function(env) env$ofile)), 1)

  if (is.null(lastScriptSourced)) {
    # No script sourced, checking invocation through Rscript
    cmdArgs <- commandArgs(trailingOnly = FALSE)
    needle <- "--file="
    match <- grep(needle, cmdArgs)
    if (length(match) > 0) {
      return(normalizePath(sub(needle, "", cmdArgs[match]), winslash=.Platform$file.sep, mustWork=TRUE))
    }
  } else {
    # 'source'd via R console
    return(normalizePath(lastScriptSourced, winslash=.Platform$file.sep, mustWork=TRUE))
  }
})()

setwd(sourceDir)
source("other.R")

 source(paste(sourceDir, "/other.R", sep=""))

#' 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)
                }
            }
        }
    }
}

wd <- setwd(".")
setwd(wd)

wd <- getwd()
setwd(wd)

setwd(".")

sys.calls()[[1]] [[2]]

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))
  }
}

library(rstudioapi)    
rstudioapi::getActiveDocumentContext()$path

#!/usr/bin/env Rscript
library(here)
source(here("other.R"))

write.table(c("readlink -e $0"), file="scriptpath.sh",col=F, row=F, quote=F)
thisscript <- system("sh scriptpath.sh", intern = TRUE)

splitstr <- rev(strsplit(thisscript, "\\/")[[1]])
otherscript <- paste0(paste(rev(splitstr[2:length(splitstr)]),collapse="/"),"/other.R")

script.dir.executing = (function() return( if(length(sys.parents())==1) getwd() else dirname( Filter(is.character,lapply(rev(sys.frames()),function(x) x$ofile))[[1]] ) ))()

script.dir.entry = (function() return( if(length(sys.parents())==1) getwd() else dirname(sys.frame(1)$ofile) ))()

paste0(gsub("\\", "/", fileSnapshot()$path, fixed=TRUE),"/")

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

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)

> source("foo.R")

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

this.path <- function (verbose = getOption("verbose"))
{
    where <- function(x) if (verbose)
        cat("Source: ", x, "\n", sep = "")


    # loop through functions that lead here from most recent to earliest looking
    #     for an appropriate source call (a call to function base::source or base::sys.source)
    # an appropriate source call is a source call in which
    #     argument 'file' has been evaluated (forced)
    # this means, for example, the following is an inappropriate source call:
    #     source(this.path())
    # the argument 'file' is stored as a promise
    #     containing the expression "this.path()"
    # when the value of 'file' is requested, it assigns the value
    #     returned by evaluating "this.path()" to variable 'file'
    # there are two functions on the calling stack at
    #     this point 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 variable ('ofile' for base::source, 'exprs' for base::sys.source)
    #     exists in that function's evaluation environment. this is because that
    #     variable is created AFTER argument 'file' has been forced
    # if that variable does exist, then argument 'file' has been forced and the
    #     source call is deemed appropriate. For base::source, the filename we want
    #     is the variable 'ofile' from that function's evaluation environment. For
    #     base::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 (if available)
    #
    # 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 definition). 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 (if available)


    if (.Platform$GUI == "RStudio")
        dbs <- get("debugSource", mode = "function", "tools:rstudio",
            inherits = FALSE)
    for (n in seq.int(sys.nframe(), 1L)[-1L]) {
        if (identical(sys.function(n), base::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
            where("call to function source")
            return(normalizePath(path, mustWork = TRUE))
        }
        else if (identical(sys.function(n), base::sys.source) &&
            exists("exprs", envir = sys.frame(n), inherits = FALSE)) {
            path <- get("file", envir = sys.frame(n), inherits = FALSE)
            where("call to function sys.source")
            return(normalizePath(path, mustWork = TRUE))
        }
        else if (.Platform$GUI == "RStudio" && identical(sys.function(n), dbs) &&
            tryCatch({
                path <- get("fileName", envir = sys.frame(n), inherits = FALSE)
                TRUE
            }, error = function(c) FALSE)) {
            where("call to function debugSource in RStudio")
            return(normalizePath(path, mustWork = TRUE))
        }
    }


    # if the for loop is passed, no appropriate
    #     source call was found up the calling stack
    # next, check if the user is running R from the command-line
    #     on a Windows OS, the GUI is "RTerm"
    #     on a Unix    OS, the GUI is "X11"


    if (.Platform$OS.type == "windows" && .Platform$GUI == "RTerm" ||  # running from Windows command-line
        .Platform$OS.type == "unix" && .Platform$GUI == "X11") {       # running from Unix command-line


        # get all command-line arguments that start with "--file="
        # check the number of command-line arguments starting with "--file="
        #     in case more or less than one were supplied


        path <- grep("^--file=", commandArgs(), value = TRUE)
        if (length(path) == 1L) {
            path <- sub("^--file=", "", path)
            where("Command-line argument 'FILE'")
            return(normalizePath(path, mustWork = TRUE))
        }
        else if (length(path)) {
            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 the command-line where formal argument 'FILE' matched by multiple actual arguments")
        }
        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 the command-line where argument 'FILE' is missing")
    }
    else if (.Platform$GUI == "RStudio") {  # running R from 'RStudio'


        # function ".rs.api.getActiveDocumentContext" from the environment "tools:rstudio"
        #     returns a list of information about the document where your cursor is located
        #
        # function ".rs.api.getSourceEditorContext" from the environment "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


        adc <- get(".rs.api.getActiveDocumentContext",
            mode = "function", "tools:rstudio", inherits = FALSE)()
        if (adc$id != "#console") {
            path <- adc$path
            if (nzchar(path)) {
                where("active document in RStudio")
                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",
                "* active document in RStudio does not exist")
        }


        sec <- get(".rs.api.getSourceEditorContext", mode = "function",
            "tools:rstudio", inherits = FALSE)()
        if (!is.null(sec)) {
            path <- sec$path
            if (nzchar(path)) {
                where("source document in RStudio")
                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",
                "* source document in RStudio does not exist")
        }
        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 RStudio with no documents open")
    }
    else if (.Platform$OS.type == "windows" && .Platform$GUI == "Rgui") {  # running R from 'RGui' on Windows


        # on a Windows OS only, the function "getWindowsHandles" from the base
        # package "utils" returns a list of external pointers containing the windows
        # handles. The thing of interest are the names of this list, these should
        # be 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 exactly
        # match the string "R Console" or end with " - R Editor". I highly suggest
        # that you NEVER end a document's filename with " - R Editor". From there,
        # similar checks are done as in the above section for 'RStudio'


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


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


        path <- wh[1L]
        if (path != "R Console") {
            path <- sub(" - R Editor$", "", path)
            if (path != "Untitled") {
                where("active document in RGui")
                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",
                "* active document in RGui does not exist")
        }


        path <- wh[2L]
        if (!is.na(path)) {
            path <- sub(" - R Editor$", "", path)
            if (path != "Untitled") {
                where("source document in RGui")
                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",
                "* source document in RGui does not exist")
        }
        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")
    }
    else if (.Platform$OS.type == "unix" && .Platform$GUI == "AQUA") {  # running R from 'RGui' on Unix
        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 requires a source call on the calling stack")
    }
    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")
}

#!/usr/bin/env Rscript
f  <-  funr::sys.script()
show(f)

user@somewhere:/home$ Rscript myscript.R

"/home/path/to/myscript.R"