Question

我需要帮助计算给定日期范围内的天数。这是我的数据集：

dat<- data.frame(a=c(seq(as.Date("2018-01-01"), as.Date("2018-01-3"), 1),
                 seq(as.Date("2018-01-08"), as.Date("2018-01-10"), 1),
                 seq(as.Date("2018-01-23"), as.Date("2018-01-31"), 1),
                 seq(as.Date("2018-03-01"), as.Date("2018-03-05"), 1)), 
             b= c(rep("x",5), rep("y",5), rep("x",5), rep("y",5)) )



        a     b
1  2018-01-01 x
2  2018-01-02 x
3  2018-01-03 x
4  2018-01-08 x
5  2018-01-09 x
6  2018-01-10 y
7  2018-01-23 y
8  2018-01-24 y
9  2018-01-25 y
10 2018-01-26 y
11 2018-01-27 x
12 2018-01-28 x
13 2018-01-29 x
14 2018-01-30 x
15 2018-01-31 x
16 2018-03-01 y
17 2018-03-02 y
18 2018-03-03 y
19 2018-03-04 y
20 2018-03-05 y

这是从船舶收到的报告，“ x”和“ y”是不同类型的燃料。 1月1日和1月3日，船舶报告使用的是“ x”型燃料。然后，该船在1月4日，5日，6日和7日未报告任何内容。该船在8月8日（这是1月4日，5日，6日，7日和8日的合并报告）发送了另一则报告，称其仍在使用燃料输入“ x”。如果船舶将燃料类型更改为“ y”，它将发送报告。

我想计算燃料类型为“ x”的天数和燃料类型为“ y”的天数。如果日期之间有间隔，例如

1  2018-01-01 x
2  2018-01-02 x
3  2018-01-03 x
4  2018-01-08 x
5  2018-01-09 x

则第一行和第五行之间的天数应为8天（09 /一月-01 /一月）。因此，“ x”的计数是8天然后，它应该计算b列中的下一个计数器“ y”。

6  2018-01-10 y
7  2018-01-23 y
8  2018-01-24 y
9  2018-01-25 y
10 2018-01-26 y

此处的差异为16天（1月26日至1月10日）。因此，“ y”的计数是16天。

然后我们又有了“ x”：

11 2018-01-27 x
12 2018-01-28 x
13 2018-01-29 x
14 2018-01-30 x
15 2018-01-31 x

在这里，“ x”的计数为4天（1月31日至1月27日）。因此，“ x”的总数为（8 + 4）= 12天。而且我们对“ y”的计数也类似。

16 2018-03-01 y
17 2018-03-02 y
18 2018-03-03 y
19 2018-03-04 y
20 2018-03-05 y

这就是陷阱。船在二月份没有报告任何东西。由于上次报告的燃料类型使用为“ x”（在1月31日报告），这意味着整个2月，船舶使用的燃料类型为“ x”，因此我们需要在“ x”中添加2月的28天，（8 + 4 + 28）= 40天

“ y”计数为（16 + 4）= 21天

我似乎无法理解如何编写逻辑代码。任何帮助将不胜感激。

Answer 1

data.table方法

library(data.table)
#create sample data
dt1 <- setDT(dat)
#create a data.table with one row for each day within the range of dt1
dt2 <- data.table( a = seq( min( dt1$a ), max( dt1$a), by = "days") )

#perform rolling join to get the last 'b' from dt1 on all dates in dt2
dt2[, b := dt1[dt2, b, on = "a", roll = TRUE]][]
#summarise by b (number of rows = number of days, so we can use .N)
dt2[, (days = .N), by = "b"]
#    b  N
# 1: x 42
# 2: y 22

Answer 2

在dplyr的注释中使用Jon Spring的方法：

dat %>% mutate(days_to_next = lead(a) - a) %>% 
  group_by(b) %>% 
  summarise(N = sum(days_to_next, na.rm = TRUE))

编辑：我们也可以在循环的同时做旧学校。这实际上是我在看到@JonSpring答案之前的第一个想法。无论如何，我惊讶地发现while循环在比较中的表现相对不错！

library(data.table)
library(dplyr)
library(microbenchmark)

dat<- data.frame(a=c(seq(as.Date("2018-01-01"), as.Date("2018-01-3"), 1),
                     seq(as.Date("2018-01-08"), as.Date("2018-01-10"), 1),
                     seq(as.Date("2018-01-23"), as.Date("2018-01-31"), 1),
                     seq(as.Date("2018-03-01"), as.Date("2018-03-05"), 1)), 
                 b= c(rep("x",5), rep("y",5), rep("x",5), rep("y",5)) )

dat <- arrange(dat, a) # make sure data is arranged from oldest to most recent !
while_loop <- function(dat){ 
  ## @IsmailMüller
  i <- 1 # initialize for the while loop
  counts <- c("x"=0,"y"=0) # intilise counts
  while(i < nrow(dat)){
  # what's the fuel on this position ?
  fuel <- dat$b[i]
  # what's the date on this position ?
  date_this_fuel <- dat$a[i]

  # find next observation with different fuel !
  if(any(dat$b[i:nrow(dat) ] != fuel) ){ # Need to ensure that we have different fuels left in the remaining data
    other_fuel_position <- i-1 + min(which( dat$b[i:nrow(dat) ] != fuel)) # find the next position where the fuel is different of what we have in i
  } else {
    other_fuel_position <- nrow(dat) # if there is only one sort of fuel left, then go to the last row of the dataset
  }

  # Get the date where the fuel changes
  date_other_fuel <- dat$a[ other_fuel_position ] 
  # Add the number of days between the two date to to overall count
  counts[fuel] <- counts[fuel] + (date_other_fuel-date_this_fuel)

  # set the i where the fuel changes for next iteration
  i = other_fuel_position
  }
}


dplyr_f <- function(dat){
  # @JonSpring @IsmailMüller
  dat %>% mutate(days_to_next = lead(a) - a) %>% 
    group_by(b) %>% 
    summarise(N = sum(days_to_next, na.rm = TRUE))
}

data.table_f1 <- function(dat){
  ## @Wimpel
  #create sample data
  dt1 <- setDT(dat)
  #create a data.table with one row for each day within the range of dt1
  dt2 <- data.table( a = seq( min( dt1$a ), max( dt1$a), by = "days") )
  #perform rolling join to get the last 'b' from dt1 on all dates in dt2
  dt2[, b := dt1[dt2, b, on = "a", roll = TRUE]][]
  #summarise by b (number of rows = number of days, so we can use .N)
  dt2[, (days = .N), by = "b"]
}

data.table_f2 <- function(dat){
  ## @Frank
  setDT(dat)
  res <- dat[, .(d_start = first(a)), by=.(b, g = rleid(b))]
  res[, dur := shift(d_start, type="lead", fill=max(dat$a)) - d_start][]
  res[!is.na(dur), .(tot_dur = sum(dur)), by=b]
}

microbenchmark(while_loop(dat), data.table_f1(dat),data.table_f2(dat), dplyr_f(dat))
# expr                min       lq        mean    median       uq      max  neval
# while_loop(dat)     1.755670 1.868047 2.308720 1.905485 1.989556 27.02236   100
# data.table_f1(dat)  3.874152 4.143840 4.559838 4.268966 4.666345 14.59840   100
# data.table_f2(dat)  3.269300 3.470870 4.090084 3.660293 4.130438 17.41423   100
# dplyr_f(dat)        4.373799 4.646995 5.269530 4.802282 5.258533 14.71824   100

Answer 3

另一种data.table方法（与@IsmailMüller的dplyr答案基本相同）：

library(data.table)
setDT(dat)

res <- dat[, .(d_start = first(a)), by=.(b, g = rleid(b))]
res[, dur := shift(d_start, type="lead") - d_start][]

   b g    d_start     dur
1: x 1 2018-01-01  9 days
2: y 2 2018-01-10 17 days
3: x 3 2018-01-27 33 days
4: y 4 2018-03-01 NA days

NA似乎是最终咒语的正确值，因为您不知道它何时结束。不过，如果您想在那儿使用最新的记录...

res[, dur := shift(d_start, type="lead", fill=max(dat$a)) - d_start][]

   b g    d_start     dur
1: x 1 2018-01-01  9 days
2: y 2 2018-01-10 17 days
3: x 3 2018-01-27 33 days
4: y 4 2018-03-01  4 days

无论哪种方式，您都可以获取每种燃料类型的总和

res[!is.na(dur), .(tot_dur = sum(dur)), by=b]

   b tot_dur
1: x 42 days
2: y 21 days
# these results are for the fill= way

注释。通过每次运行获取第一条记录（使用rleid），这减少了需要进行的计算总和sum（x-shift / lead（x））。完成，但是除非您的数据非常大，否则这无关紧要。

Answer 4

使用this._dependentSubject.next([...this._dependentSubject.getValue(), ...dependent]); / dplyr的直接方法：

tidyr

哪个返回：

library(tidyverse)

dat %>%
  complete(a = full_seq(a, 1)) %>% 
  fill(b) %>%
  count(b)

计算R中日期范围内的天数

4 个答案: