迭代地从矩阵 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 中删除行或列，使得 mean(c(apply(my.mat, 1, min), apply(my.mat, 2, min)))给定删除的行数和列数，最小化。贪婪地这样做（所以一旦删除一列或一行，它就永远不会返回到矩阵）。换句话说，只需删除具有最大最小值的行或列。以下注意事项适用。

首先，如果删除行或列会更改列或行的最小值（即，如果它们彼此都是最小值），请删除 (row, column) 对。如果一行或一列与多列或多行配对，则迭代删除额外的列或行，直到配对为 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 步：制作数据帧

第一步是找到每一行和每一列的最小值，并将它们保存在data.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)

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

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 的解释。 我不确定如果最小值有时跨列共享，有时跨行共享，这将如何工作。 YMMV。

两个数据框：名称和最小值

最后，我们将上面的答案转换为两个数据框：一个是最小值“名称”（实际上是删除的行和列），另一个是实际最小值。后者给出了移除的顺序，前者给出了应该移除的组：

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 排序，并返回将被删除的行或列的名称。如果你想随机打破平局，你可以简单地在val的每个唯一值中使用sample()：

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"