коллапса/агрегировать некоторые части матрицы смежности одновременно на строках и столбцах

Question

У меня есть матрица, которая представляет мобильность между различными рабочими местами:

jobnames <- c("job 1","job 2","job 3","job 4","job 5","job 6","job 7") 
jobdat <- matrix(c(
5, 5, 5, 0, 0, 5, 5, 
5, 5, 2, 5, 5, 1, 5, 
1, 5, 5, 5, 0, 0, 1, 
1, 0, 5, 5, 8, 0, 1, 
0, 5, 0, 0, 5, 5, 1, 
0, 0, 5, 5, 0, 5, 5, 
0, 1, 0, 0, 5, 1, 5 
      ), 
      nrow = 7, ncol = 7, byrow = TRUE, 
      dimnames = list(jobnames,jobnames 
       )) 

Это трактуется как направленная, взвешенная матрица смежности в социальной сети анализ. Направление сети от строк до столбцов: Таким образом, мобильность определяется как переход от строки задания к столбцу задания. Диагональ имеет значение, так как можно изменить на ту же работу в другой фирме.

мне нужно свернуть эту матрицу в соответствии с прообразом списка , содержащего индекс рабочих мест, которые должны быть объединены:

group.list <- list(grp1=c(1,2) ,grp2 =c(3,4)) 

Теперь, так как это матрица смежности, это немного отличается от других 'ответы о том, как свернуть матрицу, которую я нашел здесь и где-то еще. Коллапс должен быть одновременным как по строкам, так и по столбцам. И некоторые работы не сгруппированы вообще. Так что результат в данном примере должно быть так:

group.jobnames <- c("job 1 and 2","job 3 and 4","job 5","job 6","job 7") 

group.jobdat <- matrix(c(
      20,12,5,6,10, 
      7,17,8,0,2, 
      5,0,5,5,1, 
      0,10,0,5,5, 
      1,0,5,1,5 
      ), 
      nrow = 5, ncol = 5, byrow = TRUE, 
      dimnames = list(group.jobnames,group.jobnames 
       )) 

В этом примере группы два первых рабочих мест, а затем следующий два, но в моих фактических данных это может быть любая комбинация (индексов) рабочих мест, а также любые количество рабочих мест в каждой группе. Таким образом, работа [1,7] может быть одной группой, а работа [2,3,6] может быть другой группой, в то время как работа 4 или 5 не была сгруппирована. Или любая другая комбинация.

Спасибо за ваше время,

Answer 1

Я считаю, что есть некоторые опечатки в предполагаемой продукции, а также определение group.list. Если я прав в своей интерпретации, вот решение.

Вот новый group.list, который соответствует названиям желаемого результата. В этой версии группа 2 сопоставляется с 1, а группа 4 сопоставляется с 3, что соответствует тексту в group.jobs.

group.list <- list(grp1=c(1, 3), grp2=c(2, 4)) 

Учитывая этот список, построить группировку вектор

# initial grouping 
groups <- seq_len(ncol(jobdat)) 
# map elements of second list item to values of first list item 
groups[match(group.list[["grp2"]], groups)] <- group.list[["grp1"]] 

groups 
[1] 1 1 3 3 5 6 7 

Итак, теперь группы 1 и 2 такие же, как и 3 и 4. Теперь мы используем rowsum и пару транспонирования в вычислить выход.

myMat <- t(rowsum(t(rowsum(jobdat, groups)), groups)) 
# add the group names 
dimnames(myMat) <- list(group.jobnames,group.jobnames) 

myMat 
      job 1 and 2 job 3 and 4 job 5 job 6 job 7 
job 1 and 2   20   12  5  6 10 
job 3 and 4   7   20  8  0  2 
job 5     5   0  5  5  1 
job 6     0   10  0  5  5 
job 7     1   0  5  1  5 

---

В ответ на комментарии ОР по ниже, группировка должна была быть в пределах элементов списка, а не соответствующие позиции между элементами списка, как я первоначально интерпретированы. Для выполнения этой формы группировки будет выполнена повторная подача replace до Reduce. С group.list как в вопросе,

group.list <- list(grp1=c(1, 2), grp2=c(3, 4)) 

groups <- Reduce(function(x, y) replace(x, x[x %in% y], min(y)), 
       c(list(groups), unname(group.list))) 
groups 
[1] 1 1 3 3 5 6 7 

Здесь replace принимает первоначальную группировку, находит элементы группировки, которые находятся в одном из векторов в group.list, и заменяет их с минимальным значением этого вектора. Функция Reduce повторно применяет эту операцию к исходной групповой переменной, за исключением изменения ее на каждой итерации.

С этим результатом, мы используем выше переставляет и rowsum получить

myMat 
      job 1 and 2 job 3 and 4 job 5 job 6 job 7 
job 1 and 2   20   12  5  6 10 
job 3 and 4   7   20  8  0  2 
job 5     5   0  5  5  1 
job 6     0   10  0  5  5 
job 7     1   0  5  1  5