以特定方式排列数据框

Question

抱歉标题不好，但我真的不知道如何简洁地用词。

我有一个我正在使用的数据框，其中一个项目可以属于 4 个类别中的任何一个，不限于 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 行包含 B，第 3 行包含 C，第 4 行包含 D，第 5 行包含 A 或 B，第 6 行包含 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)。