rdplyrsubsetinterpolation

Exclude interpolated rows where gap is bigger than a given theshhold


I have temperture data from different places. Recordings are usually made every hour but sometimes there are bigger gaps between two dates. So the data is like this:

df <- data.frame(date= lubridate::ymd_hms(c("2011-01-02 08:00:00", "2011-01-02 09:00:00", "2011-01-02 10:00:00", "2011-01-02 11:00:00", "2011-01-02 12:00:00",
                                        "2011-01-04 08:00:00", "2011-01-04 09:00:00", "2011-01-04 10:00:00", "2011-01-04 11:00:00", "2011-01-04 12:00:00",
                                        
                                        "2012-04-22 00:00:00", "2012-04-22 01:00:00", "2012-04-22 02:00:00", "2012-04-22 13:00:00", "2012-04-24 05:00:00",
                                        "2012-04-24 06:00:00", "2012-04-24 07:00:00", "2012-04-24 08:00:00", "2012-04-24 09:00:00", "2012-04-24 10:00:00")),
             id= rep(LETTERS[1:2], each= 10))
df$temp <- rnorm(nrow(df), 15, 5) + rep(c(1, 10), each= 10)

I interpolate the data and plot it. Something like this:

library(magrittr)
df_interpolated <- df %>%
  dplyr::group_by(id) %>%
  dplyr::reframe(date_interpolate_for= seq(min(date), max(date), by= "secs"),
                 temp_interpolated= approx(date, temp, xout= date_interpolate_for)$y,
                 id= unique(id))

library(ggplot2)
ggplot() +
  geom_point(data= df_interpolated, mapping= aes(date_interpolate_for, temp_interpolated), size= .5) +
  geom_point(data= df, mapping= aes(date, temp), col= "red") +
  facet_wrap(. ~ id, scales= "free_x") +
  theme_bw()

wrong

In the former plot, the black "line" shows the interpolated data and the red points the actual measured temperature. The problem is that there are those big gaps between two dates where the interpolation makes us think that the temperature changed from date x to date x+1 like a straight line. This is unplausible if the date gaps last days, months or even years. Therefore, I want to exclude rows from df_interpolated if the gaps between the real dates in df are bigger than a choosen threshold. Lets say we pick a treshold of 12 hours, than the resulting data would look like that:

df_interpolated2 <- df_interpolated %>%
  dplyr::filter(id == "A" & date_interpolate_for <= lubridate::ymd_hms("2011-01-02 12:00:00") |
                  id == "A" & date_interpolate_for >= lubridate::ymd_hms("2011-01-04 08:00:00") |
                  id == "B" & date_interpolate_for <= lubridate::ymd_hms("2012-04-22 13:00:00") |
                  id == "B" & date_interpolate_for >= lubridate::ymd_hms("2012-04-24 05:00:00"))

ggplot() +
  geom_point(data= df_interpolated2, mapping= aes(date_interpolate_for, temp_interpolated), size= .5) +
  geom_point(data= df, mapping= aes(date, temp), col= "red") +
  facet_wrap(. ~ id, scales= "free_x") +
  theme_bw()

right

So what I have so far is df and df_interpolated, but how to exclude rows based on a choosen threshold in order to get df_interpolated2? In the code above, I did it by hand - how can I achieve this progmatically?


Solution

  • One way is to create another grouping variable derived from the date differences exceeding your threshold.

    threshold <- 12
    
    df_interpolated <- df %>%
      mutate(keep=cumsum(c(1, diff(date))>threshold), .by=id) %>%
      dplyr::group_by(id, keep) %>%
      dplyr::reframe(date_interpolate_for=seq(min(date), max(date), by= "secs"),
                     temp_interpolated= approx(date, temp, xout= date_interpolate_for)$y,
                     id= unique(id))
    
    ggplot() +
      geom_point(data= df_interpolated, mapping= aes(date_interpolate_for, temp_interpolated), size= .5) +
      geom_point(data= df, mapping= aes(date, temp), col= "red") +
      facet_wrap(. ~ id, scales= "free_x") +
      theme_bw()
    

    enter image description here