фиктивный код свернут столбец с использованием data.table в R

Question

Свернуть столбец с помощью tidyverse довольно просто. Вот быстрый пример того, как я делал это в прошлом. Сначала я загружу данные iris и создам настраиваемый свернутый столбец из случайно выбранных букв:

library(tidyverse)

# load practice data
data(iris)
iris <- as_tibble(iris)

# create column of collapsed values
lst <- list()
for(i in 1:150) {
  value <- as.list(paste0(sample(letters[1:2], 1), ", ", sample(letters[3:4], 1)))
  lst[i] <- value
}

# append custom columns to the iris dataset
iris$Samples <- unlist(lst)
iris$Subject <- c(1:150)
iris <- iris %>% select(Subject, everything())

# preview custom dataset
iris

# A tibble: 150 x 7
   Subject Sepal.Length Sepal.Width Petal.Length Petal.Width Species Samples
     <int>        <dbl>       <dbl>        <dbl>       <dbl> <fct>   <chr>  
 1       1          5.1         3.5          1.4         0.2 setosa  a, d   
 2       2          4.9         3            1.4         0.2 setosa  a, c   
 3       3          4.7         3.2          1.3         0.2 setosa  a, c   
 4       4          4.6         3.1          1.5         0.2 setosa  b, c   
 5       5          5           3.6          1.4         0.2 setosa  a, c   
 6       6          5.4         3.9          1.7         0.4 setosa  a, d   
 7       7          4.6         3.4          1.4         0.3 setosa  b, c   
 8       8          5           3.4          1.5         0.2 setosa  b, c   
 9       9          4.4         2.9          1.4         0.2 setosa  b, d   
10      10          4.9         3.1          1.5         0.1 setosa  a, c
# ... with 140 more rows

Итак, предположим, что каждая буква представляет уникальное значение интереса, и я хотел это обсудить данные в ряд фиктивных переменных для каждой буквы. Вот как я мог бы сделать это, используя tidyverse функции:

iris %>%
  separate_rows(Samples, sep = ', ') %>%
  mutate(Values = 1) %>%
  pivot_wider(names_from = "Samples", values_from = "Values") %>%
  mutate_if(is.double, ~replace_na(., 0))

 # A tibble: 150 x 10
   Subject Sepal.Length Sepal.Width Petal.Length Petal.Width Species     a     d     c     b
     <int>        <dbl>       <dbl>        <dbl>       <dbl> <fct>   <dbl> <dbl> <dbl> <dbl>
 1       1          5.1         3.5          1.4         0.2 setosa      1     1     0     0
 2       2          4.9         3            1.4         0.2 setosa      1     0     1     0
 3       3          4.7         3.2          1.3         0.2 setosa      1     0     1     0
 4       4          4.6         3.1          1.5         0.2 setosa      0     0     1     1
 5       5          5           3.6          1.4         0.2 setosa      1     0     1     0
 6       6          5.4         3.9          1.7         0.4 setosa      1     1     0     0
 7       7          4.6         3.4          1.4         0.3 setosa      0     0     1     1
 8       8          5           3.4          1.5         0.2 setosa      0     0     1     1
 9       9          4.4         2.9          1.4         0.2 setosa      0     1     0     1
10      10          4.9         3.1          1.5         0.1 setosa      1     0     1     0
# ... with 140 more rows

Это быстро и эффективно для небольших наборов данных. Но я быстро перемещаюсь в наборы данных с миллионами строк. Введите data.table.

Как бы выполнить sh тот же процесс, используя data.table? Вот моя попытка:

library(data.table)

# convert my tibble into a data.table
iris.dt <- as.data.table(iris)

# perform the separate_rows functionality on my data
result <- iris.dt[, list(Samples = unlist(strsplit(Samples, ", "))), by = Subject
                  ][, Values := 1]

print(result)

     Subject Samples Values
  1:       1       a      1
  2:       1       d      1
  3:       2       a      1
  4:       2       c      1
  5:       3       a      1
---                       
296:     148       d      1
297:     149       a      1
298:     149       d      1
299:     150       b      1
300:     150       c      1

Проблема в том, что я не знаю, как (1) сохранить все остальные столбцы и (2) разложить эту информацию аналогично dplyr::pivot_wider.

Любая помощь будет высоко ценится!

Answer 1

Вот еще один вариант с использованием числовой матрицы c индекс:

l <- strsplit(DT[["Samples"]], ",")
nl <- lengths(l)
ul <- unlist(l)
cols <- sort(unique(ul))

DT[, (cols) := {
        m <- matrix(0L, nrow=.N, ncol=length(cols))
        m[cbind(rep(1L:.N, nl), match(ul, cols))] <- 1L
        as.data.table(m)
    }]

вывод:

    Subject Samples a b c d
 1:       1     a,d 1 0 0 1
 2:       2     a,c 1 0 1 0
 3:       3     a,c 1 0 1 0
 4:       4     b,c 0 1 1 0
 5:       5     a,c 1 0 1 0
 6:       6     a,d 1 0 0 1
 7:       7     b,c 0 1 1 0
 8:       8     b,c 0 1 1 0
 9:       9     b,d 0 1 0 1
10:      10     a,c 1 0 1 0

данные:

DT <- fread("Subject Samples
1         a,d   
2         a,c   
3         a,c   
4         b,c   
5         a,c   
6         a,d   
7         b,c   
8         b,c   
9         b,d   
10        a,c", sep=" ")

Answer 2

Один из способов - это tstrsplit, а затем плавить + dcast. Кажется неэффективным, но не уверен в другом

Пример данных:

library(magrittr)
library(data.table)

set.seed(2020)
iris.dt <- as.data.table(iris)
iris.dt[, samples := paste0(sample(letters[1:2], .N, T), ', ', sample(letters[3:4], .N, T))]

Создание фиктивных столбцов

new_cols <- 
  iris.dt[, tstrsplit(samples, ', ')][, I := .I] %>% 
    melt('I') %>% 
    dcast(I ~ value, fun.agg = length) %>% 
    .[, I := NULL]


iris.dt[, names(new_cols) := new_cols][]
#      Sepal.Length Sepal.Width Petal.Length Petal.Width   Species samples a b c d
#   1:          5.1         3.5          1.4         0.2    setosa    b, c 0 1 1 0
#   2:          4.9         3.0          1.4         0.2    setosa    a, d 1 0 0 1
#   3:          4.7         3.2          1.3         0.2    setosa    b, c 0 1 1 0
#   4:          4.6         3.1          1.5         0.2    setosa    a, d 1 0 0 1
#   5:          5.0         3.6          1.4         0.2    setosa    a, c 1 0 1 0
#  ---                                                                            
# 146:          6.7         3.0          5.2         2.3 virginica    b, d 0 1 0 1
# 147:          6.3         2.5          5.0         1.9 virginica    a, d 1 0 0 1
# 148:          6.5         3.0          5.2         2.0 virginica    b, c 0 1 1 0
# 149:          6.2         3.4          5.4         2.3 virginica    a, c 1 0 1 0
# 150:          5.9         3.0          5.1         1.8 virginica    a, d 1 0 0 1