R中两个日期之间的总和/计数

hzbexzde 于 2023-04-03 发布在其他

关注(0)|答案(5)|浏览(127)

我有一个包含两列的数据框-一列是开始日期，另一列是结束日期。我需要获取一个包含两列的新数据框-一列是日期，另一列是日期介于开始和结束之间的第一个数据框的观测计数。
具有：

dates<-data.frame("Start"=seq(as.Date("2017/1/1"),by="day", length.out = 5),"End"=seq(as.Date("2017/1/3"),by="day", length.out = 5))

 Start        End
2017-01-01 2017-01-03
2017-01-02 2017-01-04
2017-01-03 2017-01-05
2017-01-04 2017-01-06
2017-01-05 2017-01-07

需求：

Date         Count
2017-01-01     1
2017-01-02     2
2017-01-03     3
2017-01-04     3
2017-01-05     3
2017-01-06     2
2017-01-07     1

我可以使用for循环，但在R中有更好的方法吗？

r

来源：https://stackoverflow.com/questions/57255851/sum-count-between-two-dates-in-r

5条答案

按热度按时间

wh6knrhe1#

这些基本选项避免分组。
第一个选项使用逻辑来避免Map或整形。它是：
1.给予我所有的dates$Start选项
1.与dates$End合并，当两者之间的差异不为0时（即，如果它是相同的日期，我不应该重复计数）。
1.合并dates$Start加上seq_len，其中，再次，之间的差异不是0。

date_diffs <- dates$End - dates$Start
x <- c(dates[['Start']],
  with(subset(dates, subset = date_diffs > 0)
        ,c(End, rep(Start, date_diffs - 1) + sequence(date_diffs-1))
           ))
data.frame(table(x))

第二个选项Vectorize()是seq.Date()函数。然后它只是简单地组合结果。

#or
vec_seq <- Vectorize(seq.Date, , vectorize.args = c("from", "to"), SIMPLIFY = F)
table(do.call(c, vec_seq(dates[['Start']], dates[['End']], 1)))

        Var1 Freq
1 2017-01-01    1
2 2017-01-02    2
3 2017-01-03    3
4 2017-01-04    3
5 2017-01-05    3
6 2017-01-06    2
7 2017-01-07    1

性能：对于@akrun的基本选项，我将table()结果 Package 在data.frame()中，以便每个人都产生某种类型的data.frame。

# The original data set copied to make 1080 rows
Unit: milliseconds
             expr       min         lq       mean     median        uq       max neval
  tmfmnk_complete 1629.3048 1647.52845 1680.82496 1664.07245 1697.4511 1828.4093    20
    tmfmnk_lubrid 6882.1404 6959.20810 7018.69083 7002.27455 7064.0898 7276.2349    20
     M_M_data.tab  103.4166  103.99925  108.33817  107.95715  108.6591  134.9388    20
 Ronak_stack_base  131.0364  134.23370  137.46651  137.32235  141.4388  144.5971    20
      akrun_purrr  133.4917  136.89080  138.92787  138.44575  140.7778  147.4172    20
       akrun_base  130.4179  134.16735  137.21640  136.98225  140.1182  145.8873    20
        cole_base   15.4396   15.60345   16.42558   16.74245   17.1322   17.4201    20
     cole_vec_seq  114.7890  118.44795  130.69493  121.76430  124.0880  309.7418    20
  cole_dt_version   15.9107   15.98035   16.56220   16.11790   17.0216   18.8438    20

#Original data set copied to make  180 rows:

Unit: milliseconds
             expr       min         lq        mean     median         uq       max neval
  tmfmnk_complete  275.6845  279.06390  281.871350  281.95420  284.16025  287.5412    20
    tmfmnk_lubrid 1136.1109 1161.35915 1176.073630 1169.81685 1176.87130 1277.6444    20
     M_M_data.tab   19.0258   19.33070   19.766890   19.45450   19.63410   24.7390    20
 Ronak_stack_base   22.2327   22.56530   23.234095   22.85260   23.20790   27.0589    20
      akrun_purrr   27.8797   28.50225   29.146325   28.71840   29.11915   33.3277    20
       akrun_base   22.3477   22.61135   23.370780   22.81920   23.41300   28.6941    20
        cole_base    3.4258    3.50735    3.642605    3.62470    3.67595    3.9780    20
     cole_vec_seq   19.9366   20.08345   21.359275   20.17250   22.48055   25.7780    20
  cole_dt_version    3.9992    4.09905    4.207690    4.16135    4.28265    4.5052    20

# Original dataset copied to make 30 rows

Unit: milliseconds
             expr      min        lq       mean    median        uq      max neval
  tmfmnk_complete  51.2437  52.16495  54.524465  52.55520  56.19050  66.9461    20
    tmfmnk_lubrid 192.1206 196.99550 198.501640 197.64815 201.42050 203.7031    20
     M_M_data.tab   4.9511   5.05215   5.215670   5.19315   5.33075   5.7740    20
 Ronak_stack_base   4.3609   4.51110   4.995405   4.54885   4.79490   8.8183    20
      akrun_purrr  10.9024  10.96420  11.622235  11.07575  11.58300  15.7751    20
       akrun_base   4.4919   4.55905   4.843730   4.60825   4.73760   8.4334    20
        cole_base   1.4225   1.48635   1.738995   1.58685   1.60780   5.2324    20
     cole_vec_seq   4.0648   4.16095   4.318665   4.24445   4.48420   4.7344    20
  cole_dt_version   1.9733   2.06385   2.132040   2.13965   2.18945   2.3612    20

#Original 5 row dataset

Unit: milliseconds
             expr     min       lq      mean   median       uq     max neval
  tmfmnk_complete 14.7549 14.90780 15.463195 15.10195 15.62030 18.9115    20
    tmfmnk_lubrid 37.2571 37.58240 41.583090 38.18540 40.57435 86.6058    20
     M_M_data.tab  2.6235  2.85145  3.037975  2.90815  2.97045  5.3476    20
 Ronak_stack_base  1.3305  1.38490  1.465170  1.49175  1.53355  1.5978    20
      akrun_purrr  7.7036  7.86260  8.212875  7.98790  8.18055 11.7898    20
       akrun_base  1.4046  1.43715  1.501945  1.51890  1.56545  1.6176    20
        cole_base  1.0560  1.09905  1.169260  1.16010  1.21595  1.3601    20
     cole_vec_seq  1.3547  1.40685  1.452515  1.45645  1.51385  1.5328    20
  cole_dt_version  1.5662  1.70555  1.813365  1.78930  1.84720  2.5267    20

参考代码：

library(data.table)
library(dplyr)
library(purrr)
library(tidyverse)
library(microbenchmark)
library(lubridate)

dates<-data.frame("Start"=seq(as.Date("2017/1/1"),by="day", length.out = 5),"End"=seq(as.Date("2017/1/3"),by="day", length.out = 5))
dates_dt <- as.data.table(dates)

dates <- rbind(dates,dates,dates,dates,dates,dates) #repeat this as many times as you want
dates_dt <- as.data.table(dates)

vec_seq <- Vectorize(seq.Date, , vectorize.args = c("from", "to"), SIMPLIFY = F)

microbenchmark(
  tmfmnk_complete = {
    dates %>%
      rowid_to_column() %>%
      gather(var, Date, -rowid) %>%
      group_by(rowid) %>%
      complete(Date = seq(min(Date), max(Date), by = "1 day")) %>%
      ungroup() %>%
      count(Date)
  }
  , tmfmnk_lubrid = {
    dates %>%
      rowwise() %>%
      mutate(Date = interval(Start, End)/days(1),
             Date = list(Start + days(0:Date))) %>%
      ungroup() %>%
      unnest() %>%
      count(Date)
  }
  , M_M_data.tab = {
    dates_dt[ ,.(Date = seq(Start, End, by = "day")), 
      by = 1:nrow(dates_dt)][,
                          .(count = .N), by = Date]
  }
  , Ronak_stack_base = {
    stack(table(do.call(c, Map(seq, dates$Start, dates$End, by = "1 day"))))
  }
  , akrun_purrr = {
    dates %>%
      transmute(Date = map2(Start, End, seq, by = "1 day")) %>%
      unnest(Date) %>%
      count(Date)
  }
  , akrun_base = {
    lst1 <- do.call(Map, c(f = seq,  unname(dates), by = "1 day"))
    data.frame(table(do.call(c, lst1)))
  }
  , cole_base = {
    date_diffs <- dates$End - dates$Start
    x <- c(dates[['Start']],
           with(subset(dates, subset = date_diffs > 0)
                ,c(End, rep(Start, date_diffs - 1) + sequence(date_diffs-1))
           ))
    data.frame(table(x))
  }
  , cole_vec_seq = {
    data.frame(table(do.call(c, vec_seq(dates[['Start']], dates[['End']], 1))))
  }
  , cole_dt_version = {
    date_diffs <- dates$End - dates$Start
    dates_dt[date_diffs > 0, data.frame(table({diff_sub = End - Start -1; c(dates_dt[['Start']], End, rep(Start, diff_sub) + sequence(diff_sub))}))]
  }
, times = 20
  )

赞(0）回复(0）举报 2023-04-03

yk9xbfzb2#

以下是使用data.table的可能性：

library(data.table)
setDT(dates)[ ,.(Date = seq(Start, End, by = "day")), 
               by = 1:nrow(dates)][,
                                    .(count = .N), by = Date]

#>          Date count
#> 1: 2017-01-01     1
#> 2: 2017-01-02     2
#> 3: 2017-01-03     3
#> 4: 2017-01-04     3
#> 5: 2017-01-05     3
#> 6: 2017-01-06     2
#> 7: 2017-01-07     1

赞(0）回复(0）举报 2023-04-03

mwkjh3gx3#

使用基数R，我们可以在Start和End日期之间创建一个序列，并使用table计算所有日期的频率。

stack(table(do.call(c, Map(seq, dates$Start, dates$End, by = "1 day"))))

#  values        ind
#1      1 2017-01-01
#2      2 2017-01-02
#3      3 2017-01-03
#4      3 2017-01-04
#5      3 2017-01-05
#6      2 2017-01-06
#7      1 2017-01-07

赞(0）回复(0）举报 2023-04-03

bwntbbo34#

涉及dplyr和tidyr的可能性可能是：

dates %>%
 rowid_to_column() %>%
 gather(var, Date, -rowid) %>%
 group_by(rowid) %>%
 complete(Date = seq(min(Date), max(Date), by = "1 day")) %>%
 ungroup() %>%
 count(Date)

  Date           n
  <date>     <int>
1 2017-01-01     1
2 2017-01-02     2
3 2017-01-03     3
4 2017-01-04     3
5 2017-01-05     3
6 2017-01-06     2
7 2017-01-07     1

或者加上lubridate：

dates %>%
 rowwise() %>%
 mutate(Date = interval(Start, End)/days(1),
        Date = list(Start + days(0:Date))) %>%
 ungroup() %>%
 unnest() %>%
 count(Date)

赞(0）回复(0）举报 2023-04-03

mmvthczy5#

一个选项是使用map2获取相应的'Start'，'End'列之间的'Date'序列，unnestlist输出并获取count

library(dplyr)
library(tidyr)
library(purrr)
dates %>%
   transmute(Date = map2(Start, End, seq, by = "1 day")) %>%
   unnest(Date) %>%
   count(Date)
# A tibble: 7 x 2
#  Date           n
#  <date>     <int>
#1 2017-01-01     1
#2 2017-01-02     2
#3 2017-01-03     3
#4 2017-01-04     3
#5 2017-01-05     3
#6 2017-01-06     2
#7 2017-01-07     1

或base R中的选项

lst1 <- do.call(Map, c(f = seq,  unname(dates), by = "1 day"))
table(do.call(c, lst1))

赞(0）回复(0）举报 2023-04-03

我来回答

R中两个日期之间的总和/计数

5条答案

相关问题

热门标签

最新问答