Как выбрать подматрицу в матрице (смежности) на основе связей, в R
У меня есть матрица, которая представляет мобильность между различными заданиями:
jobdat <- matrix(c(
295, 20, 0, 0, 0, 5, 7,
45, 3309, 15, 0, 0, 0, 3,
23, 221, 2029, 5, 0, 0, 0,
0, 0, 10, 100, 8, 0, 3,
0, 0, 0, 0, 109, 4, 4,
0, 0, 0, 0, 4, 375, 38,
0, 18, 0, 0, 4, 26, 260),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
Это рассматривается как ориентированная, взвешенная матрица смежности в анализе социальных сетей. Направление сети - от строк к столбцам. Таким образом, мобильность определяется как переход от строки задания к столбцу задания. Диагональ имеет смысл, так как можно перейти на ту же работу в другой фирме.
Для части моего анализа я хочу выбрать подматрицу, которая состоит из задания 1, задания 5 и задания 7:
work.list <- c(1,5,7)
jobpick_wrong <- jobdat[work.list,work.list]
однако, это только дает прямые связи между этими тремя рабочими местами. Что мне нужно, это:
jobpick_right <- matrix(c(
295, 20, 0, 5, 7,
45, 3309, 0, 0, 3,
0, 0, 109, 4, 4,
0, 0, 4, 375, 38,
0, 18, 4, 26, 260),
nrow = 5, ncol = 5, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 5","job 6","job 7"),
c("job 1","job 2","job 5","job 6","job 7")))
Здесь также включаются задания 2 и 6, поскольку эти две задания также имеют прямые связи с заданием 1, 5 или 7. Хотя задания 3 и 4 исключаются, поскольку они не связаны с заданием 1, 5 или 7.
Я не уверен, как это сделать. Может быть, мне нужно превратить его в igraph-объект, чтобы попасть куда угодно?
net <- graph.adjacency(jobdat, mode = "directed", weighted = TRUE)
а затем, может быть, использовать функцию эго / окрестности, также из пакета igraph? Но как я на самом деле не уверен, как. Или, если это лучший способ сделать это.
Спасибо за ваше время,
Эмиль Бегтруп-Брайт
Дополненный вопрос:
Ответ Айхао идеально подходит для задаваемого вопроса, хотя оказывается, что необходим еще один шаг. Когда создан список work.list, включающий задания, связанные с тремя "интересующими заданиями", задания 1, 5, 7 в этом примере. Затем, с реальными данными, количество беспорядка делает еще один желательный шаг: сохраняются только прямые связи с тремя интересующими заданиями, а связи между другими заданиями устанавливаются равными нулю.
Приведенные выше данные не очень хорошо отражают это, поэтому я создал очень версию выше, чтобы продемонстрировать это:
jobdat <- matrix(c(
1, 0, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 1
),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
используя решение Айхаос:
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[x,] != 0)))))
тогда мы получим это:
jobdat[work.list,work.list]
# job 1 job 2 job 3 job 5 job 7
# job 1 1 0 1 0 0
# job 2 1 1 1 0 0
# job 3 1 1 1 0 0
# job 5 0 0 0 1 0
# job 7 0 0 0 0 1
Однако связи между работой 2 и работой 3 не имеют значения и служат только для того, чтобы скрыть связи интересов.
jobdat.result <- matrix(c(
1, 0, 1, 0, 0,
1, 1, 0, 0, 0,
1, 0, 1, 0, 0,
0, 0, 0, 1, 0,
0, 0, 0, 0, 1
),
nrow = 5, ncol = 5, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 5","job 7"),
c("job 1","job 2","job 3","job 5","job 7")))
в job.dat.result связь между заданием 3 и заданием 2 была удалена, как по строкам, так и по строкам, но связи между этими двумя заданиями и тремя интересующими заданиями сохраняются. В идеале, должна быть возможность выбрать диагональ задания 2, а задание 3 также должно быть равно нулю. Но, скорее всего, я установлю диагональ на ноль для всех заданий, так что это не обязательно. Но было бы неплохо, если не что иное, как мне понять логику этого на более высоком уровне.
Что я пытаюсь достичь, между прочим, так это круговые диаграммы:
Так что простота в количестве связей важна. Диаграмма воспроизводится так:
library(circlize)
segmentcircle <- jobdat
diag(segmentcircle) <- 0
df.c <- get.data.frame(graph.adjacency(segmentcircle,weighted=TRUE))
colour <- brewer.pal(ncol(segmentcircle),"Set1")
chordDiagram(x = df.c,
grid.col = colour,
transparency = 0.2,
directional = 1, symmetric=FALSE,
direction.type = c("arrows", "diffHeight"), diffHeight = -0.065,
link.arr.type = "big.arrow",
# self.link=1
link.sort = TRUE, link.largest.ontop = TRUE,
link.border="black",
# link.lwd = 2,
# link.lty = 2
)
1 ответ
Предполагая, что ваш ориентированный граф состоит из строк в столбцы, вы можете расширить свой work.list с теми столбцами, которые связаны (с элементом!=0) с каждой строкой в work.list, Вы можете сделать это:
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[x,] != 0)))))
использование unique хранить только уникальные колонки в собранном виде и sort так что эти столбцы отсортированы по их показателям. Затем:
jobdat[work.list,work.list]
## job 1 job 2 job 5 job 6 job 7
##job 1 295 20 0 5 7
##job 2 45 3309 0 0 3
##job 5 0 0 109 4 4
##job 6 0 0 4 375 38
##job 7 0 18 4 26 260
Если вместо этого ваш ориентированный граф из столбцов в строки:
work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[,x] != 0)))))
Обновлено для дополненного вопроса:
С новым jobdat:
jobdat <- matrix(c(
1, 0, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
1, 1, 1, 0, 0, 0, 0,
0, 0, 0, 1, 0, 0, 0,
0, 0, 0, 0, 1, 0, 0,
0, 0, 0, 0, 0, 1, 0,
0, 0, 0, 0, 0, 0, 1
),
nrow = 7, ncol = 7, byrow = TRUE,
dimnames = list(c("job 1","job 2","job 3","job 4","job 5","job 6","job 7"),
c("job 1","job 2","job 3","job 4","job 5","job 6","job 7")))
и список соответствующих рабочих мест в work.list:
work.list <- c(1,5,7)
Вычислить расширенный рабочий список aug.work.list как набор рабочих мест, который идет непосредственно к соответствующим рабочим местам в work.list, Это будет включать в себя задания 2 и 3. Обратите внимание, что мы используем which(jobdat[,x] != 0) вместо which(jobdat[x,] != 0) здесь, чтобы определить работу (соответствующую или не относящуюся к делу), которая связана с соответствующей работой x в work.list,
aug.work.list <- sort(unique(unlist(lapply(work.list, function(x) which(jobdat[,x] != 0)))))
##[1] 1 2 3 5 7
Это приводит к:
jobdat.result <- jobdat[aug.work.list, aug.work.list]
## job 1 job 2 job 3 job 5 job 7
##job 1 1 0 1 0 0
##job 2 1 1 1 0 0
##job 3 1 1 1 0 0
##job 5 0 0 0 1 0
##job 7 0 0 0 0 1
Теперь, чтобы удалить связи между нерелевантными заданиями, сначала найдите индексы для этих нерелевантных заданий в jobdat.result, которые являются индексами элементов в aug.work.list которые не в work.list
irrelevant.job.indices <- which(!(aug.work.list %in% work.list))
##[1] 2 3
Обратите внимание, что это не номера заданий для нерелевантных заданий, а индексы (строка и столбец) в jobdat.result соответствующие нерелевантные рабочие номера. В этом случае они просто соответствуют самим рабочим номерам.
Удаление соединений требует установки недиагоналей для подматрицы jobdat.result индексируется irrelevant.job.indices в 0, Сделать это:
## first, keep diagonal values for irrelevant.job.indices
dvals <- diag(jobdat.result)[irrelevant.job.indices]
## set sub-matrix to zero (this will also set diagnal elements to zero)
jobdat.result[irrelevant.job.indices,irrelevant.job.indices] <- 0
## replace diagonal elements
diag(jobdat.result)[irrelevant.job.indices] <- dvals
Результат:
jobdat.result
## job 1 job 2 job 3 job 5 job 7
##job 1 1 0 1 0 0
##job 2 1 1 0 0 0
##job 3 1 0 1 0 0
##job 5 0 0 0 1 0
##job 7 0 0 0 0 1