Access lapply index names in FUN

To zasadniczo wykorzystuje to samo obejście, co Tommy, ale w przypadku Map(), nie ma potrzeby dostępu do zmiennych globalnych, które przechowują nazwy składników listy.

> 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

Lub, jeśli wolisz mapply()

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

Aktualizacja dla wersji R 3.2

Zastrzeżenie: jest to hacky trick, i może przestać działać w następnych wydaniach.

Możesz uzyskać indeks używając tego:

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

$b
[1] 2

Uwaga: [] jest wymagane, aby to zadziałało, ponieważ zmusza R do myślenia, że symbol i (rezydujący w ramce oceny lapply) może mieć więcej odniesień, co aktywuje leniwe powielanie go. Bez niego R nie zachowa oddzielonych kopii i:

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

$b
[1] 2

Można używać innych egzotycznych sztuczek, takich jak function(x){parent.frame()$i+0} lub function(x){--parent.frame()$i}.

Wpływ Wydajności

Czy wymuszone powielanie spowoduje utratę wydajności? Tak! oto benchmarki:

> 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

Wniosek

Ta odpowiedź pokazuje tylko, że nie powinieneś tego używać... Nie tylko twój kod będzie bardziej czytelny, jeśli znajdziesz inne rozwiązanie, takie jak powyżej, i bardziej kompatybilne z przyszłymi wydaniami, ryzykujesz również utratę optymalizacje główny zespół ciężko pracował nad rozwojem!

Triki starych wersji, już nie działają:

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

Wynik:

$a
[1] 1

$b
[1] 2

$c
[1] 3

Explanation: lapply tworzy wywołania formularza FUN(X[[1L]], ...), FUN(X[[2L]], ...) itd. Tak więc przekazywany argument to X[[i]] gdzie i jest bieżącym indeksem w pętli. Jeśli otrzymamy to przed jest ono ocenione (tzn. jeśli użyjemy substitute), otrzymamy wyrażenie X[[i]]. Jest to wywołanie funkcji [[ z argumentami X (symbol) i i (liczba całkowita). Więc substitute(x)[[3]] zwraca dokładnie tę liczbę całkowitą.

Mając indeks, możesz uzyskać trywialny dostęp do nazw, jeśli najpierw zapiszesz go w następujący sposób:

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

Wynik:

$a
[1] "a"

$b
[1] "b"

$c
[1] "c"

lub używając tej drugiej sztuczki: -)

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

(wynik jest taki sam).

Explanation 2: sys.call(1) zwraca lapply(...), tak że sys.call(1)[[2]] jest wyrażeniem używanym jako argument listy do lapply. Przekazanie tego do eval tworzy legalny obiekt, który names dostęp. Trudne, ale działa.

Bonus: drugi sposób na zdobycie imion:

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

Zauważ, że X jest poprawnym obiektem w ramce nadrzędnej FUN i odwołuje się do argumentu listy lapply, więc możemy do niego dotrzeć za pomocą eval.parent.

Miałem ten sam problem wiele razy... Zacząłem używać innego sposobu... Zamiast używać lapply, zacząłem używać mapply

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

Możesz spróbować użyć imap() z purrr pakietu.

Z dokumentacji:

Imap(x, ...) jest krótką ręką dla map2( x, nazw(x),...) jeśli x ma nazwy, lub map2( x, seq_along (x), ...), jeśli nie.

Więc możesz go użyć w ten sposób:

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

Co daje następujący wynik:

$a
[1] "11 a"

$b
[1] "12 b"

$c
[1] "13 c"

Po prostu wprowadź nazwy.

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

Odpowiedź Tommy ' ego odnosi się do nazwanych wektorów, ale mam pomysł, że interesujesz się listami. I wygląda na to, że robił koniec, bo odnosił się do "x"ze środowiska wywołującego. Funkcja ta używa tylko parametrów, które zostały przekazane do funkcji, a więc nie przyjmuje żadnych założeń dotyczących nazw obiektów, które zostały przekazane:

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

Moja odpowiedź idzie w tym samym kierunku co Tommy ' ego i caracalsa, ale unika konieczności zapisywania listy jako dodatkowego obiektu.

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

Wynik:

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

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

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

To daje listę jako nazwany argument do zabawy (zamiast do lapply). lapply musi tylko iterować nad elementami listy (należy uważać, aby zmienić ten pierwszy argument na lapply przy zmianie długości listy).

Uwaga: podanie listy bezpośrednio do lapply jako dodatkowego argumentu również działa:

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

Zarówno @ Caracal, jak i @ Tommy są dobrymi rozwiązaniami i jest to przykład obejmujący list s i data.frame s.
r jest list z list s i data.frame s (dput(r[[1]] na końcu).

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

Celem jest unlist wszystkie listy, umieszczając sekwencję nazw list jako kolumny do identyfikacji przypadku.

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"

Unlist listy, ale nie data.frame s.

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

Map umieszcza sekwencję nazw jako kolumnę. Reduce dołącz do wszystkich data.frames.

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

P. S. 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"))

Powiedzmy, że chcemy obliczyć długość każdego elementu.

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

Jeśli celem jest tylko etykietowanie wynikowych elementów, to lapply(mylist,length) lub poniżej działa.

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

 a  b  c 
 4  8 11 

Jeśli celem jest użycie etykiety wewnątrz funkcji, to {[4] } jest użyteczne przez zapętlenie dwóch obiektów; elementów listy i nazw list.

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

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

@ferdinand-kraft dał nam świetną sztuczkę, a potem powiedział, że nie powinniśmy jej używać ponieważ jest nieudokumentowana i ze względu na wydajność.

Nie mogę się zbytnio spierać z pierwszym punktem, ale chciałbym zauważyć, że overhead rzadko powinno to być problemem.

Zdefiniujmy funkcje aktywne, abyśmy nie musieli wywoływać wyrażenia złożonego parent.frame()$i[] ale tylko .i(), utworzymy również .n(), aby uzyskać dostęp nazwa, która powinna działać zarówno dla base i purrr funkcjonalnych (i chyba większość innych).

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

Teraz porównajmy prostą funkcję, która wkleja elementy wektora do ich indeksu, używając różnych podejść(operacje te można oczywiście wektoryzować używając paste(vec, seq_along(vec)), ale nie o to tu chodzi).

Definiujemy funkcję benchmarkingu i funkcję kreślenia i wykreślamy wyniki poniżej:

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

^{w 2019 roku został utworzony pakiet reprex.]} (v0.3.0)}

Widzimy, że wybrana odpowiedź jest rzeczywiście szybsza, a dla przyzwoitej ilości iteracji nasze rozwiązania .i() są rzeczywiście wolniejsze, narzut w porównaniu do wybranej odpowiedzi jest około 3 razy większy niż narzut użycia purrr::imap() i wynosi około, 25 ms dla 30K iteracji, więc tracę około 1 ms na 1000 iteracji, 1 SEK na milion. Moim zdaniem to niewielki koszt dla wygody.

Po prostu napisz własną funkcję 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)
}

Następnie użyj tak:

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