r语言 - 迭代地从矩阵s.t中删除列和行,使行和列的最小值的平均值最小化



你有一个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)

目标:迭代地从我的。这意味着(c)(适用于)(i)。1,分钟),应用(我的)。Mat, 2, min)())是最小的给定删除的行和列的数量。这样做是贪婪的(因此,一旦删除了一列或一行,它就永远不会返回到矩阵中)。换句话说,只需删除具有最大最小值的行或列。以下注意事项适用。

首先,如果删除一行或列改变了列或行的最小值(即,如果它们彼此都是最小值),则删除(行、列)对。如果一行或列与多个列或行配对,则迭代地删除额外的列或行,直到配对为1:1,然后同时删除剩余的对。第二,在有平局的地方,随机选择。

Output:表示根据该目标的移除顺序的向量。它既可以引用行/列名,也可以引用单元格值,只要它意味着正确的删除顺序。

对于上面的矩阵,正确的答案是…

(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的行和列。然而,当有领带的时候,就像在我的。但是,这会中断,因为它会不必要地删除不改变相应列或行的最小值的行和列。例如,如果一行与两列配对,它们都有相等的最小值,所以这个粗略的算法会删除这一行和两列,而正确的答案是随机删除其中一列,然后删除剩下的列和行。这个问题的一个可能的解决方案是抖动值,这样就隐含了正确的排序,但是随着矩阵变大,很难确保抖动不会导致错误的排序。

EDIT 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实际上是可以互换的。同样,在它们之间随机选择。

实际上不需要迭代地做任何事情,因为当删除某些内容时,向量的最小值不会改变。因此,我们可以简化这个问题,只考虑行和列的最小值。这样可以减少问题的规模,并使解决方案更快,可扩展

在整个回答中,我使用dplyrtidyr,两个用于操作数据的包。

步骤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对于矩阵中具有最小值的每个位置都有一行。cr这两列分别保存了当前位置值为最小值的列名和行名。注意,现在我们考虑的是最小值之间的关系,而不是它们的实际值。

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 .

两个数据框:names和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排序,并返回将要删除的行或列的名称。如果您想随机地打破联系,您可以简单地在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"

最新更新