Acceda a nombres de índice de lapply dentro de FUN

¿Hay alguna manera de obtener el nombre del índice de la lista en mi función lapply ()?

n = names(mylist)
lapply(mylist, function(list.elem) { cat("What is the name of this list element?\n" })

Pregunté antes si es posible preservar los nombres de índice en la lista devuelta lapply () , pero todavía no sé si hay una manera fácil de recuperar cada nombre de elemento dentro de la función personalizada. Me gustaría evitar llamar a lapply en los nombres mismos, prefiero obtener el nombre en los parámetros de la función.

Desafortunadamente, lapplysolo te da los elementos del vector que le pasas. La solución habitual es pasarle los nombres o índices del vector en lugar del vector en sí.

Pero tenga en cuenta que siempre puede pasar argumentos adicionales a la función, por lo que lo siguiente funciona:

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

Aquí uso lapplysobre los índices de x, pero también paso xy los nombres de x. Como puede ver, el orden de los argumentos de la función puede ser cualquier cosa: lapplypasará el "elemento" (aquí el índice) al primer argumento no especificado entre los adicionales. En este caso, especifico yy n, así que solo iqueda ...

Lo que produce lo siguiente:

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

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

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

ACTUALIZACIÓN Ejemplo más simple, mismo resultado:

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

Aquí la función utiliza la variable "global" xy extrae los nombres en cada llamada.

Básicamente, utiliza la misma solución alternativa que Tommy, pero con Map(), no hay necesidad de acceder a las variables globales que almacenan los nombres de los componentes de la lista.

> 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

O si lo prefieres mapply()

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

ACTUALIZACIÓN para R versión 3.2

Descargo de responsabilidad: este es un truco hacky, y puede dejar de funcionar en los próximos lanzamientos.

Puede obtener el índice usando esto:

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

$b
[1] 2

Nota: []es necesario para que esto funcione, ya que engaña a R para que piense que el símbolo i(que reside en el marco de evaluación de lapply) puede tener más referencias, lo que activa la duplicación perezosa de este. Sin ella, R no guardará copias separadas de i:

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

$b
[1] 2

Se pueden usar otros trucos exóticos, como function(x){parent.frame()$i+0}o function(x){--parent.frame()$i}.

Impacto en el rendimiento

¿La duplicación forzada causará pérdida de rendimiento? ¡Si! Aquí están los puntos de referencia:

> 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

Conclusión

Esta respuesta solo muestra que NO debe usar esto ... No solo su código será más legible si encuentra otra solución como la de Tommy anterior, y más compatible con futuras versiones, también corre el riesgo de perder las optimizaciones que el equipo central ha trabajado duro para ¡desarrollar!

Trucos de versiones anteriores, que ya no funcionan:

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

Resultado:

$a
[1] 1

$b
[1] 2

$c
[1] 3

Explicación: lapplycrea llamadas del formulario FUN(X[[1L]], ...), FUN(X[[2L]], ...)etc. Entonces, el argumento que pasa es X[[i]]dónde iestá el índice actual en el bucle. Si obtenemos esto antes de que sea evaluado (es decir, si lo usamos substitute), obtenemos la expresión no evaluada X[[i]]. Esta es una llamada a la [[función, con argumentosX (un símbolo) y i(un número entero). Entonces substitute(x)[[3]]devuelve precisamente este entero.

Al tener el índice, puede acceder a los nombres trivialmente, si lo guarda primero así:

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

Resultado:

$a
[1] "a"

$b
[1] "b"

$c
[1] "c"

O usando este segundo truco: :-)

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

(El resultado es el mismo).

Explicación 2: sys.call(1) devuelve lapply(...), entonces esa sys.call(1)[[2]]es la expresión utilizada como argumento de lista para lapply. Pasando esto aeval crea un objeto legítimo al que namespuede acceder. Difícil, pero funciona.

Bono: una segunda forma de obtener los nombres:

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

Tenga en cuenta que Xes un objeto válido en el marco primario de FUN, y hace referencia al argumento de lista de lapply, por lo que podemos llegar a él con eval.parent.

He tenido el mismo problema muchas veces ... Empecé a usar otra forma ... En lugar de usar lapply, comencé a usarmapply

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

Puedes intentar usar imap()desdepurrr paquete.

De la documentación:

imap (x, ...) es la abreviatura de map2 (x, names (x), ...) si x tiene nombres, o map2 (x, seq_along (x), ...) si no los tiene.

Entonces, puedes usarlo de esa manera:

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

Lo que te dará el siguiente resultado:

$a
[1] "11 a"

$b
[1] "12 b"

$c
[1] "13 c"

Solo ingrese los nombres.

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

La respuesta de Tommy se aplica a los vectores con nombre, pero tengo la idea de que te interesan las listas. Y parece que estaba haciendo una vuelta porque hacía referencia a "x" desde el entorno de llamada. Esta función usa solo los parámetros que se pasaron a la función y, por lo tanto, no hace suposiciones sobre el nombre de los objetos que se pasaron:

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

Mi respuesta va en la misma dirección que Tommy y los caracales, pero evita tener que guardar la lista como un objeto adicional.

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

Resultado:

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

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

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

Esto le da a la lista un argumento con nombre a FUN (en lugar de lapply). lapply solo tiene que iterar sobre los elementos de la lista (tenga cuidado de cambiar este primer argumento a lapply cuando cambie la longitud de la lista).

Nota: Dar la lista directamente a lapply como argumento adicional también funciona:

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

Tanto @caracals como @Tommy son buenas soluciones y este es un ejemplo que incluye list´s y data.frame´s.
res un listde list´s y data.frame´s ( dput(r[[1]]al final).

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

El objetivo es unlisttodas las listas, colocando la secuencia de listlos nombres como columnas para identificar el caso.

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"

Deslista las listas pero no las data.frame´s.

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

Mappone la secuencia de nombres como una columna. Reduceúnete a todos 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

PD 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"))

Digamos que queremos calcular la longitud de cada elemento.

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

Si el objetivo es simplemente etiquetar los elementos resultantes, entonces lapply(mylist,length)o debajo funciona.

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

 a  b  c 
 4  8 11 

Si el objetivo es usar la etiqueta dentro de la función, entonces mapply()es útil haciendo un bucle sobre dos objetos; los elementos de la lista y los nombres de la lista.

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

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

@ ferdinand-kraft nos dio un gran truco y luego nos dice que no deberíamos usarlo porque no está documentado y debido a la sobrecarga de rendimiento.

No puedo discutir mucho con el primer punto, pero me gustaría señalar que los gastos generales rara vez deberían ser una preocupación.

definamos las funciones activas para que no tengamos que llamar a la expresión compleja parent.frame()$i[]sino que solo .i()crearemos .n()para acceder al nombre, que debería funcionar tanto para las funciones base como para las purrr (y probablemente también para la mayoría de las otras).

.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"

Ahora comparemos una función simple que pega los elementos de un vector a su índice, utilizando diferentes enfoques (estas operaciones pueden, por supuesto, ser vectorizadas usando paste(vec, seq_along(vec)) pero ese no es el punto aquí).

Definimos una función de evaluación comparativa y una función de trazado y trazamos los resultados a continuación:

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

^{Creado el 15/11/2019 por el paquete reprex (v0.3.0)}

La caída al comienzo del primer gráfico es una casualidad, ignórela.

Vemos que la respuesta elegida es de hecho más rápida, y para una cantidad decente de iteraciones nuestras .i()soluciones son de hecho más lentas, la sobrecarga en comparación con la respuesta elegida es aproximadamente 3 veces la sobrecarga de uso purrr::imap(), y asciende a aproximadamente 25 ms para 30k iteraciones, así que pierdo aproximadamente 1 ms por 1000 iteraciones, 1 segundo por millón. Eso es un pequeño costo de conveniencia en mi opinión.

Simplemente escriba su propia lapplyfunción personalizada

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

Luego use así:

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