微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦!

使用 R,如何获取传递给函数的所有参数及其值? 理想的可变参数解决方案是外部函数 grabFunctionParameters()解决方案:

如何解决使用 R,如何获取传递给函数的所有参数及其值? 理想的可变参数解决方案是外部函数 grabFunctionParameters()解决方案:

我有一个功能

adebo.deepSearch = function(z,pi_0 = 0.3,families=list(),... )
    {

    }

我想捕获通过名为 grabFunctionParameters函数传入的所有参数名称和值;例如,

adebo.deepSearch = function(z,... )
    {
    args = grabFunctionParameters();
    }

其中 args 将是一个包含“键”和“值”的列表,例如

args[["pi_0"] = 0.3;

对于所有键和值,包括省略号 (...) 中的键和值。

理想的(可变参数)解决方案是外部函数 grabFunctionParameters()

解决方案:

这是提供的接受的答案:
# https://stackoverflow.com/questions/66329835/
# nice work :: B. Christian Kamgang
# .GlobalEnv$.function.args.memory ... key memory on last function call ... so I Could reference outside the function
grabFunctionParameters <- function() {
    pf <- parent.frame()    
    args_names <- ls(envir = pf,all.names = TRUE,sorted = FALSE)
    if("..." %in% args_names) {
    dots <- eval(quote(list(...)),envir = pf)
    }  else {
    dots = list()
    }
    args_names <- sapply(setdiff(args_names,"..."),as.name)
    if(length(args_names)) {
    not_dots <- lapply(args_names,eval,envir = pf) 
    } else {
    not_dots <- list()
    }   
   idx <- names(dots) != "";
   list(.keys. = names(not_dots),.vals. = unname(not_dots),.fn. = as.character(sys.call(1L)[[1L]]),.scope. = pf,.dot.keys. = names(dots[idx]),.dot.vals. = unname(dots[idx])); 
} 

这是提供的 ACCEPTED ANSWER(格式略有不同):
grabFunctionParameters <- function() 
    {
    pf          = parent.frame();    
    my.names    = ls(envir = pf,sorted = FALSE);
    
    dots        = if("..." %in% my.names) { eval(quote(list(...)),envir = pf); } else { list(); }  
    dots.idx    = ( names(dots) != "" );
    
    remaining   = sapply( setdiff(my.names,as.name);
    
    not.dots    = if(length(remaining) > 0) { lapply( remaining,envir = pf);  } else { list(); }
    
   
    res = list();
    
        res$.fn.            = as.character( sys.call(1L)[[1L]] );
        res$.scope.         = pf;
        res$.keys.          = names( not.dots );
        res$.vals.          = not.dots;                             # unname(not_dots);  # I want keys on "vals"
        res$.dots.keys.     = names( dots[dots.idx] );
        res$.dots.vals.     = dots[dots.idx];                       # unname(dots[dots.idx]); 

    res;
    } 

解决方法

您可以mget函数环境。

adebo.deepSearch <- function(z,pi_0 = 0.3,families=list(),... ) {
  c(mget(ls(environment(),sorted=F)),match.call(expand.dots=F)$...)
}
adebo.deepSearch(foo=1,z=2)
# $z
# [1] 2
# 
# $pi_0
# [1] 0.3
# 
# $families
# list()
# 
# $foo
# [1] 1
,

这是一种可能的解决方案。此解决方案需要没有指定默认值的函数参数(如下面的 z)。

grabFunctionParameters <- function() {
  pf <- parent.frame()                                   # get caller environment
  dots <- eval(quote(list(...)),envir = pf)             # get ... in the caller
  nms <- sapply(ls(envir = pf,sorted = FALSE),as.name) # get argument names different from names in ... in the caller
  out <- c(lapply(nms,eval,envir = pf),dots)          # get all arguments/values
  out[names(out) != ""]                                  # remove unnamed values in ... (if any)
}

用例示例

adebo.deepSearch = function(z,... ) {
  args = grabFunctionParameters();
  args
}

一些场景

adebo.deepSearch(z=4)
# $z
# [1] 4
# 
# $pi_0
# [1] 0.3
# 
# $families
# list()
# 
adebo.deepSearch(z=4,pi_0=9,families = list(z=1:2))  
# $z
# [1] 4
# 
# $pi_0
# [1] 9
# 
# $families
# $families$z
# [1] 1 2
# 
# 
adebo.deepSearch(z=4,ac=5,bc=6)  # some additional arguments for ...
# $z
# [1] 4
# 
# $pi_0
# [1] 9
# 
# $families
# list()
# 
# $ac
# [1] 5
# 
# $bc
# [1] 6

Udapte:这是对上述函数的更新,使其更通用。

它总是返回一个列表:

  • 如果调用者(函数)没有参数(或只有......具有未命名的值),则为空列表。
  • 形式参数名称(不在...中)可以以点开头。 前一个函数要求调用者具有 ...;并且正式参数名称以点开头(不在 ...)的调用者没有返回。

新功能

grabFunctionParameters <- function() {
    pf <- parent.frame()    
    args_names <- ls(envir = pf,all.names = TRUE,sorted = FALSE)
    if("..." %in% args_names) {
    dots <- eval(quote(list(...)),envir = pf)
    }  else {
    dots = list()
    }
    args_names <- sapply(setdiff(args_names,"..."),as.name)
    if(length(args_names)) {
    not_dots <- lapply(args_names,envir = pf) 
    } else {
    not_dots <- list()
    }
    out <- c(not_dots,dots)
    out[names(out) != ""]                                  # remove unnamed values in ... (if any)
}   

一些场景

fn1 <- function() grabFunctionParameters()                              # the initial function (before the update) required ... argument
fn2 <- function(x=1,.a=2,b=list(),...) grabFunctionParameters()      # the initial function did not return .a 
fn3 <- function(.x,...) grabFunctionParameters()
fn4 <- function(...) grabFunctionParameters()
fn5 <- function(x,.a) grabFunctionParameters()                        # the initial function required ... argument


fn1()     # correct since the caller has no argument. Previously not allowed!
# list()

fn2()
# $x
# [1] 1
# 
# $.a
# [1] 2
# 
# $b
# list()
                                    
fn2(.a=10,ac=4,bc=7,.xy=1)      #    
# $x
# [1] 1
# 
# $.a
# [1] 10
# 
# $b
# list()
# 
# $ac
# [1] 4
# 
# $bc
# [1] 7
# 
# $.xy
# [1] 1

fn3(10)
# $.x
# [1] 10
# 
# $.a
# [1] 2
# 
# $b
# list()

fn3()       # throw an error! (.x required!). This will not happen if we use mget function and not lapply/supply inside grabFunctionParameters above. 
# Error in FUN(X[[i]],...) : argument ".x" is missing,with no default

fn4(a = 5,b = 6,c = 6,6,7,9)       # unnamed values are dropped
# $a
# [1] 5
# 
# $b
# [1] 6
# 
# $c
# [1] 6

fn5(6,8)
# $x
# [1] 6
# 
# $.a
# [1] 8
,
adebo <- function(z,families = list(),...) {
  args <- formals(adebo)
  return(args)
}

adebo()
#> $z
#> 
#> 
#> $pi_0
#> [1] 0.3
#> 
#> $families
#> list()
#> 
#> $...

reprex package (v1.0.0) 于 2021 年 2 月 23 日创建

,

不是解决方案,而是捕捉“...”部分的想法。以 quosure 或 quosures 列表的形式返回为 ... 传入的参数。

adebo <- function(z,...) {
  rlang::enquos(...)
}

adebo(trash = "trash",idea = "idea")
#> <list_of<quosure>>
#> 
#> $trash
#> <quosure>
#> expr: ^"trash"
#> env:  empty
#> 
#> $idea
#> <quosure>
#> expr: ^"idea"
#> env:  empty

reprex package (v1.0.0) 于 2021 年 2 月 23 日创建

版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。