Uzyskaj dostęp do nazw indeksów lapply wewnątrz FUN

Czy istnieje sposób, aby uzyskać nazwę indeksu listy w mojej funkcji lapply ()?

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

Pytałem wcześniej , jeśli to możliwe, aby zachować nazwy indeksu w lapply () zwróconej listy, ale nadal nie wiem, czy jest to prosty sposób, aby pobrać nazwę każdego elementu wewnątrz funkcji niestandardowej. Chciałbym uniknąć wywoływania lapply na samych nazwach, wolałbym raczej uzyskać nazwę w parametrach funkcji.

Niestety, lapplypodaje tylko elementy wektora, przez który go przekazujesz. Zwykle można obejść ten problem, aby przekazać mu nazwy lub indeksy wektora zamiast samego wektora.

Pamiętaj jednak, że zawsze możesz przekazać dodatkowe argumenty do funkcji, więc działa to:

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

Tutaj używam lapplyindeksów x, ale także przekazuję xi nazw x. Jak widać, kolejność argumentów funkcja może być cokolwiek - lapplyprzejdzie w „element” (tu index) do pierwszego argumentu nie określony spośród tych dodatkowych. W tym przypadku określam yi ntak zostało tylko i...

Który daje następujące wyniki:

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

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

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

UPDATE Prostszy przykład, ten sam wynik:

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

Tutaj funkcja używa zmiennej „globalnej” xi wyodrębnia nazwy w każdym wywołaniu.

Zasadniczo wykorzystuje to to samo obejście, co Tommy, ale Map()nie ma potrzeby uzyskiwania 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"

UPDATE dla wersji R 3.2

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

Możesz uzyskać indeks za pomocą tego:

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

$b
[1] 2

Uwaga: []aby to zadziałało, wymagane jest, aby R pomyślał, że symbol i(znajdujący się w ramce oceny lapply) może mieć więcej odniesień, aktywując w ten sposób leniwe jego powielanie. Bez tego R nie zachowa oddzielnych kopii i:

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

$b
[1] 2

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

Wpływ na wydajność

Czy wymuszona duplikacja spowoduje utratę wydajności? Tak! oto wzorce:

> 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 Tommy powyżej, i bardziej kompatybilne z przyszłymi wersjami, możesz również stracić optymalizacje, nad którymi główny zespół ciężko pracował rozwijać się!

Sztuczki starszych 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

Objaśnienie: lapplytworzy połączenia z postaci FUN(X[[1L]], ...), FUN(X[[2L]], ...)itp Więc argument, że przechodzi to X[[i]]gdzie ijest obecny indeks w pętli. Jeśli otrzymamy to przed oszacowaniem (tj. Jeśli używamy substitute), otrzymamy niezocenione wyrażenie X[[i]]. To jest wywołanie [[funkcji z argumentami X(symbol) i i(liczbą całkowitą). Więc substitute(x)[[3]]zwraca dokładnie tę liczbę całkowitą.

Mając indeks, możesz uzyskać dostęp do nazw w trywialny sposób, jeśli zapiszesz go najpierw w ten 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).

Wyjaśnienie 2: sys.call(1)zwraca lapply(...), więc sys.call(1)[[2]]jest to wyrażenie używane jako argument listy lapply. Przekazanie tego do evaltworzy legalny obiekt, do którego namesmożna uzyskać dostęp. Podstępne, ale działa.

Bonus: drugi sposób na zdobycie nazw:

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

Zauważ, że Xjest to prawidłowy obiekt w ramce nadrzędnej programu FUNi odwołuje się do argumentu list lapply, więc możemy do niego dotrzeć za pomocą eval.parent.

Wiele razy miałem ten sam problem ... 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 purrrpakietu.

Z dokumentacji:

imap (x, ...) to krótka ręka dla map2 (x, names (x), ...), jeśli x ma nazwy lub map2 (x, seq_along (x), ...), jeśli nie.

Możesz więc używać tego w ten sposób:

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

Który da następujący wynik:

$a
[1] "11 a"

$b
[1] "12 b"

$c
[1] "13 c"

Po prostu zapętl nazwy.

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

Odpowiedź Tommy'ego dotyczy wektorów nazwanych, ale doszedłem do wniosku, że interesowały Cię listy. I wygląda na to, że robił koniec, ponieważ odnosił się do „x” ze środowiska wywołującego. Ta funkcja używa tylko parametrów, które zostały przekazane do funkcji, więc nie przyjmuje żadnych założeń dotyczących nazw przekazanych obiektów:

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 i karakale, 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"

Daje to listę jako nazwany argument FUN (zamiast lapply). lapply musi tylko iterować po elementach listy (uważaj, aby zmienić ten pierwszy argument na lapply podczas zmiany 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 @caracals, jak i @Tommy są dobrymi rozwiązaniami, a to jest przykład obejmujący znaki list„i data.frame”.
rjest listz 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 unlistsprawdzenie wszystkich list, umieszczenie sekwencji listnazwisk jako kolumn w celu zidentyfikowania 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"

Ukryj listy, ale nie data.frame´s.

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

Mapumieszcza sekwencję nazw jako kolumnę. Reducedołącz do wszystkich 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"))

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 po prostu etykietowanie powstałych elementów, wtedy 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, mapply()przydatne jest zapętlenie dwóch obiektów; elementy listy i nazwy 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 następnie mówi nam, że nie powinniśmy go używać, ponieważ nie jest to udokumentowane i ze względu na narzut wydajności.

Nie mogę zbytnio dyskutować z pierwszą kwestią, ale chciałbym zauważyć, że koszty ogólne rzadko powinny stanowić problem.

zdefiniujmy aktywne funkcje, abyśmy nie musieli wywoływać złożonego wyrażenia, parent.frame()$i[]ale tylko .i(), stworzymy również .n()dostęp do nazwy, która powinna działać zarówno dla funkcjonałów podstawowych, jak i mruczących (i prawdopodobnie większości 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 przeanalizujmy prostą funkcję, która wkleja elementy wektora do ich indeksu, używając różnych podejść (te operacje można oczywiście wektoryzować przy użyciu, paste(vec, seq_along(vec))ale nie o to tutaj chodzi).

Definiujemy funkcję porównawczą 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")

^{Utworzono 15.11.2019 przez pakiet reprex (v0.3.0)}

Spadek na początku pierwszego wykresu to fuks, zignoruj ​​go.

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

Po prostu napisz własną lapplyfunkcję niestandardową

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 w ten sposób:

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