以特定方式排列数据框

提前抱歉，标题不好，但我真的不知道如何简洁地表达它。

我正在使用一个数据框，其中的项目可以属于 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 条直线，但我想不出如何对其进行编程以正确排序，无论数据集如何。我觉得这应该很容易，但我只是没有看到。换位思考会不会更容易？

提前致谢。

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

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 

没那么糟糕