рассчитать проценты уровней - добавить название столбца

Question

Этот код:

tips <- data.frame(
        gender = c("female", "male", "male")
        ,smoker = c("yes", "no", "no")
     )

tblFun <- function(x) {
    tbl <- table(x)
    res <- cbind(tbl, round(prop.table(tbl) * 100, 2))
    colnames(res) <- c('Count', 'Percentage')
    res
}

do.call(rbind, lapply(tips[1:2], tblFun))

производит это:

       Count Percentage
female     1      33.33
male       2      66.67
no         2      66.67
yes        1      33.33

, что здорово.Тем не менее, я хотел бы представить это:

key_value_pair       Count Percentage
gender=female     1      33.33
gender=male       2      66.67
smoker=no         2      66.67
smoker=yes        1      33.33

Может ли кто-нибудь быть таким добрым и предложить решение?Спасибо!

Answer 1

Я бы использовал tidyverse и некоторые манипуляции с данными:

library(tidyverse)

tips %>%
    gather(key_value, value) %>% # wide to long
    count(key_value, value) %>%
    group_by(key_value) %>%
    mutate(percentage = n / sum(n)) %>%
    unite(key_value_pair, key_value, value, sep = "=") # convert 2 cols into 1

#   key_value_pair     n percentage
#   <chr>          <int>      <dbl>
# 1 gender=female      1      0.333
# 2 gender=male        2      0.667
# 3 smoker=no          2      0.667
# 4 smoker=yes         1      0.333

Answer 2

Одним из способов является расширение функции tblFun для принятия имени категории и добавления его к меткам.

tblFun <- function(x, nm = character(0)) {
  tbl <- table(x)
  if (length(nm)) names(tbl) <- paste(nm[[1]], names(tbl), sep = "=")
  res <- cbind(tbl, round(prop.table(tbl) * 100, 2))
  colnames(res) <- c('Count', 'Percentage')
  res
}

При отсутствии изменений он ведет себя как прежде:

do.call(rbind, lapply(tips[1:2], tblFun))
#        Count Percentage
# female     1      33.33
# male       2      66.67
# no         2      66.67
# yes        1      33.33

Чтобы передать имя каждого столбца каждому столбцу, необходимо использовать версию с несколькими аргументами lapply, Map:

do.call(rbind, Map(tblFun, tips[1:2], names(tips[1:2])))
#               Count Percentage
# gender=female     1      33.33
# gender=male       2      66.67
# smoker=no         2      66.67
# smoker=yes        1      33.33

---

Альтернативой является использование purrr::imap, который передает как объект , так и его имя (в качестве второго аргумента) функции:

do.call(rbind, purrr::imap(tips[1:2], tblFun))
#               Count Percentage
# gender=female     1      33.33
# gender=male       2      66.67
# smoker=no         2      66.67
# smoker=yes        1      33.33

Одно преимущество, которое я вижу, заключается в том, что нет необходимости включать в себя tips[1:2] и names(tips[1:2]), хотя, если вы еще не используете purrr или tidyverse-пакеты, добавление другого пакета просто для этого может быть нежелательным (особенно, если Map делает то же самое с явным names()).

---

В качестве краткой демонстрации того, что делает Map: он «объединяет» аргументы.

Для сравнения lapply (и семейство) запускают функцию один раз для каждого элементаего входного вектора / списка.Таким образом, lapply(1:3, myfunc) "развертывается" до

list(
  myfunc(1),
  myfunc(2),
  myfunc(3)
)

Однако, если вы попытаетесь указать несколько векторов, он не будет работать так, как один "может" хотеть / подумать: lapply(1:3, myfunc, 11:13) развертывается до:

list(
  myfunc(1, 11:13),
  myfunc(2, 11:13),
  myfunc(3, 11:13)
)

Map делает это для произвольного числа векторов / списков, поэтому Map(myfunc, 1:3, 11:13, 21:23, 99) разворачивается до

list(
  myfunc(1, 11, 21, 99),
  myfunc(2, 12, 22, 99),
  myfunc(3, 13, 23, 99)
)

(Обратите внимание, как векторы длины один перерабатываются. Хотя это действительно перерабатываетдлины между 1 и длиной самого длинного вектора, я не рекомендую полагаться на него, если вы строго не контролируете тот факт, что более короткие векторы должны умножаться на длину самого длинного без остатка.)

myfunc в этом случае необходимо принять (как минимум) три аргумента.Два заметных различия между lapply и Map:

• lapply ставят data-first, function-second;поскольку Map принимает один или несколько векторов / списков, он помещает функцию first, один или более данных в секунду +;
• Map перезапустит единственный аргумент listпоэтому Map(myfunc, 1:3, list(11:13) развертывается до list(myfunc(1, 11:13), myfunc(2, 11:13), myfunc(3, 11:13)), что на поверхности выглядит очень похоже на lapply(1:3, myfunc, 11:13), но может быть удобно, когда у вас более двух векторов входных данных.
• Потому что не важно, скольковекторы / списки, можно отправлять произвольные / неизвестные длины векторов / списков в Map с do.call, как в

  l <- list(1:3, 11:13, 21:21)
  do.call("Map", c(f = myfunc, l))
  

  (до тех пор, пока myfunc принимает произвольное количество аргументов, вероятно, с помощью механики ...).Первый и единственный именованный аргумент Map для функции равен f=;здесь не обязательно называть его, но я хотел бы пояснить.
• Так же, как lapply имеет опционально упрощающую версию sapply, Map имеет опционально упрощающую версию mapply,Я предпочитаю явное - нет ничего более расстраивающего, чем ожидание векторного вывода, но один ввод приводит к выводу list ...