根据数据框中的条件为每组创建一个新列

Question

虽然我搜索了很长时间的解决方案，例如 Assign value to group based on condition in column

我无法解决以下问题，非常感谢任何帮助！

我有以下数据框（实际上，有数千行）：

df <- data.frame(ID1 = c(1,1,1,2,2,2,2,3,3,4,4,4,5,5,5,6,6,6,7,7), 
             ID2 = c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20), 
             Percentage = c(0,10,NA,65,79,81,52,0,0,11,12,35,0,24,89,76,0,NA,59,16), 
             Group_expected_result = c(6,6,6,7,7,7,7,1,1,3,3,3,4,4,4,5,5,5,2,2))

我要做的是为每个组分配一个从 1 到 7 的组类型，如 ID1 所示。应该分配哪种组类型取决于第 3 列的条件，百分比（可以具有从 0 到 100 的值）并分为七种类型：

类型 1 的百分比为 0，即

• 类型 1 = 0
• 类型 2 > 0 &
• 类型 3 > 9 &
• 类型 4 > 19 &
• 类型 5 > 29 &
• 类型 6 > 39 &
• 类型 7 > 49

这些类型的组合（上）定义了下面的组类型（G1-G7）：

• G1 = 仅 T7
• G2 = 仅 T7 和 T2-T6
• G3 = 仅 T2-T6
• G4 = 至少一个 T1、一个 T2-T6 和一个 T7（= 全部）
• G5 = 仅 T7 和 T1
• G6 = 仅 T2-T6 和 T1
• G7 = 仅 T1

预期结果在样本数据框的最后一列，例如 第一组由类型 T1 和 T2 组成，因此应该是组类型 G6。

那么，问题是如何在最后一列中得到预期的结果？我希望我把问题说清楚了！提前致谢！

Answer 1

试试这个：

myType <- function(x) {
    if (is.na(x) || x==0) {
        return(1L)
    } else if (x < 50) {
        return(2L)
    } else {
        return(3L)
    }
}

myGroup <- function(myDf) {
    myIds <- unique(myDf$ID1)
    myGs <- list(G1=1L, G2=2:3, G3=2L, G4=1:3, G5=c(1L,3L), G6=1:2, G7=3L)
    assignG <- vector(mode = "integer", length=nrow(myDf))
    vT <- vapply(myDf[,"Percentage"], function(x) myType(x), 1L)

    for (i in myIds) {
        myV <- which(myDf[,1L]==i)
        testV <- sort(unique(vT[myV]))
        assignG[myV] <- which(vapply(myGs, function(x) identical(x,testV), TRUE, USE.NAMES = FALSE))
    }

    myDf$myResult <- assignG
    myDf
}

调用它，我们得到：

myGroup(df,7)
   ID1 ID2 Percentage Group_expected_result myResult
1    1   1          0                     6        6
2    1   2         10                     6        6
3    1   3         NA                     6        6
4    2   4         65                     7        7
5    2   5         79                     7        7
6    2   6         81                     7        7
7    2   7         52                     7        7
8    3   8          0                     1        1
9    3   9          0                     1        1
10   4  10         11                     3        3
11   4  11         12                     3        3
12   4  12         35                     3        3
13   5  13          0                     4        4
14   5  14         24                     4        4
15   5  15         89                     4        4
16   6  16         76                     5        5
17   6  17          0                     5        5
18   6  18         NA                     5        5
19   7  19         59                     2        2
20   7  20         16                     2        2

这是一个不太直观但更有效的解决方案。

myGroup2 <- function(myDf) {
    myIds <- unique(myDf$ID1)
    AltGs <- c(G1=2L, G2=7L, G3=3L, G4=9L, G5=6L, G6=5L, G7=4L)
    assignG <- vector(mode = "integer", length=nrow(myDf))
    vT <- vapply(myDf[,"Percentage"], function(x) myType(x), 1L)

    for (i in myIds) {
        myV <- which(myDf[,1L]==i)
        testV <- unique(vT[myV])
        assignG[myV] <- which(AltGs==(length(testV)+sum(testV)))
    }

    myDf$myResult <- assignG
    myDf
}

速度大约是原来的两倍。

microbenchmark(t1=myGroup(df,7), t2=myGroup2(df,7))
Unit: microseconds
 expr     min      lq     mean   median      uq      max neval
   t1 692.117 728.4470 779.6459 748.562 819.170 1018.060   100
   t2 320.608 340.3115 390.7098 351.395 414.203 1781.195   100

您可以通过运行以下命令获得上面的AltGs：

myGs <- list(G1=1L, G2=2:3, G3=2L, G4=1:3, G5=c(1L,3L), G6=1:2, G7=3L)
AltGs <- vapply(myGs, function(x) length(x)+sum(x), 2L, USE.NAMES = FALSE)