8

我正在尝试根据值的出现来获取数据框的子集。这在下面给出的示例中得到了最好的解释。这个问题与以下内容密切相关：为 R 中数据名列中列的每个唯一值选择前有限行数 但是，我想改变 head() 命令选择的项目数。

#Sample data
input <- matrix( c(1000001,1000001,1000001,1000001,1000001,1000001,1000002,1000002,1000002,1000003,1000003,1000003,100001,100002,100003,100004,100005,100006,100002,100003,100007,100002,100003,100008,"2011-01-01","2011-01-02","2011-01-01","2011-01-04","2011-01-01","2011-01-02","2011-01-01","2011-01-04","2011-01-01","2011-01-02","2011-01-01","2011-01-04"), ncol=3)
colnames(input) <- c( "Product" , "Something" ,"Date")
input <- as.data.frame(input)
input$Date <- as.Date(input[,"Date"], "%Y-%m-%d")

#Sort based on date, I want to leave out the entries with the oldest dates.
input <- input[ with( input, order(Date)), ]

#Create number of items I want to select
table_input <- as.data.frame(table(input$Product))
table_input$twentyfive <- ceiling( table_input$Freq*0.25  )

#This next part is a very time consuming method (Have 2 mln rows, 90k different products)

first <- TRUE

for( i in table_input$Var1 ) {
  data_selected <- input[input$Product == i,]
  number <- table_input[table_input$Var1 == i ,]$twentyfive

  head <- head( data_selected, number)        

  if( first == FALSE) {
    output <- rbind(output, head)
  } else {
    output <- head
  }
  first <- FALSE
}

希望有人知道更好，更有效的方法。我尝试使用此处答案中的拆分函数：为 R 中数据名列中的每个唯一值选择顶部有限行数以拆分产品，然后尝试迭代它们并选择 head()。但是 split 函数总是耗尽内存（无法分配..）

input_split <- split(input, input$Product) #Works here, but not i my problem.

所以最后我的问题是我希望选择不同数量的每个独特产品。所以这里有 1000001 的 2 个项目和 1000002 和 1000003 的 1 个项目。

4

2 回答 2

10

我想到了两个解决方案。plyr::ddply专为您的需求而设计，但使用 adata.table会更快。

您想将其data.frame拆分为块，删除按日期排序的每个块的所有底部 25% 的行，然后重新组合成data.frame. 这可以通过一条简单的线来完成......

require( plyr )
ddply( input , .(Product) , function(x) x[ - c( 1 : ceiling( nrow(x) * 0.25 ) ) , ] )
#  Product Something       Date
#1 1000001    100005 2011-01-01
#2 1000001    100002 2011-01-02
#3 1000001    100006 2011-01-02
#4 1000001    100004 2011-01-04
#5 1000002    100007 2011-01-01
#6 1000002    100003 2011-01-04
#7 1000003    100002 2011-01-02
#8 1000003    100008 2011-01-04

data.table解决方案

因为data.table您将需要最新的开发版本r-forge（由于我们尚未在 data.table 的 CRAN 版本中实现负下标）。确保您按照install.package呼叫获取最新版本...

install.packages( "data.table" , repos="http://r-forge.r-project.org" )
require( data.table )
DT <- data.table( input )

#  Sort by Product then Date very quickly
setkeyv( DT , c( "Product" , "Date" ) )

#  Return the bottom 75% of rows (i.e. not the earliest)
DT[ ,  tail( .SD , -ceiling( nrow(.SD) * .25 ) )  , by = Product ] 
#   Product Something       Date
#1: 1000001    100005 2011-01-01
#2: 1000001    100002 2011-01-02
#3: 1000001    100006 2011-01-02
#4: 1000001    100004 2011-01-04
#5: 1000002    100007 2011-01-01
#6: 1000002    100003 2011-01-04
#7: 1000003    100002 2011-01-02
#8: 1000003    100008 2011-01-04

更好的使用方式data.table

你可以更容易地做到这一点（所以你不需要开发版本data.table）......

DT[ ,  .SD[ -c( 1:ceiling( .25 * .N ) ) ] , by = Product ]

您也可以lapply在j参数中使用（我担心我使用），这在2e6 行中的 90,000 个产品（组）.SD上运行约 14 秒...data.table

set.seed(1)
Product <- sample( 1:9e5 , 2e6 , repl = TRUE )
dates <- sample( 1:20 , 2e6 , repl = TRUE )
Date <- as.Date( Sys.Date() + dates )
DT <- data.table( Product = Product , Date = Date )

system.time( { setkeyv( DT , c( "Product" , "Date" ) ); DT[ , lapply( .SD , `[` ,  -c( 1:ceiling( .25 * .N ) ) ) , by = Product ] } )
#   user  system elapsed 
#  14.65    0.03   14.74

更新：最好的使用方法data.table！

所以感谢@Arun（他现在是data.table包的作者），我们现在有了最好的使用方法data.table是使用.I它是所有行索引的整数向量，[通过删除前 25% 的记录来作为子集-(1:ceiling(.N*.25))，然后使用这些行索引执行子集以获得最终表。这比使用我.SD上面的方法快 4-5 倍。惊人的东西！

system.time( DT[ DT[, .I[-(1:ceiling(.N*.25))] , by = Product]$V1] )
   user  system elapsed 
   3.02    0.00    3.03
于 2013-10-17T11:49:40.357 回答
2

这是一种使用mapplyand your inputand的方法table_input：

    #your code
    #input <- matrix( c(1000001,1000001,1000001,1000001,1000001,1000001,1000002,1000002,1000002,1000003,1000003,1000003,100001,100002,100003,100004,100005,100006,100002,100003,100007,100002,100003,100008,"2011-01-01","2011-01-02","2011-01-01","2011-01-04","2011-01-01","2011-01-02","2011-01-01","2011-01-04","2011-01-01","2011-01-02","2011-01-01","2011-01-04"), ncol=3)
    #colnames(input) <- c( "Product" , "Something" ,"Date")
    #input <- as.data.frame(input)
    #input$Date <- as.Date(input[,"Date"], "%Y-%m-%d")

    #Sort based on date, I want to leave out the entries with the oldest dates.
    #input <- input[ with( input, order(Date)), ]

    #Create number of items I want to select
    #table_input <- as.data.frame(table(input$Product))
    #table_input$twentyfive <- ceiling( table_input$Freq*0.25  )

    #function to "mapply" on "table_input"
    fun = function(p, d) { grep(p, input$Product)[1:d] }

    #subset "input"
    input[unlist(mapply(fun, table_input$Var1, table_input$twentyfive)),]

       Product Something       Date
    1  1000001    100001 2011-01-01
    3  1000001    100003 2011-01-01
    7  1000002    100002 2011-01-01
    11 1000003    100003 2011-01-01

我也调用system.time并replicate比较mapply了 SimonO101 的答案的速度和替代方案：

    #SimonO101's code
    #require( plyr )
    #ddply( input , .(Product) , function(x) x[ - c( 1 : ceiling( nrow(x) * 0.25 ) ) , ] )
    #install.packages( "data.table" , repos="http://r-forge.r-project.org" )
    #require( data.table )
    #DT <- data.table( input )
    #setkeyv( DT , c( "Product" , "Date" ) )
    #DT[ ,  tail( .SD , -ceiling( nrow(.SD) * .25 ) )  , by = Product ]

    > system.time(replicate(10000, input[unlist(mapply(fun, table_input$Var1, table_input$twentyfive)),]))
       user  system elapsed 
       5.29    0.00    5.29 
    > system.time(replicate(10000, ddply( input , .(Product) , function(x) x[ - c( 1 : ceiling( nrow(x) * 0.25 ) ) , ] )))
      user  system elapsed 
      43.48    0.03   44.04 
    > system.time(replicate(10000,  DT[ ,  tail( .SD , -ceiling( nrow(.SD) * .25 ) )  , by = Product ] ))                        
      user  system elapsed 
      34.30    0.01   34.50

但是：SimonO101 的替代品不会产生相同的mapply效果，因为我mapply使用了table_input您发布的内容；我不知道这是否在比较中起作用。另外，比较可能是我愚蠢地设置的。我只是因为你指出的速度问题才这样做。我真的希望@SimonO101 看到这个，以防我在胡说八道。

于 2013-10-17T14:17:49.627 回答