эффективно разрушаться матрицу

Question

У меня есть матрица этого формата:

set.seed(1) 
mat <- matrix(round(runif(25,0,1)),nrow=5,ncol=5) 
colnames(mat) <- c("a1::C","a1::A","a1::B","b1::D","b1::A") 

    a1::C a1::A a1::B b1::D b1::A 
[1,]  0  1  0  0  1 
[2,]  0  1  0  1  0 
[3,]  1  1  1  1  1 
[4,]  1  1  0  0  0 
[5,]  0  0  1  1  0 

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

Я хочу построить новую матрицу, где столбцами будут объекты (т. Е. Один столбец для каждого объекта), а в строках объекты, которые этот объект имеет, будут отображаться в алфавитном порядке и разделены комой. В случае, если у субъекта нет какой-либо функции (т. Е. Определенной строки все с 0 для этого предмета), должно использоваться значение «W» (ни одна из функций не имеет значения «W»).

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

cnames = unique(sapply(colnames(mat), function(x) strsplit(x,split="::")[[1]][1])) 
new_mat <- matrix(c("A","A","A,B,C","A,C","B", 
        "A","D","A,D","W","D"), 
        nrow=nrow(mat),ncol=length(cnames)) 
colnames(new_mat) = cnames 

    a1  b1 
[1,] "A"  "A" 
[2,] "A"  "D" 
[3,] "A,B,C" "A,D" 
[4,] "A,C" "W" 
[5,] "B"  "D" 

Любая идея, что было бы эффективным и элегантный способ для достижения этой цели?

Answer 1

вот начальная точка. В зависимости от того, сколько переменных у вас есть, это может стать громоздким.

library(data.table) 
dt = data.table(id = seq_len(nrow(mat)), mat) 
longDt <- melt(dt, id.vars = "id", measure = patterns("^a1::", "^b1::")) 

longDt[, .(a1 = list(sort(c("C", "A", "B")[as.logical(value1)])), 
      b1 = list(sort(c("D", "A")[as.logical(value2)]))), .(id)] 
    id a1 b1 
1: 1  A A 
2: 2  A D 
3: 3 A,B,C A,D 
4: 4 A,C  
5: 5  B D 

Answer 2

Шаг 1: Матрица колонка поворотного

mat <- mat[, order(colnames(mat))] 

#  a1::A a1::B a1::C b1::A b1::D 
# [1,]  1  0  0  1  0 
# [2,]  1  0  0  0  1 
# [3,]  1  1  1  1  1 
# [4,]  1  0  1  0  0 
# [5,]  0  1  0  0  1 

Шаг 2.1: Колонка разложение имени

## decompose levels, get main levels (before ::) and sub levels (post ::) 
decom <- strsplit(colnames(mat), "::") 

main_levels <- sapply(decom, "[", 1) 
# [1] "a1" "a1" "a1" "b1" "b1" 

sub_levels <- sapply(decom, "[", 2) 
# [1] "A" "B" "C" "A" "D" 

Шаг 2.2: Группировка поколение индекса

## generating grouping index 
main_index <- paste(rep(main_levels, each = nrow(mat)), rep(1:nrow(mat), times = ncol(mat)), sep = "#") 
sub_index <- rep(sub_levels, each = nrow(mat)) 
sub_index[!as.logical(mat)] <- "" ## 0 values in mat implies "" 

## in unclear of what "main_index" and "sub_index" are, check: 

## matrix(main_index, nrow(mat)) 
#  [,1] [,2] [,3] [,4] [,5] 
# [1,] "a1#1" "a1#1" "a1#1" "b1#1" "b1#1" 
# [2,] "a1#2" "a1#2" "a1#2" "b1#2" "b1#2" 
# [3,] "a1#3" "a1#3" "a1#3" "b1#3" "b1#3" 
# [4,] "a1#4" "a1#4" "a1#4" "b1#4" "b1#4" 
# [5,] "a1#5" "a1#5" "a1#5" "b1#5" "b1#5" 

## matrix(sub_index, nrow(mat)) 
#  [,1] [,2] [,3] [,4] [,5] 
# [1,] "A" "" "" "A" "" 
# [2,] "A" "" "" "" "D" 
# [3,] "A" "B" "C" "A" "D" 
# [4,] "A" "" "C" "" "" 
# [5,] "" "B" "" "" "D" 

Шаг 2,3: Условный разрушилась вставив

## collapsed paste of "sub_index" conditional on "main_index" 
x <- unname(tapply(sub_index, main_index, paste0, collapse = "")) 
x[x == ""] <- "W" 
# [1] "A" "A" "ABC" "AC" "B" "A" "D" "AD" "W" "D" 

Шаг 3: пост-обработка

Я не очень доволен этим, но не нашел альтернативу.

x <- sapply(strsplit(x, ""), paste0, collapse = ",") 
# [1] "A" "A" "A,B,C" "A,C" "B" "A" "D" "A,D" "W" "D" 

Шаг 4: Матрица

x <- matrix(x, nrow = nrow(mat)) 
colnames(x) <- unique(main_levels) 

#  a1  b1 
# [1,] "A"  "A" 
# [2,] "A"  "D" 
# [3,] "A,B,C" "A,D" 
# [4,] "A,C" "W" 
# [5,] "B"  "D" 

Эффективность соображением

Сам метод является весьма эффективным использованием векторизации, и не требует ручного ввода группировки информации. Например, вы можете использовать тот же код, когда у вас есть даже сотни основных групп (до: :) и сотен подгрупп (post: :).

Единственное соображение - уменьшить ненужные копии памяти. В этом отношении мы должны использовать анонимную функцию всякий раз, когда можем, без явного назначения матрицы, как показано выше.Это было бы хорошо (уже проверено):

decom <- strsplit(sort(colnames(mat)), "::") 
main_levels <- sapply(decom, "[", 1) 

sub_index <- rep(sapply(decom, "[", 2), each = nrow(mat)) 
sub_index[!as.logical(mat[, order(colnames(mat))])] <- "" 

x <- unname(tapply(sub_index, 
        paste(rep(main_levels, each = nrow(mat)), 
          rep(1:nrow(mat), times = ncol(mat)), 
          sep = "#"), 
        paste0, collapse = "")) 

x <- matrix(sapply(strsplit(x, ""), paste0, collapse = ","), 
      nrow = nrow(mat)) 

colnames(x) <- unique(main_levels)