r - R中最简单的主题分配算法

Question

我想分配主题，从受欢迎程度从低到高。我的数据如下所示:

library(tidyverse)
data <- data.frame(topic = c("A", "B", "C", "D", "E"),
           id1 = c(1,2,3,1,2),
           id2 = c(3,3,2,1,3),
           id3 = c(1,1,3,3,2),
           id4 = c(3,1,2,2,1),
           id5 = c(2,2,1,3,1),
           id6 = c(3,1,1,1,3)) %>%
  mutate(popularity = rowSums(. == 3),) %>%
  arrange(popularity) 

  topic id1 id2 id3 id4 id5 id6 popularity
1     B   2   3   1   1   2   1          1
2     C   3   2   3   2   1   1          2
3     D   1   1   3   2   3   1          2
4     E   2   3   2   1   1   3          2
5     A   1   3   1   3   2   3          3

在 SO 的帮助下，我能够将每行中的主题分配给该行中的第一个最大值。所以我们在这里所做的是将主题标题从每一行移动到值 3 的第一次出现(在这种情况下是最大值)。

# create empty matrox of size of the data
my_matrix <- matrix(NA, nrow(data), ncol(data)-1)
# fill matrix with topic at first occurence of maximum value per row
my_matrix[cbind(seq_len(nrow(my_matrix)), max.col(data[,-1], 'first'))] <- data$topic

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,] NA   "B"  NA   NA   NA   NA  
[2,] "C"  NA   NA   NA   NA   NA  
[3,] NA   NA   "D"  NA   NA   NA  
[4,] NA   "E"  NA   NA   NA   NA  
[5,] NA   "A"  NA   NA   NA   NA 

尽管多个主题已分配给一个 id(人)，但这几乎是完美的。我正在寻找执行 max.col(data[,-1], 'first')) <- data$topic 的循环或复杂的 ifelse替换并记住第 2 列 (id2) 已经提供。预期结果应该是:

     [,1] [,2] [,3] [,4] [,5] [,6]
[1,] NA   "B"  NA   NA   NA   NA  
[2,] "C"  NA   NA   NA   NA   NA  
[3,] NA   NA   "D"  NA   NA   NA  
[4,] NA   NA   NA   NA   NA   "E"  
[5,] NA   NA   NA   NA   "A"   NA 

最后，每个主题只分配一次，分配给最喜欢这个主题的人。

Answer 1

我觉得这是经典assignment problem在图论中，您可以使用 igraph 中的 max_bipartite_match 来解决它

---

library(igraph)
library(dplyr)

mat <- data %>%
  select(-topic) %>%
  `row.names<-`(seq(nrow(.))) %>%
  `==`(3)

res <- mat %>%
  graph_from_incidence_matrix() %>%
  set_vertex_attr(name = "type", value = startsWith(names(V(.)), "id")) %>%
  max_bipartite_match() %>%
  pluck("matching") %>%
  subset(startsWith(names(.), "id")) %>%
  stack() %>%
  arrange(as.numeric(values)) %>%
  na.omit() %>%
  as.matrix() %>%
  replace(x = NA * mat, values = data$topic)

这样

> res
  id1 id2 id3 id4 id5 id6
1 NA  "B" NA  NA  NA  NA
2 "C" NA  NA  NA  NA  NA
3 NA  NA  "D" NA  NA  NA
4 NA  NA  NA  NA  NA  "E"
5 NA  NA  NA  "A" NA  NA