在FUN中访问lapply索引名

小开

最佳答案

不幸的是，lapply只给你传递给它的向量的元素。通常的解决方法是将向量的名称或下标传递给它，而不是向量本身

但请注意，你总是可以传递额外的参数给函数，所以下面的工作:

x <- list(a=11,b=12,c=13) # Changed to list to address concerns in commments
lapply(seq_along(x), function(y, n, i) { paste(n[[i]], y[[i]]) }, y=x, n=names(x))

这里我在x的索引上使用了lapply，但也传入了x和x的名称。正如你所看到的，函数参数的顺序可以是任何东西——lapply将“元素”(这里是索引)传递给在额外的参数中指定的第一个参数不。在本例中，我指定了y和n，因此只剩下i……

这会产生以下结果:

[[1]]
[1] "a 11"


[[2]]
[1] "b 12"


[[3]]
[1] "c 13"

更新简单的例子，相同的结果:

lapply(seq_along(x), function(i) paste(names(x)[[i]], x[[i]]))

这里函数使用“全局”变量x并在每次调用中提取名称。

小开

汤米的答案适用于命名向量，但我知道你对列表感兴趣。似乎他在绕一圈因为他引用了调用环境中的x。这个函数只使用传递给函数的参数，因此不假设传递对象的名称:

x <- list(a=11,b=12,c=13)
lapply(x, function(z) { attributes(deparse(substitute(z)))$names  } )
#--------
$a
NULL


$b
NULL


$c
NULL
#--------
names( lapply(x, function(z) { attributes(deparse(substitute(z)))$names  } ))
#[1] "a" "b" "c"
what_is_my_name <- function(ZZZ) return(deparse(substitute(ZZZ)))
what_is_my_name(X)
#[1] "X"
what_is_my_name(ZZZ=this)
#[1] "this"
exists("this")
#[1] FALSE

小开

更新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是循环中的当前索引。如果我们得到这个FUN(X[[1L]], ...)1，它将被求值(即，如果我们使用substitute)，我们将得到未求值的表达式X[[i]]。这是对[[函数的调用，参数X(一个符号)和i(一个整数)。所以FUN(X[[1L]], ...)0返回的正是这个整数。

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

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将创建一个names可以访问的合法对象。有点棘手，但很有效。

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

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

注意，X是FUN父帧中的一个有效对象，并且引用了lapply的list参数，所以我们可以通过eval.parent得到它。

小开

这基本上使用了与Tommy相同的解决方法，但是使用Map()，不需要访问存储列表组件名称的全局变量。

> x <- list(a=11, b=12, c=13)
> Map(function(x, i) paste(i, x), x, names(x))
$a
[1] "a 11"


$b
[1] "b 12"


$c
[1] "c 13

或者，如果你喜欢mapply()

> mapply(function(x, i) paste(i, x), x, names(x))
a      b      c
"a 11" "b 12" "c 13"

小开

我的答案与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))

小开

同样的问题我已经遇到过很多次了… 我开始用另一种方法…我没有使用lapply，而是开始使用mapply

n = names(mylist)
mapply(function(list.elem, names) { }, list.elem = mylist, names = n)

小开

只需要把名字循环进去。

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

小开

只需编写自己的自定义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))

小开

你可以尝试使用purrr包中的imap()。

从文档中可以看到:

Imap (x，…)是map2(x, names(x)，…)的简写，如果x有名称，则Imap (x, seq_along(x)，…)

所以，你可以这样使用它:

library(purrr)
myList <- list(a=11,b=12,c=13)
imap(myList, function(x, y) paste(x, y))

这将给你以下结果:

$a
[1] "11 a"


$b
[1] "12 b"


$c
[1] "13 c"

小开

@caracals和@Tommy都是很好的解决方案，这是一个包括list和data.frame的例子 r是list´s和data.frame´s的list(结尾是dput(r[[1]])。< / p >

names(r)
[1] "todos"  "random"
r[[1]][1]
$F0
$F0$rst1
algo  rst  prec  rorac prPo pos
1  Mean 56.4 0.450 25.872 91.2 239
6  gbm1 41.8 0.438 22.595 77.4 239
4  GAM2 37.2 0.512 43.256 50.0 172
7  gbm2 36.8 0.422 18.039 85.4 239
11 ran2 35.0 0.442 23.810 61.5 239
2  nai1 29.8 0.544 52.281 33.1 172
5  GAM3 28.8 0.403 12.743 94.6 239
3  GAM1 21.8 0.405 13.374 68.2 239
10 ran1 19.4 0.406 13.566 59.8 239
9  svm2 14.0 0.385  7.692 76.2 239
8  svm1  0.8 0.359  0.471 71.1 239


$F0$rst5
algo  rst  prec  rorac prPo pos
1  Mean 52.4 0.441 23.604 92.9 239
7  gbm2 46.4 0.440 23.200 83.7 239
6  gbm1 31.2 0.416 16.421 79.5 239
5  GAM3 28.8 0.403 12.743 94.6 239
4  GAM2 28.2 0.481 34.815 47.1 172
11 ran2 26.6 0.422 18.095 61.5 239
2  nai1 23.6 0.519 45.385 30.2 172
3  GAM1 20.6 0.398 11.381 75.7 239
9  svm2 14.4 0.386  8.182 73.6 239
10 ran1 14.0 0.390  9.091 64.4 239
8  svm1  6.2 0.370  3.584 72.4 239

目标是unlist所有列表，将list的名称序列作为列来标识情况。

r=unlist(unlist(r,F),F)
names(r)
[1] "todos.F0.rst1"  "todos.F0.rst5"  "todos.T0.rst1"  "todos.T0.rst5"  "random.F0.rst1" "random.F0.rst5"
[7] "random.T0.rst1" "random.T0.rst5"

取消列表，但不取消data.frame `。

ra=Reduce(rbind,Map(function(x,y) cbind(case=x,y),names(r),r))

Map将名称序列作为一列。Reduce加入所有data.frame。

head(ra)
case algo  rst  prec  rorac prPo pos
1  todos.F0.rst1 Mean 56.4 0.450 25.872 91.2 239
6  todos.F0.rst1 gbm1 41.8 0.438 22.595 77.4 239
4  todos.F0.rst1 GAM2 37.2 0.512 43.256 50.0 172
7  todos.F0.rst1 gbm2 36.8 0.422 18.039 85.4 239
11 todos.F0.rst1 ran2 35.0 0.442 23.810 61.5 239
2  todos.F0.rst1 nai1 29.8 0.544 52.281 33.1 172

注:r[[1]]:

    structure(list(F0 = structure(list(rst1 = structure(list(algo = c("Mean",
"gbm1", "GAM2", "gbm2", "ran2", "nai1", "GAM3", "GAM1", "ran1",
"svm2", "svm1"), rst = c(56.4, 41.8, 37.2, 36.8, 35, 29.8, 28.8,
21.8, 19.4, 14, 0.8), prec = c(0.45, 0.438, 0.512, 0.422, 0.442,
0.544, 0.403, 0.405, 0.406, 0.385, 0.359), rorac = c(25.872,
22.595, 43.256, 18.039, 23.81, 52.281, 12.743, 13.374, 13.566,
7.692, 0.471), prPo = c(91.2, 77.4, 50, 85.4, 61.5, 33.1, 94.6,
68.2, 59.8, 76.2, 71.1), pos = c(239L, 239L, 172L, 239L, 239L,
172L, 239L, 239L, 239L, 239L, 239L)), .Names = c("algo", "rst",
"prec", "rorac", "prPo", "pos"), row.names = c(1L, 6L, 4L, 7L,
11L, 2L, 5L, 3L, 10L, 9L, 8L), class = "data.frame"), rst5 = structure(list(
algo = c("Mean", "gbm2", "gbm1", "GAM3", "GAM2", "ran2",
"nai1", "GAM1", "svm2", "ran1", "svm1"), rst = c(52.4, 46.4,
31.2, 28.8, 28.2, 26.6, 23.6, 20.6, 14.4, 14, 6.2), prec = c(0.441,
0.44, 0.416, 0.403, 0.481, 0.422, 0.519, 0.398, 0.386, 0.39,
0.37), rorac = c(23.604, 23.2, 16.421, 12.743, 34.815, 18.095,
45.385, 11.381, 8.182, 9.091, 3.584), prPo = c(92.9, 83.7,
79.5, 94.6, 47.1, 61.5, 30.2, 75.7, 73.6, 64.4, 72.4), pos = c(239L,
239L, 239L, 239L, 172L, 239L, 172L, 239L, 239L, 239L, 239L
)), .Names = c("algo", "rst", "prec", "rorac", "prPo", "pos"
), row.names = c(1L, 7L, 6L, 5L, 4L, 11L, 2L, 3L, 9L, 10L, 8L
), class = "data.frame")), .Names = c("rst1", "rst5")), T0 = structure(list(
rst1 = structure(list(algo = c("Mean", "ran1", "GAM1", "GAM2",
"gbm1", "svm1", "nai1", "gbm2", "svm2", "ran2"), rst = c(22.6,
19.4, 13.6, 10.2, 9.6, 8, 5.6, 3.4, -0.4, -0.6), prec = c(0.478,
0.452, 0.5, 0.421, 0.423, 0.833, 0.429, 0.373, 0.355, 0.356
), rorac = c(33.731, 26.575, 40, 17.895, 18.462, 133.333,
20, 4.533, -0.526, -0.368), prPo = c(34.4, 52.1, 24.3, 40.7,
37.1, 3.1, 14.4, 53.6, 54.3, 116.4), pos = c(195L, 140L,
140L, 140L, 140L, 195L, 195L, 140L, 140L, 140L)), .Names = c("algo",
"rst", "prec", "rorac", "prPo", "pos"), row.names = c(1L,
9L, 3L, 4L, 5L, 7L, 2L, 6L, 8L, 10L), class = "data.frame"),
rst5 = structure(list(algo = c("gbm1", "ran1", "Mean", "GAM1",
"GAM2", "svm1", "nai1", "svm2", "gbm2", "ran2"), rst = c(17.6,
16.4, 15, 12.8, 9, 6.2, 5.8, -2.6, -3, -9.2), prec = c(0.466,
0.434, 0.435, 0.5, 0.41, 0.8, 0.44, 0.346, 0.345, 0.337),
rorac = c(30.345, 21.579, 21.739, 40, 14.754, 124, 23.2,
-3.21, -3.448, -5.542), prPo = c(41.4, 54.3, 35.4, 22.9,
43.6, 2.6, 12.8, 57.9, 62.1, 118.6), pos = c(140L, 140L,
195L, 140L, 140L, 195L, 195L, 140L, 140L, 140L)), .Names = c("algo",
"rst", "prec", "rorac", "prPo", "pos"), row.names = c(5L,
9L, 1L, 3L, 4L, 7L, 2L, 8L, 6L, 10L), class = "data.frame")), .Names = c("rst1",
"rst5"))), .Names = c("F0", "T0"))

小开

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

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"

小开

@ferdinand-kraft给了我们一个很棒的技巧，然后告诉我们不应该使用它因为它没有记录，也因为性能开销我对第一点没有太多的争论，但我想指出的是，开销

让我们定义活动函数，这样我们就不必调用复杂表达式我们还将创建.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")

< img src = " https://i.imgur.com/TC2JMJE.png " alt = " " >

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

< img src = " https://i.imgur.com/qNulLc0.png " alt = " " >

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

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

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