FUN içindeki lapply dizin adlarına erişin

Lapply () işlevimde liste dizini adını almanın bir yolu var mı?

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

Daha önce , lapply () döndürülen listesinde dizin adlarını korumak mümkün olup olmadığını sordum , ancak yine de özel işlev içindeki her öğe adını almanın kolay bir yolu olup olmadığını bilmiyorum. Ben isimleri kendileri üzerinde lapply aramaktan kaçınmak istiyorum, ben fonksiyon parametrelerinde adı almak istiyorum.

Ne yazık ki, lapplysadece onu geçirdiğiniz vektörün elemanlarını verir. Genel çözüm, vektörün kendisi yerine vektörün adlarını veya indekslerini iletmektir.

Ancak, işleve her zaman ekstra argümanlar aktarabileceğinizi unutmayın, bu nedenle aşağıdakiler çalışır:

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

Burada lapplyendeksleri üzerinde kullanıyorum x, ama aynı zamanda xve isimlerini de geçiyorum x. Gördüğünüz gibi, işlev argümanlarının sırası herhangi bir şey olabilir -lapply ilk argüman için "eleman" (burada endeksi) geçecek değil ekstra olanlar arasından belirtildi. Bu durumda, ben belirtiyorum yve nbu yüzden sadece i...

Hangi aşağıdakileri üretir:

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

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

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

GÜNCELLEME Daha basit bir örnek, aynı sonuç:

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

Burada fonksiyon "global" değişkeni kullanır xve her çağrıdaki isimleri çıkartır.

Bu temelde Tommy ile aynı geçici çözümü kullanır, ancak Map()liste bileşenlerinin adlarını depolayan global değişkenlere erişmeye gerek yoktur.

> 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

Veya isterseniz mapply()

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

R sürüm 3.2 için GÜNCELLEME

Feragatname: Bu hileli bir hile ve sonraki sürümlerde çalışmayı durdurabilir.

Bunu kullanarak dizini alabilirsiniz:

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

$b
[1] 2

Not: []Bunun çalışması için gereklidir, çünkü R'yi i(değerlendirme çerçevesinde yer alan lapply) sembolün daha fazla referansa sahip olabileceğini düşünmesi için hileler , böylece tembel kopyalamayı aktive eder. Bu olmadan, R aşağıdakilerin ayrı kopyalarını saklamaz i:

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

$b
[1] 2

function(x){parent.frame()$i+0}Veya gibi diğer egzotik hileler kullanılabilir function(x){--parent.frame()$i}.

Performans Etkisi

Zorla çoğaltma performans kaybına neden olur mu? Evet! İşte kriterler:

> 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

Sonuç

Bu cevap sadece bunu KULLANMAMANIZ gerektiğini gösteriyor ... Tommy'nin yukarıda olduğu gibi başka bir çözüm bulursanız ve kodunuz gelecekteki sürümlerle daha uyumluysa, yalnızca kodunuz daha okunaklı olmayacak, aynı zamanda çekirdek ekibin çok çalıştığı optimizasyonları kaybetme riskiyle karşı karşıya kalacaksınız geliştirmek!

Eski sürümlerin püf noktaları, artık çalışmıyor:

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

Sonuç:

$a
[1] 1

$b
[1] 2

$c
[1] 3

Açıklama: lapplyFormun aramaları yaratır FUN(X[[1L]], ...), FUN(X[[2L]], ...)o geçer argümanı Yani vb X[[i]]nerede idöngü içinde geçerli endeksidir. Bunu değerlendirilmeden önce alırsak (yani kullanırsak substitute) değerlendirilmemiş ifadeyi elde ederiz X[[i]]. Bu, [[argümanlar X(sembol) ve i(tamsayı) bulunan bir işlev çağrısıdır . Yanisubstitute(x)[[3]] tam olarak bu tamsayıyı döndürür.

Dizine sahip olarak, önce bu şekilde kaydederseniz, adlara önemsiz bir şekilde erişebilirsiniz:

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

Sonuç:

$a
[1] "a"

$b
[1] "b"

$c
[1] "c"

Veya bu ikinci numarayı kullanarak: :-)

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

(sonuç aynıdır).

Açıklama 2: sys.call(1)döndürür lapply(...), yani sys.call(1)[[2]]liste bağımsız değişkeni olarak kullanılan ifade budur lapply. Bunu geçmek evalmeşru bir nesne oluşturur.names , erişebilen . Zor, ama işe yarıyor.

Bonus: İsimleri almanın ikinci bir yolu:

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

Bunun Xüst çerçevesindeki geçerli bir nesne olduğunu FUNve list argümanına başvurduğunu unutmayın lapply, böylece ona ulaşabiliriz eval.parent.

Ben başka bir yol kullanarak ... Yerine kullanmaya başladıktan ... Aynı problemi bir çok kez yaşadım lapplyben kullanmaya başladıktan sonra,mapply

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

Sen kullanarak deneyebilirsiniz imap()gelen purrrpaketin.

Belgelerden:

imap (x, ...), x'in adları varsa map2 (x, adlar (x), ...) için kısa el, yoksa yoksa map2 (x, seq_along (x), ...) anlamına gelir.

Yani, bu şekilde kullanabilirsiniz:

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

Hangi size aşağıdaki sonucu verecektir:

$a
[1] "11 a"

$b
[1] "12 b"

$c
[1] "13 c"

Sadece isimleri gir.

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

Tommy'nin cevabı adlandırılmış vektörler için geçerlidir, ancak listelerle ilgilendiğiniz fikrini aldım. Görünüşe göre bir sonlandırma yapıyormuş gibi görünüyor çünkü çağıran ortamdan "x" e atıfta bulunuyor. Bu işlev yalnızca işleve iletilen parametreleri kullanır ve bu nedenle iletilen nesnelerin adı hakkında herhangi bir varsayımda bulunmaz:

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

Cevabım Tommy ve karakollarla aynı yöne gidiyor, ancak listeyi ek bir nesne olarak kaydetmek zorunda kalmıyor.

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

Sonuç:

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

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

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

Bu, listeyi FUN'a adlandırılmış bir bağımsız değişken olarak verir (yerine uygulamak). lapply sadece liste öğelerini yinelemelidir (listenin uzunluğunu değiştirirken ilk argümanı değiştirmeye dikkat edin).

Not: Ek bir argüman olarak listeyi doğrudan lapply yapmak da işe yarar:

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

Hem @caracals ve @Tommy iyi çözümlerdir ve bu da dahil olmak üzere bir örnektir listyılların ve data.frameyılların.
rBir olduğu listve listyıllardan ve data.frameyılların ( dput(r[[1]]sonunda).

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

Amaç, unlisttüm listeleri listelemek ve namess listisimlerini sıralamayı tanımlamak için sütunlar olarak koymaktır.

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"

Listeleri listeleyip listelemeyin data.frame.

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

Mapad dizisini sütun olarak koyar. Reduceher şeye katıl 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

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

Her bir öğenin uzunluğunu hesaplamak istediğimizi varsayalım.

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

Amaç sadece elde edilen elemanları etiketlemekse, o zaman lapply(mylist,length)veya aşağı çalışır.

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

 a  b  c 
 4  8 11 

Amaç etiketi fonksiyonun içinde kullanmaksa, mapply()iki nesnenin üzerine ilmek yaparak faydalıdır; liste öğeleri ve liste adları.

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

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

@ ferdinand-kraft bize harika bir numara verdi ve sonra kullanmamamız gerektiğini söylüyor çünkü belgelenmemiş ve performans yükü yüzünden.

İlk nokta ile fazla tartışamam ama ek yükün nadiren bir endişe olması gerektiğini belirtmek isterim.

Karmaşık ifadesini aramak zorunda kalmamak aktif fonksiyonlarını tanımlayalım parent.frame()$i[]ama sadece .i(), Biz de yaratacaktır .n()ikisi için çalışmalıdır adını erişmek için taban ve purrr (sıra ve belki de en diğerleri) fonksiyonellerin.

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

Şimdi, farklı yaklaşımlar kullanarak bir vektörün öğelerini dizinlerine yapıştıran basit bir işlevi kıyaslayalım (bu işlemler elbette kullanılarak vektörleştirilebilir) paste(vec, seq_along(vec)) ancak buradaki nokta değildir).

Bir kıyaslama işlevi ve bir çizim işlevi tanımlar ve aşağıdaki sonuçları çizeriz:

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

^{2019-11-15 tarihinde reprex paketi tarafından oluşturuldu (v0.3.0)}

İlk grafiğin başlangıcındaki düşüş bir fluke, lütfen dikkate almayın.

Seçilen cevabın gerçekten daha hızlı olduğunu görüyoruz ve iyi bir iterasyon için .i()çözümlerimiz gerçekten daha yavaş, seçilen cevaba göre ek yük, kullanım yükünün yaklaşık 3 katı ve purrr::imap()30k iterasyon için yaklaşık 25 ms, bu yüzden 1000 yineleme başına yaklaşık 1 ms, milyonda 1 sn kaybediyorum. Bence rahatlık için küçük bir maliyet.

Sadece kendi özel lapplyişlevinizi yazın

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

Sonra şöyle kullanın:

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