r - 反复从矩阵s.t.中删除列和行。行和列最小值的平均值最小

Question

你有一个i乘j矩阵。在本例中，采用以下（非常小）矩阵然而，该算法应该是快速和可扩展的。

values <- c(2,5,3,6,7,
            9,5,4,9,9,
            1,5,4,8,1,
            3,1,5,6,2,
            2,9,4,7,4)
my.mat <- matrix(values, nrow = 5, byrow = TRUE)

目标：迭代地从my.mat中删除行或列，以便根据删除的行和列数最小化平均值（c（apply（my.mat，1，min）、apply（my.mat，2，min））。贪婪地这样做（所以一旦列或行被删除，它就永远不会返回到矩阵）。换句话说，只需删除最小值最大的行或列。以下注意事项适用。
首先，如果删除行或列会更改列或行的最小值（即，如果它们彼此是最小值），则删除（行、列）对。如果一行或一列与多个列或行配对，则迭代删除其他列或行，直到配对为1:1，然后同时删除其余的对。其次，在有联系的地方，随机选择。
输出：一个向量，根据这个目标指示移除的顺序。它既可以引用行/列名，也可以引用单元格值，只要它暗示正确的删除顺序。
所以对于上面的矩阵，正确的答案是…

(Column 4), (Row 2), (Column 3), (Either Row 1 or Row 5), (Row 5 or Row 1), (Column 1 or Column 5), (Row 4 and Column 2), (Column 5 or Column 1 AND Row 3)

然而，实际的实现不应该是不确定的例如，它应该随机选择第5行或第1行，然后在以后的步骤中删除剩余的行（如果合适）。
很容易想象这个问题的解决方法很草率然而，很难想象一个快速的矢量化解决方案。
如果没有列和行不成对的关系，并且没有多个行或列与单个列或行成对的实例，则只需对唯一的行和列最小值进行排序，然后迭代删除最小值等于排序的最小值中第i个值的行和列。但是，当存在关联时，就像在my.mat中一样，这种情况会中断，因为它会不必要地删除不更改相应列或行的最小值的行和列例如，如果一行与两列配对，则它们的最小值都相等，因此这种粗略的算法将删除行和两列，而正确的答案是随机删除其中一列，然后删除其余的列和行。这个问题的一个潜在解决方案是对值进行抖动，以便隐含正确的顺序，但是随着矩阵变大，很难确保抖动不会导致不正确的顺序。
编辑1：解释示例
AndrewMacDonald对这个例子提出了一个问题，所以我来解释一下顺序。
每行和每列的最小值如下所示，其中Ci、Ri是第i列，行。

C4 R2 C3 R1 R5 R3 R4 C1 C2 C5 
 6  4  3  2  2  1  1  1  1  1 

前三步很简单。C4、R2和C3不是其他行或列的最小值，也没有任何关系。所以，步骤1-3…
完整矩阵：

   C1 C2 C3 C4 C5
R1  2  5  3  6  7
R2  9  5  4  9  9
R3  1  5  4  8  1
R4  3  1  5  6  2
R5  2  9  4  7  4

1）拆下C4。

   C1 C2 C3 C5
R1  2  5  3  7
R2  9  5  4  9
R3  1  5  4  1
R4  3  1  5  2
R5  2  9  4  4

2）拆除R2

   C1 C2 C3 C5
R1  2  5  3  7
R3  1  5  4  1
R4  3  1  5  2
R5  2  9  4  4

3）拆除C3

   C1 C2 C5
R1  2  5  7
R3  1  5  1
R4  3  1  2
R5  2  9  4

然后，R1和R5之间有一个平局（两者都至少有2个平局）它们显然不是成对的，也不是任何列的最小值，因此我们可以一次删除一个，而不更改任何其他行或列的最小值。我们在两者之间随机挑选以确定顺序。
4）第1行或第5行（我将任意选择第1行）

   C1 C2 C5
R3  1  5  1
R4  3  1  2
R5  2  9  4

5）第5行或第1行（以步骤4中未选择的为准）

   C1 C2 C5
R3  1  5  1
R4  3  1  2

其余的行和列被绑定为1不能移除R3，因为C1或C5会变得更糟但你可以去掉C1或C5，而不是让R3更糟。同样，你不能在不让另一个更糟的情况下移除r4或c2。所以我们必须同时移除R4和C2。
最后几个步骤是，移除C1或C5中的一个，然后移除其余两对（R4和C2，R3以及C1或C5中的其余两对）。
6）C1或C5（我任意选择C5）

   C1 C2
R3  1  5
R4  3  1

7）R4和C2

   C1 
R3  1 

8）R3和C1或C5的剩余部分

[]

注意：步骤7和8实际上是可以互换的再次，在它们之间随机挑选。

Answer 1

实际上不需要迭代地做任何事情，因为当某个向量被移除时，它的最小值不会改变。因此，我们可以减少这个问题，只考虑行和列的最小值这样可以减少问题的规模，并使解决方案更快、更可扩展
在这个答案中，我使用了dplyr和tidyr，两个用于处理数据的包。
步骤1：生成数据帧
第一步是找出每一行和每一列的最小值，并将它们保存在adata.frame中。可能有更优雅的方法可以做到这一点，但这里有一种方法：

library(dplyr)
library(tidyr)


colmins <- lapply(1:ncol(my.mat),function(s){col <- my.mat[,s,drop = FALSE]
                                             which(col == min(col), arr.ind = TRUE)}
)

cs_pos <- data.frame(name = rep(paste0("c",1:ncol(my.mat)),
                                times = sapply(colmins,nrow)),
                     do.call(rbind,colmins),
                     stringsAsFactors = FALSE)

rowmins <- lapply(1:nrow(my.mat),function(s){row <- my.mat[s,,drop = FALSE]
                                             which(row == min(row), arr.ind = TRUE)}
)

rs_pos <- data.frame(name = rep(paste0("r",1:nrow(my.mat)),
                                times = sapply(rowmins,nrow)),
                     do.call(rbind,rowmins),
                     stringsAsFactors = FALSE)

cs_val <- data.frame(type = "c", name = paste0("c",1:ncol(my.mat)),
                     val = apply(my.mat,2,min),
                     stringsAsFactors = FALSE)

rs_val <- data.frame(type = "r", name = paste0("r",1:ncol(my.mat)),
                     val = apply(my.mat,1,min),
                     stringsAsFactors = FALSE)


cs <- cs_pos %>%
  mutate(col = col + (extract_numeric(name)-1)) %>%
  left_join(cs_val)

rs <- rs_pos %>%
  mutate(row = row + (extract_numeric(name)-1)) %>%
  left_join(rs_val)

my.df <- rbind(cs,rs)

结果是 data.frame每行或列的“最小值”有一行，并有额外的行用于连接：

my.df
   name row col type val
1    c1   3   1    c   1
2    c2   4   2    c   1
3    c3   1   3    c   3
4    c4   1   4    c   6
5    c4   4   4    c   6
6    c5   3   5    c   1
7    r1   1   1    r   2
8    r2   2   3    r   4
9    r3   3   1    r   1
10   r3   3   5    r   1
11   r4   4   2    r   1
12   r5   5   1    r   2

确定最小值的“组”：
这些重复行很重要，因为当它们出现时，我们知道一行或一列要么a）有两个相互相等的最小值，要么b）一行和一列有相同的最小值，要么c）两者都有。
我们可以使用一些方便的函数来定位这些值对：

findpairs <- function(var) xor(duplicated(var,incomparables = NA),
                           duplicated(var,fromLast = TRUE,incomparables = NA))

my.df.dup <- my.df %>%
  mutate(coord = paste(row,col,sep = ",")) %>%
  select(coord,name,type) %>%
  spread(type,name) %>%
  mutate(cdup = findpairs(c),
         rdup = findpairs(r)) %>%
  group_by(coord) %>%
  mutate(nval = sum(!is.na(c),!is.na(r)),
         dup = any(cdup,rdup)) %>%
  mutate(grp = ifelse(nval == 1 & !dup, 1, 0),
         grp = ifelse(nval == 1 & dup, 2, grp),
         grp = ifelse(nval == 2 & !dup, 3, grp),
         grp = ifelse(nval == 2 & dup, 4, grp)) %>%
  arrange(grp) %>%
  select(coord,c,r,grp) 

my.df.dup
  coord  c  r grp
1   1,1 NA r1   1
2   1,3 c3 NA   1
3   2,3 NA r2   1
4   5,1 NA r5   1
5   1,4 c4 NA   2
6   4,4 c4 NA   2
7   4,2 c2 r4   3
8   3,1 c1 r3   4
9   3,5 c5 r3   4

my.df.dup在矩阵中每个位置有一行最小值两列 c和 r分别包含列和行的名称，此位置的值是最小值请注意，目前我们考虑的是最小值之间的关系，而不是它们的实际值。
grp列很方便——根据它们是否“共享”，确定可分为四类的最小值：

## nval = 1, dup = FALSE : unique minima
## nval = 1, dup = TRUE  : duplicated minima, unshared
## nval = 2, dup = FALSE : a row-column pair
## nval = 2, dup = TRUE  : >=2 columns share minima with a row (or vice-versa)

根据上述步骤6至8，只有 grp = 4中的最小值需要“拆分”为了简单（和快速），我将它们与主数据分开，编辑，然后替换：

my.df.not4 <- my.df.dup %>%
  filter(grp != 4) %>%
  ungroup %>%
  filter(!(grp == 2 & duplicated(c)))

my.df.4 <- my.df.dup %>% 
  ungroup %>%
  filter(grp == 4) %>%
  group_by(c) %>%
  mutate(c_new = ifelse(sample(!duplicated(c)),c,NA)) %>%
  ungroup %>%
  group_by(r) %>%
  mutate(r_new = ifelse(sample(!duplicated(r)),r,NA)) %>%
  ungroup %>%
  select(coord, c = c_new, r = r_new)

对 mutate的最后调用将所有重复的值替换为“na”；这是我对上面步骤6-8的解释。如果minima有时跨列共享，有时跨行共享，我不确定这将如何工作YMMV公司。
两个数据帧：names和minima
最后，我们将上面的答案转换为两个数据帧：一个minima“名称”（实际上是删除的行和列）和一个实际minima。后者给出移除顺序，前者给出应移除的组：

my.df.names <- rbind(my.df.not4,my.df.4) %>% 
  gather(type,name,c:r,na.rm = TRUE) %>%
  group_by(coord) %>%
  mutate(size = n(),
         name = ifelse(size == 2, paste(name,collapse = ","), name)) %>%
  select(coord,name) %>%
  ungroup

my.df.mins <- my.df %>%
  mutate(coord = paste(row,col,sep = ",")) %>%
  select(coord,val) %>%
  arrange(val %>% desc) %>%
  ungroup


my.df.names
   coord  name
1    1,3    c3
2    1,4    c4
3    4,2 c2,r4
4    3,1    c1
5    3,5 c5,r3
6    1,1    r1
7    2,3    r2
8    5,1    r5
9    4,2 c2,r4
10   3,5 c5,r3

my.df.mins
   coord val
1    1,4   6
2    4,4   6
3    2,3   4
4    1,3   3
5    1,1   2
6    5,1   2
7    3,1   1
8    4,2   1
9    3,5   1
10   3,1   1
11   3,5   1
12   4,2   1

最后一步很简单：合并两个数据帧，按 val排序，并返回要删除的行或列的名称。如果要随机断开领带，只需在 sample()的每个唯一值中使用 val：

output <- left_join(data.frame(my.df.names),my.df.mins) %>%
  unique %>%
  arrange(desc(val)) %>%
  group_by(val) %>%
  mutate(namesamp = sample(name))

output$namesamp
"c4"    "r2"    "c3"    "r1"    "r5"    "c5,r3" "c1"    "c2,r4"