只需编写自己的自定义lapply函数

lapply2 <- function(X, FUN){
  if( length(formals(FUN)) == 1 ){
    # No index passed - use normal lapply
    R = lapply(X, FUN)
  }else{
    # Index passed
    R = lapply(seq_along(X), FUN=function(i){
      FUN(X[[i]], i)
    })
  }

  # Set names
  names(R) = names(X)
  return(R)
}

然后像这样使用:

lapply2(letters, function(x, i) paste(x, i))

我的答案与Tommy和caracals的方向相同，但避免了将列表保存为额外对象。

lapply(seq(3), function(i, y=list(a=14,b=15,c=16)) { paste(names(y)[[i]], y[[i]]) })

结果:

[[1]]
[1] "a 14"

[[2]]
[1] "b 15"

[[3]]
[1] "c 16"

这将列表作为FUN的命名参数(而不是lapply)。Lapply只需要遍历列表的元素(在更改列表长度时，要注意将第一个参数更改为Lapply)。

注意:将列表直接作为附加参数提供给lapply也可以:

lapply(seq(3), function(i, y) { paste(names(y)[[i]], y[[i]]) }, y=list(a=14,b=15,c=16))

更新R版本3.2

免责声明:这是一个hack技巧，并可能停止工作在下一个版本。

你可以使用下面的方法获取索引:

> lapply(list(a=10,b=20), function(x){parent.frame()$i[]})
$a
[1] 1

$b
[1] 2

注意:[]是必需的，因为它欺骗R认为符号i(驻留在lapply的计算框架中)可能有更多的引用，从而激活它的惰性复制。如果没有它，R将不会保留i的分离副本:

> lapply(list(a=10,b=20), function(x){parent.frame()$i})
$a
[1] 2

$b
[1] 2

可以使用其他奇异的技巧，如function(x){parent.frame()$i+0}或function(x){——parent.frame()$i}。

性能的影响

强制复制是否会造成性能损失?是的!以下是基准:

> x <- as.list(seq_len(1e6))

> system.time( y <- lapply(x, function(x){parent.frame()$i[]}) )
user system elapsed
2.38 0.00 2.37
> system.time( y <- lapply(x, function(x){parent.frame()$i[]}) )
user system elapsed
2.45 0.00 2.45
> system.time( y <- lapply(x, function(x){parent.frame()$i[]}) )
user system elapsed
2.41 0.00 2.41
> y[[2]]
[1] 2

> system.time( y <- lapply(x, function(x){parent.frame()$i}) )
user system elapsed
1.92 0.00 1.93
> system.time( y <- lapply(x, function(x){parent.frame()$i}) )
user system elapsed
2.07 0.00 2.09
> system.time( y <- lapply(x, function(x){parent.frame()$i}) )
user system elapsed
1.89 0.00 1.89
> y[[2]]
[1] 1000000

结论

这个答案只是表明你不应该使用这个…如果您找到了另一个类似Tommy上面的解决方案，不仅您的代码更易于阅读，而且与未来的版本更兼容，您还可能失去核心团队努力开发的优化!

---

旧版本的把戏，不再起作用:

> lapply(list(a=10,b=10,c=10), function(x)substitute(x)[[3]])

结果:

$a
[1] 1

$b
[1] 2

$c
[1] 3

说明:lapply创建的调用形式为FUN(X[[1L]]，…)，FUN(X[[2L]]，…)等。所以它传递的参数是X[[i]]，其中i是循环中的当前索引。如果我们在它被求值之前得到它(即，如果我们使用替换)，我们得到未求值的表达式X[[i]]。这是对[[函数的调用，参数X(一个符号)和i(一个整数)。因此，substitute(x)[[3]]返回的正是这个整数。

有了索引，你可以简单地访问名称，如果你先像这样保存它:

L <- list(a=10,b=10,c=10)
n <- names(L)
lapply(L, function(x)n[substitute(x)[[3]]])

结果:

$a
[1] "a"

$b
[1] "b"

$c
[1] "c"

或者使用第二个技巧::-)

lapply(list(a=10,b=10,c=10), function(x)names(eval(sys.call(1)[[2]]))[substitute(x)[[3]]])

(结果相同)。

解释2:sys.call(1)返回lapply(…)，因此sys.call(1)[[2]]是用作lapply列表参数的表达式。将此传递给eval将创建一个名称可以访问的合法对象。有点棘手，但很有效。

好处:第二种获取名字的方法:

lapply(list(a=10,b=10,c=10), function(x)eval.parent(quote(names(X)))[substitute(x)[[3]]])

注意，X在FUN的父框架中是一个有效的对象，它引用了lapply的list参数，所以我们可以使用eval.parent访问它。

假设我们想计算每个元素的长度。

mylist <- list(a=1:4,b=2:9,c=10:20)
mylist

$a
[1] 1 2 3 4

$b
[1] 2 3 4 5 6 7 8 9

$c
 [1] 10 11 12 13 14 15 16 17 18 19 20

如果目的仅仅是标记结果元素，那么lapply(mylist,length)或更低的值可以工作。

sapply(mylist,length,USE.NAMES=T)

 a  b  c 
 4  8 11 

如果目标是在函数内部使用标签，则mapply()通过遍历两个对象非常有用;列表元素和列表名称。

fun <- function(x,y) paste0(length(x),"_",y)
mapply(fun,mylist,names(mylist))

     a      b      c 
 "4_a"  "8_b" "11_c" 

只需要把名字循环进去。

sapply(names(mylist), function(n) { 
    doSomething(mylist[[n]])
    cat(n, '\n')
}

@ferdinand-kraft给了我们一个很棒的技巧，然后告诉我们我们不应该使用它 因为它没有记录，也因为性能开销。

我对第一点没有太多的争论，但我想指出的是，开销 很少会担心。

让我们定义活动函数，这样我们就不必调用复杂表达式 parent.frame()$i[]但只有.i()，我们还将创建.n()来访问 名称，它应该适用于基函数和purrr函数(可能也适用于大多数其他函数)。

.i <- function() parent.frame(2)$i[]
# looks for X OR .x to handle base and purrr functionals
.n <- function() {
  env <- parent.frame(2)
  names(c(env$X,env$.x))[env$i[]]
}

sapply(cars, function(x) paste(.n(), .i()))
#>     speed      dist 
#> "speed 1"  "dist 2"

现在让我们对一个简单的函数进行基准测试，该函数将向量的项粘贴到它们的下标， 使用不同的方法(此操作当然可以使用paste(vec, seq_along(vec))向量化，但这不是这里的重点)。

我们定义了一个基准测试函数和一个绘图函数，并将结果绘制如下:

library(purrr)
library(ggplot2)
benchmark_fun <- function(n){
  vec <- sample(letters,n, replace = TRUE)
  mb <- microbenchmark::microbenchmark(unit="ms",
                                      lapply(vec, function(x)  paste(x, .i())),
                                      map(vec, function(x) paste(x, .i())),
                                      lapply(seq_along(vec), function(x)  paste(vec[[x]], x)),
                                      mapply(function(x,y) paste(x, y), vec, seq_along(vec), SIMPLIFY = FALSE),
                                      imap(vec, function(x,y)  paste(x, y)))
  cbind(summary(mb)[c("expr","mean")], n = n)
}

benchmark_plot <- function(data, title){
  ggplot(data, aes(n, mean, col = expr)) + 
    geom_line() +
    ylab("mean time in ms") +
    ggtitle(title) +
    theme(legend.position = "bottom",legend.direction = "vertical")
}

plot_data <- map_dfr(2^(0:15), benchmark_fun)
benchmark_plot(plot_data[plot_data$n <= 100,], "simplest call for low n")

benchmark_plot(plot_data,"simplest call for higher n")

由reprex包于2019年11月15日创建(v0.3.0)

第一张图表开头的下跌是偶然的，请忽略它。

我们可以看到，所选的答案确实更快，对于相当数量的迭代，我们的I()解决方案确实更慢，与所选答案相比，开销大约是使用purrr::imap()的开销的3倍，30k次迭代大约为25毫秒，因此每1000次迭代大约损失1毫秒，每百万次损失1秒。在我看来，这是为了方便而付出的小代价。