Линейная интерполяция для заполнения NoData для пробелов не более 2 дней

Question

Я работаю с вложенным списком (наземные датчики) списков (глубины измерений) списков (фреймы данных для каждого года с 2014-2018 гг.) И хочу выполнить линейную интерполяцию для каждого из этих фреймов данных. Вот обзор набора данных, просто чтобы вы могли понять, как он выглядит:

str(G1OUT_gwFERN) 

$ SE13 :List of 3
  ..$ d20:List of 5
  .. ..$ 2014:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2014-01-01" "2014-01-01" "2014-01-01" ...
  .. .. ..$ SWC : num [1:8760] 46 45.9 46 45.9 45.9 ...
  .. ..$ 2015:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2015-01-01" "2015-01-01" "2015-01-01" ...
  .. .. ..$ SWC : num [1:8760] 49.8 49.8 49.8 49.8 49.8 ...
  .. ..$ 2016:'data.frame': 8784 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8784], format: "2016-01-01" "2016-01-01" "2016-01-01" ...
  .. .. ..$ SWC : num [1:8784] 48.2 48.2 48.1 48.1 48.1 ...
  .. ..$ 2017:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2017-01-01" "2017-01-01" "2017-01-01" ...
  .. .. ..$ SWC : num [1:8760] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN ...
  .. ..$ 2018:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2018-01-01" "2018-01-01" "2018-01-01" ...
  .. .. ..$ SWC : num [1:8760] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN ...
  ..$ d50:List of 5
  .. ..$ 2014:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2014-01-01" "2014-01-01" "2014-01-01" ...
  .. .. ..$ SWC : num [1:8760] 35.2 35.2 35.2 35.2 35.2 ...
  .. ..$ 2015:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2015-01-01" "2015-01-01" "2015-01-01" ...
  .. .. ..$ SWC : num [1:8760] 34.8 34.8 34.7 34.7 34.8 ...
  .. ..$ 2016:'data.frame': 8784 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8784], format: "2016-01-01" "2016-01-01" "2016-01-01" ...
  .. .. ..$ SWC : num [1:8784] 34.2 34.2 34.1 34.1 34.1 ...
  .. ..$ 2017:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2017-01-01" "2017-01-01" "2017-01-01" ...
  .. .. ..$ SWC : num [1:8760] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN ...
  .. ..$ 2018:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2018-01-01" "2018-01-01" "2018-01-01" ...
  .. .. ..$ SWC : num [1:8760] 36.4 36.4 36.3 36.3 36.3 ...
  ..$ d5 :List of 5
  .. ..$ 2014:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2014-01-01" "2014-01-01" "2014-01-01" ...
  .. .. ..$ SWC : num [1:8760] 32.5 32.4 32.4 32.4 32.4 ...
  .. ..$ 2015:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2015-01-01" "2015-01-01" "2015-01-01" ...
  .. .. ..$ SWC : num [1:8760] 32.1 32.1 32.1 32.1 32.1 ...
  .. ..$ 2016:'data.frame': 8784 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8784], format: "2016-01-01" "2016-01-01" "2016-01-01" ...
  .. .. ..$ SWC : num [1:8784] 30.3 30.3 30.3 30.2 30.2 ...
  .. ..$ 2017:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2017-01-01" "2017-01-01" "2017-01-01" ...
  .. .. ..$ SWC : num [1:8760] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN ...
  .. ..$ 2018:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2018-01-01" "2018-01-01" "2018-01-01" ...
  .. .. ..$ SWC : num [1:8760] 31.1 31.2 31.1 31.1 31.1 ...
 $ SE14 :List of 3
  ..$ d20:List of 5
  .. ..$ 2014:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2014-01-01" "2014-01-01" "2014-01-01" ...
  .. .. ..$ SWC : num [1:8760] 52.5 52.5 52.5 52.5 52.4 ...
  .. ..$ 2015:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2015-01-01" "2015-01-01" "2015-01-01" ...
  .. .. ..$ SWC : num [1:8760] 53.7 53.7 53.7 53.7 53.7 ...
  .. ..$ 2016:'data.frame': 8784 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8784], format: "2016-01-01" "2016-01-01" "2016-01-01" ...
  .. .. ..$ SWC : num [1:8784] 52.3 52.2 52.3 52.3 52.2 ...
  .. ..$ 2017:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2017-01-01" "2017-01-01" "2017-01-01" ...
  .. .. ..$ SWC : num [1:8760] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN ...
  .. ..$ 2018:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2018-01-01" "2018-01-01" "2018-01-01" ...
  .. .. ..$ SWC : num [1:8760] 55 55 55 55.1 55 ...
  ..$ d50:List of 5
  .. ..$ 2014:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2014-01-01" "2014-01-01" "2014-01-01" ...
  .. .. ..$ SWC : num [1:8760] 27.9 27.9 27.9 27.9 27.9 ...
  .. ..$ 2015:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2015-01-01" "2015-01-01" "2015-01-01" ...
  .. .. ..$ SWC : num [1:8760] 28.5 28.5 28.5 28.5 28.5 ...
  .. ..$ 2016:'data.frame': 8784 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8784], format: "2016-01-01" "2016-01-01" "2016-01-01" ...
  .. .. ..$ SWC : num [1:8784] 26.7 26.7 26.7 26.6 26.7 ...
  .. ..$ 2017:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2017-01-01" "2017-01-01" "2017-01-01" ...
  .. .. ..$ SWC : num [1:8760] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN ...
  .. ..$ 2018:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2018-01-01" "2018-01-01" "2018-01-01" ...
  .. .. ..$ SWC : num [1:8760] 29.4 29.4 29.4 29.4 29.5 ...
  ..$ d5 :List of 5
  .. ..$ 2014:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2014-01-01" "2014-01-01" "2014-01-01" ...
  .. .. ..$ SWC : num [1:8760] 39.8 39.8 39.7 39.6 39.7 ...
  .. ..$ 2015:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2015-01-01" "2015-01-01" "2015-01-01" ...
  .. .. ..$ SWC : num [1:8760] 42.2 42.3 42.3 42.3 42.3 ...
  .. ..$ 2016:'data.frame': 8784 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8784], format: "2016-01-01" "2016-01-01" "2016-01-01" ...
  .. .. ..$ SWC : num [1:8784] 36.6 36.6 36.5 36.6 36.5 ...
  .. ..$ 2017:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2017-01-01" "2017-01-01" "2017-01-01" ...
  .. .. ..$ SWC : num [1:8760] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN ...
  .. ..$ 2018:'data.frame': 8760 obs. of  2 variables:
  .. .. ..$ Date: Date[1:8760], format: "2018-01-01" "2018-01-01" "2018-01-01" ...
  .. .. ..$ SWC : num [1:8760] 56.5 56.5 56.5 56.5 56.3 ...

Я извлек часть одного из фреймов данных из списка и использовал dput(), так что у вас есть некоторые Данные игрушки для работы:

    toydat <-  structure(list(Date = structure(c(16277, 16277, 16277, 16277, 
16277, 16277, 16277, 16277, 16277, 16277, 16277, 16277, 16277, 
16277, 16277, 16277, 16277, 16277, 16277, 16278, 16278, 16278, 
16278, 16278, 16278, 16278, 16278, 16278, 16278, 16278, 16278, 
16278, 16278, 16278, 16278, 16278, 16278, 16278, 16278, 16278, 
16278, 16278, 16278, 16279, 16279, 16279, 16279, 16279, 16279, 
16279, 16279, 16279, 16279, 16279, 16279, 16279, 16279, 16279, 
16279, 16279, 16279, 16279, 16279, 16279, 16279, 16279, 16279, 
16280, 16280, 16280, 16280, 16280, 16280, 16280, 16280, 16280, 
16280, 16280, 16280, 16280, 16280, 16280, 16280, 16280, 16280, 
16280, 16280, 16280, 16280, 16280, 16280, 16281, 16281, 16281, 
16281, 16281, 16281, 16281, 16281, 16281, 16281), class = "Date"), 
    SWC = c(NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, 
    NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, 
    NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, 
    NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, 
    NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, 
    NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, 
    NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, NaN, 19.627243, 19.543659, 
    19.593796, 19.534379, 19.59937, 19.51582, 19.482441, 19.51582, 
    19.571497, 19.645825, 20.83435, 21.116572, 22.688702, 22.216629, 
    21.54243, 21.229946, 21.003335, 20.833735, 20.74902, 20.608045, 
    20.512311, 20.411049)), row.names = 48774:48874, class = "data.frame")

Измерения проводились ежечасно, поэтому у меня 24 измерения за один день. Некоторые значения в кадрах данных являются значениями NoData, поэтому я хочу заполнить эти промежутки, используя линейную интерполяцию. Однако я хочу использовать линейную интерполяцию только в том случае, если разрыв между значениями NoData и фактическими значениями не превышает 2 дней. В отношении данных игрушек это означает, что если значения отсутствуют для 28 и 29 июля (2014-07-28 и 2014-07-29) Я хочу заполнить пробелы только за эти дни, а не за 27, 26, 25 ... июля и так далее. Если промежутки превышают 2 дня, я хочу сохранить значения NoData, так как позже я буду использовать линейную регрессию, чтобы заполнить эти пробелы, но это не должно быть топи c этого поста.

Я уже пробовал следующие вещи:

Я использовал функцию na.approx() из пакета zoo. Я набрал:

na.approx(toydat$SWC, na.rm = FALSE)

, но он просто возвращает данные, как было раньше, и не интерполирует (я набрал $ SW C, потому что я хочу только интерполировать этот столбец). Я подумал, что если я добавлю rule = 2 к коду, он принимает последнее значение после значений NaN и просто помещает это значение для всех значений NaN, что не то, что я хочу. Я также попытался использовать maxgap = 48, потому что думал, что это обеспечит интерполяцию только 48 значений. Однако, так как я все равно не смог правильно интерполировать, ничего не произошло.

Буду очень признателен за помощь.

Answer 1

Я только что понял, что na.approx () не интерполировал никаких значений, потому что до значений NoData нет никаких значений. Очевидно, что тогда интерполяция не работает, поскольку для интерполяции нужны значения до и после значений NoData.

Answer 2

Вот грязный пример, использующий Base R, который будет работать со значениями na в начале data.frame и экстраполировать значения na в конце data.frame, он предполагает частоту одинаковую. Примечание: df_list - прокси для вашего списка

# Linear interpolation function handling ties,
# returns interpolated vector the same length 
# a the input vector: -> vector
l_interp_vec <- function(na_vec){
  approx(x = na_vec, method = "linear", ties = "constant", n = length(na_vec))$y
}

# Applied to a dataframe, replacing NA values
# in each of the numeric vectors,
# with interpolated values.
# input is dataframe: -> dataframe()
interped_df <- function(df){
  data.frame(lapply(df, function(x) {
  if (is.numeric(x)) {
    # Store a scalar of min row where x isn't NA: -> min_non_na
    min_non_na <- min(which(!(is.na(x))))
    # Store a scalar of max row where x isn't NA: -> max_non_na
    max_non_na <- max(which(!(is.na(x))))
    # Store scalar of the number of rows needed to impute prior
    # to first NA value: -> ru_lower
    ru_lower <- ifelse(min_non_na > 1, min_non_na - 1, min_non_na)
    # Store scalar of the number of rows needed to impute after
    # the last non-NA value: -> ru_upper
    ru_upper <- ifelse(max_non_na == length(x),
                       length(x) - 1,
                       (length(x) - (max_non_na + 1)))

    # Store a vector of the ramp to function: -> l_ramp_up:
    ramp_up <-
      as.numeric(cumsum(rep(x[min_non_na] / (min_non_na), ru_lower)))

    # Apply the interpolation function on vector "x": -> y
    y <-
      as.numeric(l_interp_vec(as.numeric(x[min_non_na:max_non_na])))

    # Create a vector that combines the ramp_up vector
    # and y if the first NA is at row 1: -> z
    if (length(ramp_up) > 1 & max_non_na != length(x)) {
      # Create a vector interpolations if there are
      # multiple NA values after the last value: -> lower_l_int
      lower_l_int <-
        as.numeric(cumsum(rep(mean(diff(
          c(ramp_up, y)
        )),
        ru_upper + 1)) +
          as.numeric(x[max_non_na]))

      # Store the linear interpolations in  a vector: -> z
      z <- as.numeric(c(ramp_up, y, lower_l_int))

    } else if (length(ramp_up) > 1 & max_non_na == length(x)) {
      # Store the linear interpolations in  a vector: -> z
      z <- as.numeric(c(ramp_up, y))

    } else if (min_non_na == 1 & max_non_na != length(x)) {
      # Create a vector interpolations if there are
      # multiple NA values after the last value: -> lower_l_int
      lower_l_int <-
        as.numeric(cumsum(rep(mean(diff(
          c(ramp_up, y)
        )),
        ru_upper + 1)) +
          as.numeric(x[max_non_na]))

      # Store the linear interpolations in  a vector: -> z
      z <- as.numeric(c(y, lower_l_int))

    } else{
      # Store the linear interpolations in  a vector: -> z
      z <- as.numeric(y)

    }

    # Interpolate between points in x, return new x:
    return(as.numeric(ifelse(is.na(x), z, x)))

  } else{
    x

  }

}))}

df_list_interped_extrapped <- lapply(df_list, interped_df)