Accéder aux noms d'index lapply dans FUN

Existe-t-il un moyen d'obtenir le nom de l'index de la liste dans ma fonction lapply ()?

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

J'ai demandé avant s'il est possible de conserver les noms d'index dans le lapply () retour liste, mais je ne sais toujours pas s'il y a un moyen facile de chercher le nom de chaque élément dans la fonction personnalisée. Je voudrais éviter d'appeler lapply sur les noms eux-mêmes, je préfère obtenir le nom dans les paramètres de la fonction.

Malheureusement, lapply ne vous donne que les éléments du vecteur que vous lui transmettez. La solution habituelle consiste à lui transmettre les noms ou les indices du vecteur au lieu du vecteur lui-même.

Mais notez que vous pouvez toujours passer des arguments supplémentaires à la fonction, donc ce qui suit fonctionne:

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

Ici, j'utilise lapplysur les indices de x, mais aussi je passe xet les noms de x. Comme vous pouvez le voir, l'ordre des arguments de la fonction peut être n'importe quoi - lapplypassera dans l '"élément" (ici l'index) au premier argument non spécifié parmi les supplémentaires. Dans ce cas, je précise yet n, donc il ne ireste plus que ...

Ce qui produit ce qui suit:

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

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

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

UPDATE Exemple plus simple, même résultat:

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

Ici, la fonction utilise la variable "globale" xet extrait les noms dans chaque appel.

Cela utilise essentiellement la même solution de contournement que Tommy, mais avec Map(), il n'est pas nécessaire d'accéder aux variables globales qui stockent les noms des composants de la liste.

> 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

Ou, si vous préférez mapply()

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

MISE À JOUR pour la version R 3.2

Clause de non-responsabilité: c'est un truc de piratage, et peut cesser de fonctionner dans les prochaines versions.

Vous pouvez obtenir l'index en utilisant ceci:

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

$b
[1] 2

Remarque: le []est nécessaire pour que cela fonctionne, car il incite R à penser que le symbole i(résidant dans le cadre d'évaluation de lapply) peut avoir plus de références, activant ainsi la duplication paresseuse de celui-ci. Sans cela, R ne conservera pas de copies séparées de i:

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

$b
[1] 2

D'autres astuces exotiques peuvent être utilisées, comme function(x){parent.frame()$i+0}ou function(x){--parent.frame()$i}.

Impact sur la performance

La duplication forcée entraînera-t-elle une perte de performances? Oui! voici les benchmarks:

> 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

Conclusion

Cette réponse montre simplement que vous ne devriez PAS utiliser ceci ... Non seulement votre code sera plus lisible si vous trouvez une autre solution comme celle de Tommy ci-dessus, et plus compatible avec les versions futures, vous risquez également de perdre les optimisations pour lesquelles l'équipe principale a travaillé dur. développer!

Astuces des anciennes versions, ne fonctionnant plus:

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

Résultat:

$a
[1] 1

$b
[1] 2

$c
[1] 3

Explication: lapplycrée des appels du formulaire FUN(X[[1L]], ...), FUN(X[[2L]], ...)etc. Donc l'argument qu'il passe est X[[i]]où iest l'index courant dans la boucle. Si nous obtenons cela avant qu'il ne soit évalué (c'est-à-dire si nous utilisons substitute), nous obtenons l'expression non évaluée X[[i]]. C'est un appel à la [[fonction, avec des arguments X(un symbole) et i(un entier). Donc substitute(x)[[3]]renvoie précisément cet entier.

Ayant l'index, vous pouvez accéder aux noms de manière triviale, si vous l'enregistrez d'abord comme ceci:

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

Résultat:

$a
[1] "a"

$b
[1] "b"

$c
[1] "c"

Ou en utilisant cette deuxième astuce: :-)

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

(le résultat est le même).

Explication 2: sys.call(1)retourne lapply(...), donc c'est sys.call(1)[[2]]l'expression utilisée comme argument de liste pour lapply. Passer ceci à evalcrée un objet légitime quinames peut accéder. Tricky, mais ça marche.

Bonus: une deuxième façon d'obtenir les noms:

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

Notez qu'il Xs'agit d'un objet valide dans le cadre parent de FUN, et fait référence à l'argument de liste de lapply, afin que nous puissions y accéder avec eval.parent.

J'ai eu le même problème plusieurs fois ... J'ai commencé à utiliser une autre façon ... Au lieu d'utiliser lapply, j'ai commencé à utilisermapply

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

Vous pouvez essayer d'utiliser imap()from purrrpackage.

De la documentation:

imap (x, ...) est un raccourci pour map2 (x, names (x), ...) si x a des noms, ou map2 (x, seq_along (x), ...) si ce n'est pas le cas.

Donc, vous pouvez l'utiliser de cette façon:

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

Ce qui vous donnera le résultat suivant:

$a
[1] "11 a"

$b
[1] "12 b"

$c
[1] "13 c"

Bouclez simplement les noms.

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

La réponse de Tommy s'applique aux vecteurs nommés mais j'ai eu l'idée que vous étiez intéressé par les listes. Et il semble qu'il faisait une fin autour parce qu'il faisait référence à "x" depuis l'environnement d'appel. Cette fonction utilise uniquement les paramètres qui ont été passés à la fonction et ne fait donc aucune hypothèse sur le nom des objets qui ont été passés:

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

Ma réponse va dans le même sens que Tommy et caracals, mais évite d'avoir à sauvegarder la liste comme objet supplémentaire.

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

Résultat:

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

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

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

Cela donne la liste comme argument nommé à FUN (au lieu de lapply). lapply n'a qu'à itérer sur les éléments de la liste (attention à changer ce premier argument en lapply lors de la modification de la longueur de la liste).

Remarque: donner la liste directement à lapply comme argument supplémentaire fonctionne également:

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

Les deux @caracals et @Tommy sont de bonnes solutions et ceci est un exemple incluant les list´s et data.frame´s.
rest un listde list´s et data.frame´s ( dput(r[[1]]à la fin).

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

L'objectif est de unlisttoutes les listes, en mettant la séquence des listnoms de ´s comme colonnes pour identifier le cas.

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"

Désélectionnez les listes mais pas les data.frame´s.

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

Mapmet la séquence de noms sous forme de colonne. Reducerejoindre tous les data.frame´s.

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

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

Disons que nous voulons calculer la longueur de chaque élément.

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 le but est simplement d'étiqueter les éléments résultants, alors lapply(mylist,length)ou ci-dessous fonctionne.

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

 a  b  c 
 4  8 11 

Si le but est d'utiliser l'étiquette à l'intérieur de la fonction, alors mapply()est utile en bouclant sur deux objets; les éléments de liste et les noms de liste.

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

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

@ ferdinand-kraft nous a donné un excellent truc et nous dit ensuite que nous ne devrions pas l'utiliser parce qu'il n'est pas documenté et à cause de la surcharge de performance.

Je ne peux pas discuter beaucoup avec le premier point, mais j'aimerais noter que les frais généraux devraient rarement être un problème.

définissons les fonctions actives afin que nous n'ayons pas besoin d'appeler l'expression complexe, parent.frame()$i[]mais seulement .i(), nous allons également créer .n()pour accéder au nom, qui devrait fonctionner à la fois pour les fonctions de base et purrr (et probablement pour la plupart des autres également).

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

Benchons maintenant une fonction simple qui colle les items d'un vecteur à leur index, en utilisant différentes approches (ces opérations peuvent bien sûr être vectorisées en utilisant paste(vec, seq_along(vec)) mais ce n'est pas le but ici).

Nous définissons une fonction de benchmarking et une fonction de traçage et représentons les résultats ci-dessous:

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

^{Créé le 15/11/2019 par le package reprex (v0.3.0)}

La chute au début du premier graphique est un hasard, veuillez l'ignorer.

Nous voyons que la réponse choisie est en effet plus rapide, et pour un nombre décent d'itérations nos .i()solutions sont en effet plus lentes, la surcharge par rapport à la réponse choisie est environ 3 fois la surcharge d'utilisation purrr::imap(), et s'élève à environ, 25 ms pour 30k itérations, donc je perds environ 1 ms pour 1000 itérations, 1 seconde par million. C'est un petit coût pour la commodité à mon avis.

Écrivez simplement votre propre lapplyfonction personnalisée

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

Ensuite, utilisez comme ceci:

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