Преобразование ширины в длину с помощью частотного столбца

Я пытаюсь преобразовать свои данные.кадр из широкого стола в длинный стол с частотным столбцом. 

data("UCBAdmissions")
ucb_admit <- as.data.frame(UCBAdmissions)
ucb_admit
   Admit    Gender Dept Freq
1  Admitted   Male    A  512
2  Rejected   Male    A  313
3  Admitted Female    A   89
4  Rejected Female    A   19
...

И я хочу собрать эти данные (пакет tidyr, подобный melt from reshape), но использовать Freq, чтобы указать, сколько раз строка должна повторяться.

Поэтому мои целевые данные будут выглядеть примерно так: 

     Admit      Gender Dept
1    Admitted   Male    A
2    Admitted   Male    A
3    Admitted   Male    A
4    Admitted   Male    A
5    Admitted   Male    A
6    Admitted   Male    A
...
4523 Rejected Female    F
4524 Rejected Female    F
4525 Rejected Female    F
4526 Rejected Female    F

Я хотел бы использовать tidyr:: gather (), чтобы сделать это, однако мои результаты не верны, поскольку я не уверен, если / как включить Freq колонна?

Спасибо

2 3
dataframe tidyr

2 ответа:

Это не похоже на работу для gather, поскольку данные агрегируются, а не расширяются. Вы можете "дезагрегировать" данные с помощью индексации, повторив индексы строк Freq раз для каждой строки. Ниже приведены методы, использующие базу R и dplyr.

library(dplyr)

# Base R
ucb_admit_disagg = ucb_admit[rep(1:nrow(ucb_admit), ucb_admit$Freq), 
                             -grep("Freq", names(ucb_admit))]

# dplyr
ucb_admit_disagg = ucb_admit %>% 
  slice(rep(1:n(), Freq)) %>% 
  select(-Freq)

Вот часть фрейма данных. Я добавил многоточия к выходным данным, чтобы отметить разрывы в последовательности строк.

ucb_admit_disagg[c(1:6, 510:514, 4523:4526), ]

          Admit Gender Dept
1      Admitted   Male    A
1.1    Admitted   Male    A
1.2    Admitted   Male    A
1.3    Admitted   Male    A
1.4    Admitted   Male    A
1.5    Admitted   Male    A
...
1.509  Admitted   Male    A
1.510  Admitted   Male    A
1.511  Admitted   Male    A
2      Rejected   Male    A
2.1    Rejected   Male    A
...
24.313 Rejected Female    F
24.314 Rejected Female    F
24.315 Rejected Female    F
24.316 Rejected Female    F
2

Вот решение с использованием dplyr, tidyr, и purrr.

library(dplyr)
library(tidyr)
library(purrr)

ucb_admit2 <- ucb_admit %>%
  mutate(Freq = map2(1, Freq, `:`)) %>%
  unnest() %>%
  select(-Freq)

Или использовать этот аналогичный подход, который требует только функций из dplyr и tidyr.

ucb_admit2 <- ucb_admit %>%
  rowwise() %>%
  mutate(Freq = list(seq(1, Freq))) %>%
  ungroup() %>%
  unnest() %>%
  select(-Freq)

Оба они используют одну и ту же стратегию: создают столбец списка, а затем unnest его.

Мы также можем рассмотреть возможность использования функции separate_row из tidyr для решения этой задачи.

ucb_admit2 <- ucb_admit %>%
  rowwise() %>%
  mutate(Freq = paste(seq(1, Freq), collapse = ",")) %>%
  ungroup() %>%
  separate_rows(Freq) %>%
  select(-Freq)

Бенчмаркинг

Я сравнил два метода, предложенные eipi10, и три метода, предложенные мной, используя следующие microbenchmarking. Результат показывает, что подход base R является самым быстрым, за которым следует подход dplyr repeat и slice. Поэтому, я думаю, если нет других соображений, таких как читаемость кода, нет необходимости использовать tidyr или purrr для этого вопроса. 

library(microbenchmark)

library(microbenchmark)


microbenchmark(m1 = (ucb_admit[rep(1:nrow(ucb_admit), 
                                   ucb_admit$Freq), 
                               -grep("Freq", names(ucb_admit))]),
               m2 = (ucb_admit %>% 
                       slice(rep(1:n(), Freq)) %>% 
                       select(-Freq)),
               m3 = (ucb_admit %>%
                       mutate(Freq = map2(1, Freq, `:`)) %>%
                       unnest() %>%
                       select(-Freq)),
               m4 = (ucb_admit %>%
                       rowwise() %>%
                       mutate(Freq = list(seq(1, Freq))) %>%
                       ungroup() %>%
                       unnest() %>%
                       select(-Freq)),
               m5 = (ucb_admit %>%
                       rowwise() %>%
                       mutate(Freq = paste(seq(1, Freq), collapse = ",")) %>%
                       ungroup() %>%
                       separate_rows(Freq) %>%
                       select(-Freq)))

Unit: milliseconds
 expr       min        lq      mean    median        uq       max neval
   m1  3.455026  3.585888  4.295322  3.845367  4.147506   8.60228   100
   m2  6.888881  7.541269  8.849527  8.031040  9.428189  15.53991   100
   m3 23.252458 24.959122 29.706875 27.414396 32.506805  61.00691   100
   m4 20.033499 21.914645 25.888155 23.611688 27.310155 101.15088   100
   m5 28.972557 31.127297 35.976468 32.652422 37.669135  64.43884   100
2