Acesse nomes de índices de lapply dentro do FUN

Existe uma maneira de obter o nome do índice da lista na minha função lapply ()?

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

Perguntei antes se é possível preservar os nomes de índice na lista retornada lapply () , mas ainda não sei se existe uma maneira fácil de buscar cada nome de elemento dentro da função personalizada. Gostaria de evitar chamar lapply nos próprios nomes, prefiro obter o nome nos parâmetros da função.

Infelizmente, lapplyapenas fornece os elementos do vetor que você passa. A solução alternativa usual é passar os nomes ou índices do vetor em vez do próprio vetor.

Mas observe que você sempre pode passar argumentos extras para a função, portanto, o seguinte 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))

Aqui eu uso lapplysobre os índices de x, mas também passo xe os nomes de x. Como você pode ver, a ordem dos argumentos da função pode ser qualquer coisa - lapplypassará no "elemento" (aqui o índice) para o primeiro argumento não especificado entre os extras. Nesse caso, eu especifico ye n, então só iresta ...

Que produz o seguinte:

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

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

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

UPDATE Exemplo mais simples, mesmo resultado:

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

Aqui, a função usa a variável "global" xe extrai os nomes em cada chamada.

Isso basicamente usa a mesma solução alternativa que Tommy, mas com Map(), não há necessidade de acessar variáveis ​​globais que armazenam os nomes dos componentes da 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

Ou, se você preferir mapply()

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

UPDATE para R versão 3.2

Isenção de responsabilidade: este é um truque hacky e pode parar de funcionar nos próximos lançamentos.

Você pode obter o índice usando este:

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

$b
[1] 2

Nota: []é necessário que isso funcione, pois leva R a pensar que o símbolo i(residente no quadro de avaliação de lapply) pode ter mais referências, ativando assim a duplicação lenta. Sem ele, R não manterá cópias separadas de i:

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

$b
[1] 2

Outros truques exóticos podem ser usados, como function(x){parent.frame()$i+0}ou function(x){--parent.frame()$i}.

Impacto no desempenho

A duplicação forçada causará perda de desempenho? Sim! aqui estão os 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

Conclusão

Essa resposta mostra apenas que você NÃO deve usar isso ... Não apenas seu código ficará mais legível se você encontrar outra solução como a de Tommy acima e mais compatível com versões futuras, também corre o risco de perder as otimizações para as quais a equipe principal trabalhou arduamente. desenvolve!

Truques das versões antigas, não funcionam mais:

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

Resultado:

$a
[1] 1

$b
[1] 2

$c
[1] 3

Explicação: lapplycria chamadas do formulário FUN(X[[1L]], ...), FUN(X[[2L]], ...)etc. Portanto, o argumento que passa é X[[i]]onde iestá o índice atual no loop. Se obtivermos isso antes de ser avaliado (ou seja, se usarmos substitute), obteremos a expressão não avaliada X[[i]]. Esta é uma chamada à [[função, com argumentos X(um símbolo) e i(um número inteiro). Então, substitute(x)[[3]]retorna exatamente esse número inteiro.

Com o índice, é possível acessar os nomes trivialmente, se você o salvar primeiro assim:

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"

Ou usando este segundo truque: :-)

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

(resultado é o mesmo).

Explicação 2: sys.call(1)retorna lapply(...), para que sys.call(1)[[2]]seja a expressão usada como argumento da lista lapply. Passar isso para evalcria um objeto legítimo que namespode acessar. Complicado, mas funciona.

Bônus: uma segunda maneira de obter os nomes:

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

Observe que Xé um objeto válido no quadro pai de FUNe faz referência ao argumento de lista de lapply, para que possamos chegar a ele eval.parent.

Eu já tive o mesmo problema várias vezes ... comecei a usar de outra maneira ... Em vez de usar lapply, comecei a usarmapply

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

Você pode tentar usar imap()do purrrpacote.

A partir da documentação:

imap (x, ...) é uma abreviação de map2 (x, names (x), ...) se x tiver nomes ou map2 (x, seq_along (x), ...) se não tiver.

Então, você pode usá-lo dessa maneira:

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

O que lhe dará o seguinte resultado:

$a
[1] "11 a"

$b
[1] "12 b"

$c
[1] "13 c"

Apenas faça um loop nos nomes.

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

A resposta de Tommy se aplica a vetores nomeados, mas tive a ideia de que você estava interessado em listas. E parece que ele estava dando uma reviravolta porque estava fazendo referência a "x" do ambiente de chamada. Essa função usa apenas os parâmetros que foram passados ​​para a função e, portanto, não faz suposições sobre o nome dos objetos que foram passados:

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

Minha resposta vai na mesma direção que Tommy e caracals, mas evita ter que salvar a lista como um 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"

Isso fornece a lista como um argumento nomeado para FUN (em vez de exibir). lapply só precisa iterar sobre os elementos da lista (tenha cuidado para alterar esse primeiro argumento para lapply ao alterar o comprimento da lista).

Nota: Fornecer a lista diretamente para dobrar como argumento adicional também funciona:

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

Tanto o @caracals quanto o @Tommy são boas soluções e este é um exemplo, incluindo list´s e data.frame´s.
ré um listdos liste data.framedos ( dput(r[[1]]no 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

O objetivo é unlisttodas as listas, colocando a sequência dos listnomes como colunas para identificar o 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"

Cancele a lista das listas, mas não as data.frame.

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

Mapcoloca a sequência de nomes como uma coluna. Reducejunte-se 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

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

Digamos que queremos calcular o comprimento 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

Se o objetivo é apenas rotular os elementos resultantes, então lapply(mylist,length)ou abaixo funciona.

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

 a  b  c 
 4  8 11 

Se o objetivo é usar o rótulo dentro da função, mapply()é útil fazer um loop sobre dois objetos; os elementos da lista e os nomes da lista.

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

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

O @ ferdinand-kraft nos deu um grande truque e depois nos diz que não devemos usá-lo porque não é documentado e por causa da sobrecarga de desempenho.

Não posso discutir muito com o primeiro ponto, mas gostaria de observar que a sobrecarga raramente deve ser uma preocupação.

vamos definir funções ativas para que não tenhamos que chamar a expressão complexa, parent.frame()$i[]mas apenas .i()criaremos .n()para acessar o nome, que deve funcionar para os funcionais base e purrr (e provavelmente para a maioria também).

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

Agora vamos comparar uma função simples que cola os itens de um vetor em seu índice, usando abordagens diferentes (é claro que essas operações podem ser vetorizadas usando, paste(vec, seq_along(vec))mas esse não é o ponto aqui).

Definimos uma função de benchmarking e uma função de plotagem e plotamos os resultados abaixo:

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

^{Criado em 2019-11-15 pelo pacote reprex (v0.3.0)}

A queda no início do primeiro gráfico é um acaso, por favor, ignore-a.

Vemos que a resposta escolhida é realmente mais rápida e, para uma quantidade decente de iterações, nossas .i()soluções são realmente mais lentas, a sobrecarga em comparação com a resposta escolhida é cerca de 3 vezes a sobrecarga do uso purrr::imap()e atinge cerca de 25 ms para iterações de 30k, então eu perco cerca de 1 ms por 1000 iterações, 1 segundo por milhão. Esse é um pequeno custo por conveniência, na minha opinião.

Basta escrever sua própria lapplyfunção 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)
}

Então use assim:

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