Question

对于糟糕的头衔，我很抱歉，但我真的不知道如何简洁地说出来。

我有一个数据框我正在玩四个类别中的任何一个项目，不限于1.这里是我使用的虚拟矩阵的一个例子：

ID <- 1:7
A <- c(1,0,0,1,1,0,0)
B <- c(0,1,0,0,1,0,1)
C <- c(0,0,0,0,0,1,1)
D <- c(1,0,1,1,0,0,0)
A_B <- (A+B > 0)*1
C_D <- (C+D > 0)*1
Cost <- c(25, 52, 11, 75, 45, 5, 34)

df <- data.frame(ID, A, B, C, D, A_B, C_D, A_B_C_D = 1, Cost)
df

ID A B C D A_B C_D A_B_C_D Cost
1  1 0 0 1  1   1     1     25
2  0 1 0 0  1   0     1     52
3  0 0 0 1  0   1     1     11
4  1 0 0 1  1   1     1     75
5  1 1 0 0  1   0     1     45
6  0 0 1 0  0   1     1     5
7  0 1 1 0  1   1     1     34

我需要组织这个数据帧，使得行1包含A，行2 a B，行3 a C，行4 a D，行5和A或B，行6 a C或D，以及第7行剩下的任何东西。我无法使用arrange，因为从desc(A)开始会自动给出1,4,5。此问题的可接受解决方案是：

Order <- c(4, 2, 7, 1, 5, 3, 6)
df[Order,]
df

ID A B C D A_B C_D A_B_C_D Cost
4  1 0 0 1   1   1       1   75
2  0 1 0 0   1   0       1   52
7  0 1 1 0   1   1       1   34
1  1 0 0 1   1   1       1   25
5  1 1 0 0   1   0       1   45
3  0 0 0 1   0   1       1   11
6  0 0 1 0   0   1       1    5

基本上，对角线需要7个直线，但我无法想到如何对其进行编程以便无论数据集如何都能正确排序。我觉得这应该很容易，但我只是没有看到它。转置会让它变得更容易吗？

提前致谢。

Answer 1

一种方法是使用蛮力，通过获得行排列的所有排列和检查哪些满足对角线期望：

z <- apply(permute::allPerms(1:7), 1, function(x){
  mat <- as.matrix(df[,2:8])
  if(all(diag(mat[x,]) == rep(1,7))){
    return(df[x,])
  }
  })

然后你可以删除NULL值：

z <- Filter(Negate(is.null), z)

并获得所有88个解决方案

length(z) #88

z[[5]] #random solution
#output

  ID A B C D A_B C_D A_B_C_D Cost
1  1 1 0 0 1   1   1       1   25
2  2 0 1 0 0   1   0       1   52
6  6 0 0 1 0   0   1       1    5
4  4 1 0 0 1   1   1       1   75
5  5 1 1 0 0   1   0       1   45
3  3 0 0 0 1   0   1       1   11
7  7 0 1 1 0   1   1       1   34

要获得第一个匹配的排列，可以使用while循环：

perms <- permute::allPerms(1:7)
mat <- as.matrix(df[,2:8])
i <- 1
while (!all(diag(mat[perms[i,],])  == rep(1,7))) {
  i = i+1
}

df[perms[i,],]

#  ID A B C D A_B C_D A_B_C_D Cost
1  1 1 0 0 1   1   1       1   25
2  2 0 1 0 0   1   0       1   52
6  6 0 0 1 0   0   1       1    5
3  3 0 0 0 1   0   1       1   11
4  4 1 0 0 1   1   1       1   75
7  7 0 1 1 0   1   1       1   34
5  5 1 1 0 0   1   0       1   45

让我们检查速度：

test <- function(df){
  z <- apply(permute::allPerms(1:7), 1, function(x){
    mat <- as.matrix(df[,2:8])
    if(all(diag(mat[x,]) == rep(1,7))){
      return(df[x,])
    }
  })
  z <- Filter(Negate(is.null), z)
  return(z)
}

test2 <- function(df){
  perms <- permute::allPerms(1:7)
  mat <- as.matrix(df[,2:8])
  i <- 1
  while (!all(diag(mat[perms[i,],])  == rep(1,7))) {
    i = i+1
  }
  df[perms[i,],]
}
microbenchmark::microbenchmark(b <- test(df), 
                           c <- test2(df), times = 10L)

    Unit: milliseconds
           expr       min        lq      mean   median        uq       max neval cld
  b <- test(df) 392.68257 396.81450 412.41600 401.0613 408.15582 509.77693    10   b
 c <- test2(df)  46.11754  46.92276  47.80778  47.3977  48.82543  50.05795    10  a

并非那么糟糕

Answer 2

根据您发布的数据，没有唯一的解决方案，因为第1行和第4行具有相同的A到D列序列。否则，使用四位布尔模式似乎是一种简单的练习。我不明白你为什么要重复位模式1001，除非你在设置示例数据时犯了一个错误。

为了解释为什么我感到困惑，如果第1行和第4行在建议的顺序中颠倒过来，它并不会使对角线全部为1的要求无效，但它显然与以前的顺序不同：

Order2 <- c(1, 2, 7, 4, 5, 3, 6)
df[Order2,]


   ID A B C D A_B C_D A_B_C_D Cost
    1 1 0 0 1   1   1       1   25
    2 0 1 0 0   1   0       1   52
    7 0 1 1 0   1   1       1   34
    4 1 0 0 1   1   1       1   75
    5 1 1 0 0   1   0       1   45
    3 0 0 0 1   0   1       1   11
    6 0 0 1 0   0   1       1    5

如果您不关心这样的排序，可以使用AND和OR组合来确定非唯一解决方案 - 它是使用真值表的练习（或在组合逻辑的应用中，例如使用De Morgan's Theorem）。

以特定方式排列数据框

2 个答案: