Accedi ai nomi degli indici lapply all'interno di FUN

C'è un modo per ottenere il nome dell'indice dell'elenco nella mia funzione lapply ()?

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

Ho chiesto prima se è possibile conservare i nomi dell'indice nell'elenco restituito lapply () , ma non so ancora se esiste un modo semplice per recuperare il nome di ciascun elemento all'interno della funzione personalizzata. Vorrei evitare di chiamare lapply sui nomi stessi, preferirei ottenere il nome nei parametri della funzione.

Sfortunatamente, lapplyti dà solo gli elementi del vettore che lo passi. La solita soluzione è passare i nomi o gli indici del vettore invece del vettore stesso.

Ma nota che puoi sempre passare argomenti extra alla funzione, quindi le seguenti funzioni:

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

Qui uso lapplygli indici di x, ma anche i passaggi xe i nomi di x. Come puoi vedere, l'ordine degli argomenti della funzione può essere qualsiasi cosa - lapplypasserà nell'elemento "(qui l'indice) al primo argomento non specificato tra quelli extra. In questo caso, lo specifico ye n, quindi rimane solo i...

Che produce quanto segue:

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

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

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

AGGIORNAMENTO Esempio più semplice, stesso risultato:

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

Qui la funzione utilizza la variabile "globale" xed estrae i nomi in ogni chiamata.

Questo utilizza sostanzialmente la stessa soluzione di Tommy, ma con Map() , non è necessario accedere alle variabili globali che memorizzano i nomi dei componenti dell'elenco.

> 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, se preferisci mapply()

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

AGGIORNAMENTO per R versione 3.2

Disclaimer: questo è un trucco complicato e potrebbe smettere di funzionare nelle prossime versioni.

Puoi ottenere l'indice usando questo:

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

$b
[1] 2

Nota: []è necessario perché ciò funzioni, poiché induce R a pensare che il simbolo i(che risiede nel quadro di valutazione di lapply) possa avere più riferimenti, attivando così la sua pigra duplicazione. Senza di essa, R non manterrà copie separate di i:

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

$b
[1] 2

Altri trucchi esotici possono essere usati, come function(x){parent.frame()$i+0}o function(x){--parent.frame()$i}.

Impatto sulle prestazioni

La duplicazione forzata causerà la perdita di prestazioni? Sì! ecco i benchmark:

> 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

Conclusione

Questa risposta mostra semplicemente che NON dovresti usare questo ... Non solo il tuo codice sarà più leggibile se trovi un'altra soluzione come Tommy sopra, e più compatibile con le versioni future, rischi anche di perdere le ottimizzazioni a cui il core team ha lavorato duramente sviluppare!

I trucchi delle vecchie versioni, non funzionano più:

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

Risultato:

$a
[1] 1

$b
[1] 2

$c
[1] 3

Spiegazione: lapplycrea chiamate del modulo FUN(X[[1L]], ...), FUN(X[[2L]], ...)ecc. Quindi l'argomento che passa è X[[i]]dove si itrova l'indice corrente nel ciclo. Se lo otteniamo prima che venga valutato (ovvero, se lo utilizziamo substitute), otteniamo l'espressione non valutata X[[i]]. Questa è una chiamata alla [[funzione, con argomenti X(un simbolo) e i(un numero intero). Cosìsubstitute(x)[[3]] restituisce esattamente questo numero intero.

Avendo l'indice, puoi accedere ai nomi in modo banale, se lo salvi prima in questo modo:

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

Risultato:

$a
[1] "a"

$b
[1] "b"

$c
[1] "c"

O usando questo secondo trucco: :-)

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

(il risultato è lo stesso).

Spiegazione 2: sys.call(1)restituisce lapply(...), quindi questa sys.call(1)[[2]]è l'espressione utilizzata come argomento dell'elenco lapply. Passando questo per evalcreare un oggetto legittimo chenames può accedere. Ingannevole, ma funziona.

Bonus: un secondo modo per ottenere i nomi:

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

Si noti che Xè un oggetto valido nel frame principale di FUNe fa riferimento all'argomento list di lapply, in modo che possiamo raggiungerlo con eval.parent.

Ho avuto lo stesso problema molte volte ... Ho iniziato a usare un altro modo ... Invece di usare lapply, ho iniziato a usaremapply

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

Puoi provare a usare imap()dal purrrpacchetto.

Dalla documentazione:

imap (x, ...) è una scorciatoia per map2 (x, names (x), ...) se x ha nomi o map2 (x, seq_along (x), ...) in caso contrario.

Quindi, puoi usarlo in questo modo:

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

Che ti darà il seguente risultato:

$a
[1] "11 a"

$b
[1] "12 b"

$c
[1] "13 c"

Fai un giro nei nomi.

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

La risposta di Tommy si applica ai vettori nominati ma ho avuto l'idea che tu fossi interessato alle liste. E sembra che stia facendo un giro perché stava facendo riferimento a "x" dall'ambiente chiamante. Questa funzione utilizza solo i parametri che sono stati passati alla funzione e quindi non fa ipotesi sul nome degli oggetti che sono stati passati:

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

La mia risposta va nella stessa direzione di Tommy e dei caracal, ma evita di dover salvare la lista come oggetto aggiuntivo.

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

Risultato:

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

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

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

Ciò fornisce l'elenco come argomento denominato a FUN (anziché a lapply). lapply deve solo scorrere gli elementi dell'elenco (fare attenzione a cambiare questo primo argomento in lapply quando si modifica la lunghezza dell'elenco).

Nota: Dare l'elenco direttamente alla lappatura come argomento aggiuntivo funziona anche:

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

Sia @caracals che @Tommy sono buone soluzioni e questo è un esempio che include list"e data.frame".
rè una listdi listdi e data.framedi ( dput(r[[1]]alla fine).

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'obiettivo è quello di unlisttutte le liste, mettendo la sequenza dei listnomi come colonne per identificare il 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"

Deseleziona le liste ma non quelle data.frame.

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

Mapmette la sequenza di nomi come una colonna. Reduceunisciti a tutti 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

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

Diciamo che vogliamo calcolare la lunghezza di ogni 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

Se l'obiettivo è semplicemente etichettare gli elementi risultanti, allora lapply(mylist,length)o sotto funziona.

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

 a  b  c 
 4  8 11 

Se l'obiettivo è utilizzare l'etichetta all'interno della funzione, mapply()è utile fare un ciclo su due oggetti; gli elementi dell'elenco e i nomi degli elenchi.

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

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

@ ferdinand-kraft ci ha dato un grande trucco e poi ci ha detto che non dovremmo usarlo perché non è documentato e per via delle prestazioni generali.

Non posso discutere molto con il primo punto, ma vorrei notare che l'overhead dovrebbe raramente essere un problema.

definiamo le funzioni attive in modo da non dover chiamare l'espressione complessa parent.frame()$i[]ma solo .i(), creeremo anche .n()per accedere al nome, che dovrebbe funzionare sia per i funzionali base che per i purrr (e probabilmente anche per la maggior parte degli altri).

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

Ora confrontiamo una semplice funzione che incolla gli elementi di un vettore nel loro indice, usando approcci diversi (questa operazione può ovviamente essere vettorizzata usando paste(vec, seq_along(vec)) ma non è questo il punto qui).

Definiamo una funzione di benchmarking e una funzione di tracciamento e tracciamo i risultati di seguito:

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

^{Creato il 15-11-2019 dal pacchetto reprex (v0.3.0)}

Il calo all'inizio del primo grafico è un colpo di fortuna, per favore ignoralo.

Vediamo che la risposta scelta è davvero più veloce e per una discreta quantità di iterazioni le nostre .i()soluzioni sono davvero più lente, il sovraccarico rispetto alla risposta scelta è circa 3 volte il sovraccarico dell'uso purrr::imap()e ammonta a circa 25 ms per 30k iterazioni, quindi perdo circa 1 ms per 1000 iterazioni, 1 secondo per milione. Questo è un piccolo costo per comodità secondo me.

Basta scrivere la tua lapplyfunzione personalizzata

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

Quindi utilizzare in questo modo:

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