【问题标题】:Subset a data frame based on column entry (or rank)根据列条目(或排名)对数据框进行子集
【发布时间】:2011-08-13 21:34:50
【问题描述】:

我有一个和这个一样简单的data.frame:

id group idu  value
1  1     1_1  34
2  1     2_1  23
3  1     3_1  67
4  2     4_2  6
5  2     5_2  24
6  2     6_2  45
1  3     1_3  34
2  3     2_3  67
3  3     3_3  76

我想从其中检索包含每个组的第一个条目的子集;类似:

id group idu value
1  1     1_1 34
4  2     4_2 6
1  3     1_3 34

id 不是唯一的,因此方法不应依赖它。

我可以避免循环吗?

dput()的数据:

structure(list(id = c(1L, 2L, 3L, 4L, 5L, 6L, 1L, 2L, 3L), group = c(1L, 
1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L), idu = structure(c(1L, 3L, 5L, 
7L, 8L, 9L, 2L, 4L, 6L), .Label = c("1_1", "1_3", "2_1", "2_3", 
"3_1", "3_3", "4_2", "5_2", "6_2"), class = "factor"), value = c(34L, 
23L, 67L, 6L, 24L, 45L, 34L, 67L, 76L)), .Names = c("id", "group", 
"idu", "value"), class = "data.frame", row.names = c(NA, -9L))

【问题讨论】:

    标签: r subset


    【解决方案1】:

    使用加文的百万行df:

    DF3 <- data.frame(id = sample(1000, 1000000, replace = TRUE),
                      group = factor(rep(1:1000, each = 1000)),
                      value = runif(1000000))
    DF3 <- within(DF3, idu <- factor(paste(id, group, sep = "_")))
    

    我认为最快的方法是重新排序数据框,然后使用duplicated

    system.time({
      DF4 <- DF3[order(DF3$group), ]
      out2 <- DF4[!duplicated(DF4$group), ]
    })
    # user  system elapsed 
    # 0.335   0.107   0.441
    

    相比之下,在我的计算机上 Gavin 的 fastet lapply + split 方法需要 7 秒。

    通常,在处理数据帧时,最快的方法通常是生成所有索引,然后生成单个子集。

    【讨论】:

    • 这是一个不错的方法,但是要添加一个额外的注释,真实数据也可能重复组代码,这需要一个额外的步骤:向整个数据集添加一个真实的单个 groupID,可能基于时间戳列
    • 为什么 !duplicated 返回重复组的第一个值?
    • @zach 如果您阅读了duplicated 的帮助,您会发现它实际上是“重复”的一个非常具体的定义——“具有较小下标的元素的重复”。因此,第一次遇到组 ID 时,R 只查看它处理过的先前记录,而不是前面的任何重复记录。所以它返回 FALSE,这是 Hadley 的倒置。
    【解决方案2】:

    根据 OP 的评论进行更新

    如果在超过百万行上执行此操作,那么提供的所有选项都会很慢。以下是 100,000 行的虚拟数据集的一些比较时间:

    set.seed(12)
    DF3 <- data.frame(id = sample(1000, 100000, replace = TRUE),
                      group = factor(rep(1:100, each = 1000)),
                      value = runif(100000))
    DF3 <- within(DF3, idu <- factor(paste(id, group, sep = "_")))
    
    > system.time(out1 <- do.call(rbind, lapply(split(DF3, DF3["group"]), `[`, 1, )))
       user  system elapsed 
     19.594   0.053  19.984 
    > system.time(out3 <- aggregate(DF3[,-2], DF3["group"], function (x) x[1]))
       user  system elapsed 
     12.419   0.141  12.788 
    

    我放弃了一百万行。不管你信不信,更快的是:

    out2 <- matrix(unlist(lapply(split(DF3[, -4], DF3["group"]), `[`, 1,)),
                   byrow = TRUE, nrow = (lev <- length(levels(DF3$group))))
    colnames(out2) <- names(DF3)[-4]
    rownames(out2) <- seq_len(lev)
    out2 <- as.data.frame(out2)
    out2$group <- factor(out2$group)
    out2$idu <- factor(paste(out2$id, out2$group, sep = "_"),
                       levels = levels(DF3$idu))
    

    输出(实际上)相同:

    > all.equal(out1, out2)
    [1] TRUE
    > all.equal(out1, out3[, c(2,1,3,4)])
    [1] "Attributes: < Component 2: Modes: character, numeric >"              
    [2] "Attributes: < Component 2: target is character, current is numeric >"
    

    out1(或out2)和out3aggregate() 版本)之间的区别仅在于组件的行名。)

    时间安排为:

       user  system elapsed 
      0.163   0.001   0.168
    

    关于 100,000 行问题,以及关于这百万行问题:

    set.seed(12)
    DF3 <- data.frame(id = sample(1000, 1000000, replace = TRUE),
                      group = factor(rep(1:1000, each = 1000)),
                      value = runif(1000000))
    DF3 <- within(DF3, idu <- factor(paste(id, group, sep = "_")))
    

    时间安排

       user  system elapsed 
     11.916   0.000  11.925
    

    使用矩阵版本(产生out2)比其他版本处理 100,000 行问题更快地处理百万行。这只是表明使用矩阵确实非常快,而我的do.call() 版本的瓶颈是rbind()-将结果放在一起。

    百万行问题的计时完成了:

    system.time({out4 <- matrix(unlist(lapply(split(DF3[, -4], DF3["group"]),
                                              `[`, 1,)),
                                byrow = TRUE,
                                nrow = (lev <- length(levels(DF3$group))))
                 colnames(out4) <- names(DF3)[-4]
                 rownames(out4) <- seq_len(lev)
                 out4 <- as.data.frame(out4)
                 out4$group <- factor(out4$group)
                 out4$idu <- factor(paste(out4$id, out4$group, sep = "_"),
                                    levels = levels(DF3$idu))})
    

    原创

    如果你的数据在DF,比如说,那么:

    do.call(rbind, lapply(with(DF, split(DF, group)), head, 1))
    

    会做你想做的:

    > do.call(rbind, lapply(with(DF, split(DF, group)), head, 1))
      idu group
    1   1     1
    2   4     2
    3   7     3
    

    如果新数据在DF2,那么我们得到:

    > do.call(rbind, lapply(with(DF2, split(DF2, group)), head, 1))
      id group idu value
    1  1     1 1_1    34
    2  4     2 4_2     6
    3  1     3 1_3    34
    

    但是为了速度,我们可能想要子集而不是使用head(),并且我们可以通过不使用with()获得一点好处,例如:

    do.call(rbind, lapply(split(DF2, DF2$group), `[`, 1, ))
    
    > system.time(replicate(1000, do.call(rbind, lapply(split(DF2, DF2$group), `[`, 1, ))))
       user  system elapsed 
      3.847   0.040   4.044
    > system.time(replicate(1000, do.call(rbind, lapply(split(DF2, DF2$group), head, 1))))
       user  system elapsed 
      4.058   0.038   4.111
    > system.time(replicate(1000, aggregate(DF2[,-2], DF2["group"], function (x) x[1])))
       user  system elapsed 
      3.902   0.042   4.106
    

    【讨论】:

    • 似乎对加文有用。我编辑了这个问题的内容,但可能不会受到影响。我必须用 200 万行 data.frame 测试它的性能。
    • @Paulo 我已经更新了答案,并在此数据集合上重复运行了一些比较时间。
    • @Paulo Cardosa 我对一个大问题做了一些计时,所有选项都很慢,所以我提供了一个可以使用矩阵并且速度更快的版本。包括一百万行问题的计时。
    • 信息丰富的加文。我将尝试使用真实数据来查看当 DF 也有更多列时它的行为。所有这些都至关重要,因为我有一个 2000 万行的对象要处理,任何时间节省都会对最终计算产生巨大影响。
    • 一个额外的要求是保留 only 匹配 nrows 选择约束的条目(匹配标准的 DF2$group 条目)。代码可以容纳这个吗?
    【解决方案3】:

    使用plyr 的一种解决方案,假设您的数据位于名为zzz 的对象中:

    ddply(zzz, "group", function(x) x[1 ,])
    

    另一个选择行之间的差异并且应该证明更快,但依赖于事先订购的对象。这还假设您的组值不为 0:

    zzz <- zzz[order(zzz$group) ,]
    
    zzz[ diff(c(0,zzz$group)) != 0, ]
    

    【讨论】:

      【解决方案4】:

      我认为这样可以解决问题:

      aggregate(data["idu"], data["group"], function (x) x[1])
      

      对于您更新的问题,我建议使用plyr 包中的ddply

      ddply(data, .(group), function (x) x[1,])
      

      【讨论】:

        猜你喜欢
        • 1970-01-01
        • 2013-08-15
        • 1970-01-01
        • 2016-10-28
        • 1970-01-01
        • 2022-06-18
        • 2016-09-10
        • 2022-11-18
        • 1970-01-01
        相关资源
        最近更新 更多