Отримайте доступ до індексованих імен у FUN

Чи є спосіб отримати ім’я списку індексу в моїй функції lapply ()?

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

Я раніше запитав, чи можна зберегти імена індексу у списку, що повертається lapply () , але я досі не знаю, чи є простий спосіб отримати кожне ім’я елемента всередині спеціальної функції. Я хотів би уникати назовні на виклики самих імен, я б швидше отримав ім'я в параметрах функції.

На жаль, lapplyдає лише елементи того вектора, який ви передаєте. Звичайна обробка полягає в тому, щоб передати йому імена або індекси вектора замість самого вектора.

Але зауважте, що ви завжди можете передавати додаткові аргументи функції, тому такі дії:

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

Тут я використовую lapplyнад індексами x, але також передаю xі назви x. Як бачите, порядок аргументів функції може бути будь-яким - lapplyперейде в "елемент" (тут індекс) до першого аргументу, не вказаного серед зайвих. У цьому випадку я вказую yі n, так що залишилося лише i...

Що виробляє наступне:

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

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

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

ОНОВЛЕННЯ Простіший приклад, той же результат:

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

Тут функція використовує "глобальну" змінну xі витягує імена в кожному дзвінку.

Це в основному використовує той самий спосіб вирішення, що і Tommy, але при Map()цьому немає необхідності звертатися до глобальних змінних, які зберігають назви компонентів списку.

> 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

Або, якщо хочете mapply()

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

ОНОВЛЕННЯ для версії R 3.2

Відмова від відповідальності: це хитра хитрість і може перестати працювати в наступних випусках.

Ви можете отримати індекс за допомогою цього:

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

$b
[1] 2

Примітка: []для цього потрібно працювати, оскільки це наштовхує R на думку про те, що символ i(що знаходиться в рамці оцінки lapply) може мати більше посилань, тим самим активізуючи ліниве його дублювання. Без цього R не зберігатиме окремі копії i:

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

$b
[1] 2

Можна використовувати й інші екзотичні хитрощі, як-от function(x){parent.frame()$i+0}або function(x){--parent.frame()$i}.

Вплив на продуктивність

Чи примусове дублювання призведе до втрати продуктивності? Так! ось орієнтири:

> 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

Висновок

Ця відповідь просто показує, що НЕ слід використовувати це ... Не тільки ваш код буде більш читабельним, якщо ви знайдете інше рішення, подібне до вищезгаданого Tommy, і більш сумісне з майбутніми випусками, ви також ризикуєте втратити оптимізацію, до якої основна команда наполегливо працювала розвивайся!

Прийоми старих версій, більше не працюють:

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

Результат:

$a
[1] 1

$b
[1] 2

$c
[1] 3

Пояснення: lapplyстворює виклики форми FUN(X[[1L]], ...), і FUN(X[[2L]], ...)т.д. Таким чином, аргумент він проходить це , X[[i]]де iзнаходиться поточний індекс в циклі. Якщо ми отримаємо це до того, як воно буде оцінено (тобто, якщо ми будемо використовувати substitute), ми отримаємо неоцінений вираз X[[i]]. Це заклик до [[функції, з аргументами X(символ) та i(ціле число). Такsubstitute(x)[[3]] повертається саме це ціле число.

Маючи індекс, ви можете отримати доступ до імен тривіально, якщо ви збережете його спочатку так:

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

Результат:

$a
[1] "a"

$b
[1] "b"

$c
[1] "c"

Або використовуючи цей другий трюк: :-)

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

(результат той самий).

Пояснення 2: sys.call(1)повертає lapply(...), таким чином, sys.call(1)[[2]]це вираз, який використовується як аргумент списку для lapply. Передача цього evalстворює законний об'єкт, якийnames може отримати доступ. Хитрий, але це працює.

Бонус: другий спосіб отримати імена:

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

Зауважте, що Xце дійсний об'єкт у батьківському кадрі FUNта посилається на аргумент списку lapply, тому ми можемо дістатись до нього eval.parent.

У мене була та сама проблема багато разів ... Я почав використовувати інший спосіб ... Замість використання lapplyя почав використовуватиmapply

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

Ви можете спробувати використовувати imap()з purrrпакету.

З документації:

imap (x, ...) - це коротка рука для map2 (x, імена (x), ...), якщо x має імена, або map2 (x, seq_along (x), ...), якщо цього немає.

Отже, ви можете використовувати це таким чином:

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

Що дасть вам такий результат:

$a
[1] "11 a"

$b
[1] "12 b"

$c
[1] "13 c"

Просто петлі в іменах.

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

Відповідь Томмі стосується названих векторів, але я зрозумів, що вас зацікавили списки. І здається, що він робив кінець, тому що він посилався на "х" з оточуючого середовища. Ця функція використовує лише параметри, передані функції, і тому не робить припущень щодо назви переданих об'єктів:

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

Моя відповідь йде в тому ж напрямку, що і Томмі та каракали, але уникає необхідності зберігати список як додатковий об’єкт.

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

Результат:

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

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

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

Це дає список як названий аргумент FUN (замість того, щоб пропустити). lapply має лише повторювати елементи списку (будьте обережні, щоб змінити цей перший аргумент, щоб помилково змінити довжину списку).

Примітка. Надання списку безпосередньо для промальовування як додатковий аргумент також працює:

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

І @caracals, і @Tommy - це хороші рішення, і це приклад, включаючи list«і data.frame».
rце listз - listх і х data.frameроків ( dput(r[[1]]в кінці).

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

Мета полягає у тому, щоб unlistусі списки, зазначаючи послідовність listімен як стовпчиків для ідентифікації випадку.

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"

Видаліть списки, але не data.frame´s.

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

Mapставить послідовність імен у стовпчик. Reduceприєднатися до всіх 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"))

Скажімо, ми хочемо обчислити довжину кожного елемента.

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

Якщо мета - просто позначити отримані елементи, то lapply(mylist,length)працює або нижче.

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

 a  b  c 
 4  8 11 

Якщо метою є використання мітки всередині функції, то mapply()це корисно, перебираючи два об'єкти; елементи списку та назви списків.

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

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

@ Ferdinand-kraft дав нам чудовий трюк, а потім каже нам, що ми не повинні використовувати його, оскільки він недокументований та через ефективність роботи.

Я не можу багато сперечатися з першим моментом, але хочу зазначити, що накладні витрати рідко повинні викликати занепокоєння.

давайте визначимо активні функції, тому нам не потрібно називати складний вираз, parent.frame()$i[]а лише .i(), ми також створимо .n()для доступу до імені, яке повинно працювати як для базових, так і для purrr функцій (і, мабуть, і для більшості інших).

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

Тепер давайте порівняємо просту функцію, яка вставляє елементи вектора до їх індексу, використовуючи різні підходи (ці операції, звичайно, можна векторизувати, використовуючи, paste(vec, seq_along(vec))але тут справа не в цьому).

Ми визначаємо функцію бенчмаркінгу та графічну функцію та описуємо результати нижче:

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 пакетом reprex (v0.3.0)}

Крапля на початку першої діаграми - це монета, будь ласка, ігноруйте її.

Ми бачимо, що обрана відповідь справді швидша, і для пристойної кількості ітерацій наші .i()рішення справді повільніші, накладні витрати порівняно з обраною відповіддю приблизно в 3 рази перевищують накладні витрати на використання purrr::imap()і становлять приблизно 25 мс для 30 к ітерацій, тому я втрачаю близько 1 мс на 1000 ітерацій, 1 сек на мільйон. На мою думку, це невелика вартість для зручності.

Просто напишіть власну власну 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)
}

Потім використовуйте так:

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