Подсчет случаев перекрытия в двух векторах в R - PullRequest
Новая
       26

Подсчет случаев перекрытия в двух векторах в R

0 голосов
/ 22 марта 2020

Я надеюсь создать матрицу, которая показывает количество экземпляров перекрывающихся значений для группирующей переменной на основе второй переменной. В частности, я надеюсь определить степень, в которой первичные исследования перекрываются между мета-анализами, чтобы создать диаграмму сети.

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

df <- data.frame(metas = c(1,1,1,2,3,3), studies = c(1,3,2,1,2,3))

   metas studies
1     1    1
2     1    3
3     1    2
4     2    1
5     3    2
6     3    3

Я хотел бы, чтобы он возвратил: 

  v1 v2 v3
1  3  1  2
2  1  1  0
3  2  0  2

Значение в строке 1, столбец 1, указывает на то, что метаанализ 1 имел три общих исследования с самим собой ( т.е. он включал три исследования). Строка 1, столбец 2 указывает, что у Мета-анализа 1 было одно общее исследование с Мета-анализом 2. Строка 1, столбец 3 указывает, что у Мета-анализа 1 было два общих исследования с Мета-анализом 3.

Ответы [ 2 ]

2 голосов
/ 22 марта 2020

Полагаю, вы ищете симметричную c матрицу пересекающихся исследований. 

dfspl <- split(df$studies, df$metas)
out <- outer(seq_along(dfspl), seq_along(dfspl),
             function(a, b) lengths(Map(intersect, dfspl[a], dfspl[b])))
out
#      [,1] [,2] [,3]
# [1,]    3    1    2
# [2,]    1    1    0
# [3,]    2    0    2

Если вам нужны имена для них, вы можете go с именами, определенными df$metas: 

rownames(out) <- colnames(out) <- names(dfspl)
out
#   1 2 3
# 1 3 1 2
# 2 1 1 0
# 3 2 0 2

Если вам нужны имена, определенные как v плюс мета-имя, go с 

rownames(out) <- colnames(out) <- paste0("v", names(dfspl))
out
#    v1 v2 v3
# v1  3  1  2
# v2  1  1  0
# v3  2  0  2

Если вам нужно понять, что это делает, outer создает расширение двух векторов аргументов и передает их все сразу в функцию. Например, 

outer(seq_along(dfspl), seq_along(dfspl), function(a, b) { browser(); 1; })
# Called from: FUN(X, Y, ...)
debug at #1: [1] 1
# Browse[2]> 
a
# [1] 1 2 3 1 2 3 1 2 3
# Browse[2]> 
b
# [1] 1 1 1 2 2 2 3 3 3
# Browse[2]>

В конечном итоге мы хотим найти пересечение каждой пары исследований. 

dfspl[[1]]
# [1] 1 3 2
dfspl[[3]]
# [1] 2 3
intersect(dfspl[[1]], dfspl[[3]])
# [1] 3 2
length(intersect(dfspl[[1]], dfspl[[3]]))
# [1] 2

Конечно, мы делаем это дважды (один раз для 1 и 3 , один раз для 3 и 1 (это тот же результат), так что это немного неэффективно ... было бы лучше отфильтровать их, чтобы посмотреть только на верхнюю или нижнюю половину и перенести их на другую.

Отредактировано для более эффективного процесса (вычисление только каждой пары пересечений один раз и никогда не вычисление самопересечения.) 

eg <- expand.grid(a = seq_along(dfspl), b = seq_along(dfspl))
eg <- eg[ eg$a < eg$b, ]
eg
#   a b
# 4 1 2
# 7 1 3
# 8 2 3
lens <- lengths(Map(intersect, dfspl[eg$a], dfspl[eg$b]))
lens
# 1 1 2       ## btw, these are just names, from eg$a
# 1 2 0 
out <- matrix(nrow = length(dfspl), ncol = length(dfspl))
out[ cbind(eg$a, eg$b) ] <- lens
out
#      [,1] [,2] [,3]
# [1,]   NA    1    2
# [2,]   NA   NA    0
# [3,]   NA   NA   NA
out[ lower.tri(out) ] <- out[ upper.tri(out) ]
diag(out) <- lengths(dfspl)
out
#      [,1] [,2] [,3]
# [1,]    3    1    2
# [2,]    1    1    0
# [3,]    2    0    2
1 голос
/ 22 марта 2020

Та же идея, что и у @ r2evans, также Base R (и чуть менее красноречиво) (редактируется по мере необходимости): 

# Create df using sample data: 

df <- data.frame(metas = c(1,1,1,2,3,3), studies = c(1,7,2,1,2,3))

# Test for equality between the values in the metas vector and the rest of 
# of the values in the dataframe -- Construct symmetric matrix from vector: 

m1 <- diag(v1); m1[,1] <- m1[1,] <- v1 <- rowSums(data.frame(sapply(df$metas, `==`, 
                                                                    unique(unlist(df)))))

# Coerce matrix to dataframe setting the names as desired; dropping non matches:

df_2 <- setNames(data.frame(m1[which(rowSums(m1) > 0), which(colSums(m1) > 0)]),
                 paste0("v", 1:ncol(m1[which(rowSums(m1) > 0), which(colSums(m1) > 0)])))
...