Question

我有一个我正在下载的推文数据库。我想根据他的时间戳为每条推文分配因子。但是，这个问题看起来比我预期的更具挑战性。

我的例子如下：

library(tidyverse)
library(lubridate)

创建边界：

start_time<-ymd_hms("2017-03-09 9:30:00", tz="EST")
end_time<-start_time+days()
start_time<-as.numeric(start_time)
end_time<-as.numeric(end_time)

创建第一个表。此表表示带有推文的表。在我的电脑中，有一天代表大约1M条推文，大约有1700个不同的时间戳：

example_times<-sample(start_time:end_time, 15)
example_table<-as.data.frame(rep(example_times, 200))
example_table$var<-as.character(as.roman(1:dim(example_table)[1]))
colnames(example_table)<-c("unix_ts", "text")
example_table$unix_ts<-as.POSIXct(example_table$unix_ts, origin=origin)

创建第二个表格，从中我需要花费时间和因子应该分配给每个推文。此刻我只有两个课程，但是我希望将来能创造更多课程：

breaks<-c(1489069800, 1489071600, 1489073400, 1489075200, 1489077000, 1489078800, 
          1489080600, 1489082400, 1489084200, 1489086000, 1489087800, 1489089600, 
          1489091400, 1489093200, 1489156200)
classes<-c('DOWN', 'UP', 'UP', 'UP', 'UP', 'DOWN', 'UP', 'UP', 'UP', 'DOWN', 'DOWN', 'DOWN', 'UP', 'DOWN', 'UP')
key<-data.frame(breaks, classes, stringsAsFactors = FALSE)
key$breaks<-as.POSIXct(breaks, origin = origin)
key<-key%>% mutate("intrvl"=interval(lag(breaks), breaks))

我试图解决这个问题看起来像这样：

assign_group<-function(unix_time){
    result<-key %>% 
        filter(unix_time %within% key$intrvl) %>%
        select(classes) %>%
        unlist
    names(result)<-NULL
    return(result)
}
sapply(example_table$unix_ts, assign_group)

这个例子很小，这个解决方案应该在这里工作得非常快，但是当有1M条推文的数据集时它是无法管理的。即使它很大，也只有1500个不同的时间戳，我需要使用assign_group进行分类。能不能给我提供更快的解决方案？

Answer 1

看起来您使用dplyr会导致一些问题。相反，请尝试以下方法：

首先，从key删除第一行（如果可以）。 NA-NA间隔似乎没用（？）。通过key <- key[-1, ]

然后将assign_group函数重写为：

assign_group <- function(unix_time) {
  key[unix_time %within% key$intrvl, "classes"]
}

我喜欢dplyr，但在这种情况下，基础R可能是更好更快的选择。

最后，sapply往往很慢（see this post）。使用purrr中的map_*等其他函数（使用library(tidyverse)获得）。例如，可以尝试map_chr(example_table$unix_ts, assign_group)，或者将一个因子作为新列添加到数据框mutate(example_table, ts_factor = as.factor(map_chr(unix_ts, assign_group)))。

根据R

1 个答案: