Преобразование матрицы со списками в разреженную матрицу

Question

Я пытаюсь превратить матрицу, содержащую списки (с элементами переменной длины) в разреженную матрицу. Это игрушка пример:

mOrig = matrix(
    c(rep(c('a_b', 'X'), 3), 
    rep(c('a_b_e', 'X'), 2), 
    rep(c('a_b_f', 'X'), 1), 
    rep(c('c_d', 'Y'), 3), 
    rep(c('c_d_e', 'Y'), 2), 
    rep(c('c_d_f', 'Y'), 1)), 
    ncol=2, byrow=TRUE 
) 
colnames(mOrig) = c('in', 'out') 
mOrig 

     in  out 
[1,] "a_b" "X" 
[2,] "a_b" "X" 
[3,] "a_b" "X" 
[4,] "a_b_e" "X" 
[5,] "a_b_e" "X" 
[6,] "a_b_f" "X" 
[7,] "c_d" "Y" 
[8,] "c_d" "Y" 
[9,] "c_d" "Y" 
[10,] "c_d_e" "Y" 
[11,] "c_d_e" "Y" 
[12,] "c_d_f" "Y" 

Выходная матрица должна выглядеть следующим образом:

 a b c d e f X Y 
[1,] 1 1 0 0 0 0 1 0 
[2,] 1 1 0 0 0 0 1 0 
[3,] 1 1 0 0 0 0 1 0 
[4,] 1 1 0 0 1 0 1 0 
[5,] 1 1 0 0 1 0 1 0 
[6,] 1 1 0 0 0 1 1 0 
[7,] 0 0 1 1 0 0 0 1 
[8,] 0 0 1 1 0 0 0 1 
[9,] 0 0 1 1 0 0 0 1 
[10,] 0 0 1 1 1 0 0 1 
[11,] 0 0 1 1 1 0 0 1 
[12,] 0 0 1 1 0 1 0 1 

Я близок к решению, но теперь это выглядит совершенно неэффективно с unique(unlist(strsplit())) и for петлями и т.д. Есть ли кто-нибудь знаете какое-нибудь эффективное решение, которое, например, использовало бы sparseMatrix (или sparse.model.matrix) от Matrix?

Большое спасибо!

Answer 1

Одним из самых быстрых способов записи в разреженную матрицу, по-видимому, является использование формы myMatrix[matrix] <- value. Это используется ниже, наряду с lapply и strsplit.

library(Matrix) 

mx <- Matrix(0,12,8, dimnames = list(NULL, c(letters[1:6], LETTERS[24:25]))) 

mOrig_split <- strsplit(mOrig[,'in'], '_') 

long_fm <- do.call(rbind, lapply(seq_along(mOrig_split), function(x) { 
    cbind(x,c(mOrig_split[[x]], mOrig[x,2]))})) 

mx[cbind(as.numeric(long_fm[,1]), match(long_fm[,2], colnames(mx)))] <- 1 

mx 

Это может быть немного быстрее, чтобы сделать согласование авансового, который сохраняет преобразование из числового характера и обратно:

mx <- Matrix(0,12,8, dimnames = list(NULL, c(letters[1:6], LETTERS[24:25]))) 

mOrig_split <- lapply(strsplit(mOrig[,'in'], '_'), match, colnames(mx)) 
mOrig_out <- match(mOrig[,2], colnames(mx)) 

long_fm <- do.call(rbind, lapply(seq_along(mOrig_split), function(x) { 
    cbind(x,c(mOrig_split[[x]], mOrig_out[x]))})) 

mx[long_fm] <- 1