Konvertieren von Matrix mit Listen in eine spärliche Matrix

Question

Ich versuche, eine Matrix, die Listen enthält (mit Elementen variabler Länge) in eine spärliche Matrix zu verwandeln. Dies ist ein Spielzeug Beispiel:

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" 

Die Ausgangsmatrix sollte wie folgt aussehen:

 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 

Ich bin nah an einer Lösung, aber jetzt sieht es völlig ineffizient mit unique(unlist(strsplit())) und for Schleifen usw. Hat jemand eine effiziente Lösung kennen, die zum Beispiel sparseMatrix (oder sparse.model.matrix) von Matrix Paket verwenden?

Vielen Dank!

Answer 1

Eine der schnellsten Möglichkeiten, in eine spärliche Matrix zu schreiben, scheint das Formular myMatrix[matrix] <- value zu sein. Dies wird unten verwendet, zusammen mit lapply und 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 

Es könnte etwas schneller sein, um die passende Voraus zu tun, die die Umwandlung von numerisch Zeichen speichert und zurück:

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