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))

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

类型1的百分比为0，即

类型1 = 0
类型2＆gt; 0＆amp; ＆LT; 10
类型3＆gt; 9＆amp; ＆LT; 20
类型4＆gt; 19＆amp; ＆LT; 30
类型5＆gt; 29＆amp; ＆LT; 40
类型6＆gt; 39＆amp; ＆LT; 50
类型7＆gt; 49

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

G1 =仅T7
G2 =仅T7＆amp; T2-T6
G3 =仅T2-T6
G4 =至少一个T1，＆amp;一个T2-T6，＆amp;一个T7（=全部）
G5 =仅T7＆amp; T1
G6 =仅T2-T6＆amp; 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)

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

1 个答案: