访问在 apply 中作为参数传递的变量名称答案

【问题标题】：Accesing variable name passed as argument inside apply访问在 apply 中作为参数传递的变量名称
【发布时间】：2023-02-09 18:56:11
【问题描述】：

我在另一篇文章中提出了几乎相同的问题，但只询问列名，并收到了满足该需求的完美解决方案。现在我需要的是变量全名.我在这里重新表述。

我在函数内部使用“deparse(substitute(x))”来获取作为参数传递的变量名。它工作得很好......但不适用于'lapply'

myfun <- function(x)
{
  return(deparse(substitute(x)))
}

a <- c(1,2,3)
b <- c(4,5,5)
df<-data.frame(a,b)
myfun(df$a)

[1] "df$a"

但是，随着'lapply'......

lapply(df, myfun)
$a
[1] "X[[i]]"

$b
[1] "X[[i]]"

如何获取“lapply”中的变量名？

谢谢

【问题讨论】：

标签： r

【解决方案1】：

当您将数据框传递给 lapply 时，它会通过以下方式遍历列数字使用双方括号索引，而不是姓名使用 $ 访问器进行索引。它等效于使用以下循环：

X <- df
result <- list()

for(i in seq_along(X)) {
  result[[i]] <- myfun(X[[i]])
} 

names(result) <- names(X)

result
#> $a
#> [1] "X[[i]]"
#> 
#> $b
#> [1] "X[[i]]"

所以一个简单的deparse(substitute(x))在lapply中是行不通的。你不是正在恢复列名，而是需要重建它来自调用堆栈。这充满了警告和陷阱，但一个（相对）简单的方法是：

myfun <- function(x)
{
  stack <- lapply(sys.calls(), function(x) sapply(as.list(x), deparse))
  
  if(stack[[length(stack)]][1] == 'myfun') {
    return(stack[[length(stack)]][2])
  }
  
  if(stack[[length(stack)]][1] == 'FUN') {
    paste0(stack[[length(stack) - 1]][2], '$',
           eval(quote(names(X)[i]), parent.frame()))
  }
}

这意味着如果直接调用你的函数仍然有效：

myfun(df$a)
#> [1] "df$a"

但也将在lapply内工作

lapply(df, myfun)
#> $a
#> [1] "df$a"
#> 
#> $b
#> [1] "df$b"

lapply(iris, myfun)
#> $Sepal.Length
#> [1] "iris$Sepal.Length"
#>
#> $Sepal.Width
#> [1] "iris$Sepal.Width"
#>
#> $Petal.Length
#> [1] "iris$Petal.Length"
#>
#> $Petal.Width
#> [1] "iris$Petal.Width"
#>
#> $Species
#> [1] "iris$Species"

【讨论】：

【解决方案2】：

我们可以定义一个字符串'col_name'取函数中数据框列的名称。例如，如果 col_name 是 "a"，df[[col_name]] 从数据框中提取 "a" 列。然后我们可以使用 paste() 函数连接字符串 'df$' 和 'col_name'：

   myfun <- function(col_name) {
  col <- df[[col_name]]
  return(paste("df$", col_name, sep = ""))
}


 lapply(colnames(df), myfun)

输出

[[1]]
[1] "df$a"

[[2]]
[1] "df$b"

我希望这会有所帮助。

【讨论】：

但是现在如果数据框被称为 df 以外的任何东西，这将不起作用，如果直接调用它也不会起作用（例如 myfun(df$a) 不再提供预期的输出。

【解决方案3】：

这是另一个解决方案，它有点冗长，艾伦的解决方案要好得多：

myfun <- function(x) {
  pf <- parent.frame()
  x_nm <- deparse(substitute(x))
  frame_n <- sys.nframe()
  
  apply <- FALSE
  while(frame_n > 0) {
    cl <- as.list(sys.call(frame_n))
    if (grepl("apply", cl[[1]])) {
      x_obj <- cl[[2]]
      apply <- TRUE
      break
    }
    frame_n <- frame_n - 1L
  }
  
  if (apply) {
    idx <- parent.frame()$i[]  
    obj <- get(x_obj, envir = pf)
    if (!is.null(names(obj)[idx])) {
      nm_or_idx <- names(obj)[idx]
    } else {
      nm_or_idx <- idx
    }
    x_nm <- paste0(x_obj, '$', nm_or_idx)
  }
  
  return(x_nm)
}


myfun(df$a)
#> [1] "df$a"

lapply(df, myfun)
#> $a
#> [1] "df$a"
#> 
#> $b
#> [1] "df$b"

^{由 reprex package (v2.0.1) 创建于 2023-02-09}

【讨论】：