Подсчитать количество дней в диапазоне дат в R

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" - это разные виды топлива. 01, 02 и 03 января судно сообщило, что использовало топливо типа «х». Затем 4-го, 5-го, 6-го и 7-го января корабль ничего не сообщил введите "х". Если судно изменит свой тип топлива на «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

тогда число дней между 1-й и 5-й строкой должно составлять 8 дней (с 09 января по 01 января). Таким образом, число «х» составляет 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 дней (26 января-10 января). Таким образом, число "у" составляет 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 дням (31 / январь-27 / январь). Таким образом, общее количество «х» составляет (8 + 4) = 12 дней. И мы считаем аналогично «у».

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», о котором сообщалось 31 января, это означает, что весь февраль судно использовало топливо типа «x», и поэтому нам нужно добавить 28 дней февраля к «x», что делает его (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 / tidyr:

library(tidyverse)

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

Что возвращает:

# A tibble: 2 x 2
  b         n
  <fct> <int>
1 x        42
2 y        22

Answer 3

Другой подход к data.table (по существу такой же, как и ответ dplyr @ IsmailMüller):

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), это сокращает количество вычислений суммы (x - shift / lead (x)), которые необходимо выполнить, но это вряд лине имеет значения, если ваши данные не очень большие.

Answer 4

С подходом Джона Спринга в комментариях с dplyr:

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