Replacing NA values by nearest value and factor

Question

I've already solved my problem, but I want to know if there is a more time-efficient way to solve it.

I have a 22 million rows x 9 columns dataframe, with columns having the following structure:

factorID = factor with 99000 levels
Date = date
RDate = numeric (date as progressive number as computed by R, number of days since 01/01/1970)
V1:V6 = integer

Each factor level is comprised by a time series of 231 intra-annual observations that cover a time-span of 40 years. Due to misfunctions, some observations present NA values, which could be shared across all 6 variables or confined to only 1. I wanted to replace those NA values with the nearest observation in the time domain, mainly the previous or next one (the simplest case, but sometimes the previous or next one were also NA).

To solve my problem, I tried and succeded with nested for loops:

## Isolating one factor at a time with the first loop, since NA amount and position 
## differ for each level
for (i in 1:length(levels(df$factorID))){
  ID = levels(df$factorID)[i]
  Point_df <- subset(df, df$factorID == ID) 
## Calculating total amount and position of NA and integer values by column,
## and identify them by their RDate
## If NA values are present in the column, execute the third loop
  for (j in 1:6){
    ID_column = j+3
    NAcheck <- is.na(Point_df[[ID_column]])
    difference_table <- cbind.data.frame(Point_df$RDate, NAcheck)
    NoNA <- subset(difference_table, difference_table$NAcheck == FALSE)
    True_NA <- subset(difference_table, difference_table$NAcheck == TRUE)
    colnames(True_NA)[1] <- "RDate"
    colnames(NoNA)[1] <- "RDate"
    if (length(True_NA$RDate) > 0){
## With the third loop I compute the nearest not NA observation based on the
## minimum absolute value difference in the time domain (treating the date as a progressive number),
## then I replace one NA at a time
      for (k in 1:length(True_NA$NAcheck)){
        difference <- abs(True_NA$RDate[k]-NoNA$RDate)
        difference_list <- cbind.data.frame(NoNA$RDate, difference)
        replacing_difference <- min(difference)
        replacing_date <- subset(difference_list, difference_list$difference==replacing_difference)
        NA_tochange <- subset(Point_df, Point_df$RDate == True_NA$RDate[k])
        replacing_value <- subset(Point_df, Point_df$RDate == replacing_date[1,1])
        NA_tochange[[ID_column]] <- replacing_value[[ID_column]]
        row <- as.numeric(rownames(True_NA)[k])
        Point_df[row] <- NA_tochange
      }
    }
  }
## Writing the new dataframe one level at a time
  fwrite(Point_df, "B:/Point-predictors_NA-replaced.csv", append=TRUE, sep=",")
}

As you can imagine, solving the problem in this way is extremely time-consuming (using data.table with 2 threads on my notebook took 12 hours or so: the whole dataframe is more than 1 GB and each iteration of the whole loop writes something like 15-30 KB of data). As I mentioned, since each ID has its own peculiarities, I couldn't come up with anything to automate the task better. How do you think the whole operation could be sped up?

Thanks a lot.

Edit As requested, I attach some examples; I didn't want to make the post longer than what it already was.

Sample data:

factorID   Date         RDate   V1   V2   V3   V4   V5   V6
1          1989-02-06   6976    318  351  172  570  260  108
1          1989-05-13   7072    77   NA   591  NA   801  550
1          1989-05-29   7088    NA   NA   NA   NA   NA   NA
1          1989-06-14   7104    252  305  286  835  271  85
.
2          1989-02-06   6976    236  389  323  2078 908  373
2          1989-05-13   7072    77   NA   591  NA   801  550
2          1989-05-29   7088    55   62   410  2001 NA   NA
2          1989-06-14   7104    351  508  456  1618 780  421

Desired outcome:

factorID   Date         RDate   V1   V2   V3   V4   V5   V6
1          1989-02-06   6976    318  351  172  570  260  108
1          1989-05-13   7072    77   351  591  570  801  550
1          1989-05-29   7088    77   351  591  570  801  550
1          1989-06-14   7104    252  305  286  835  271  85
.
2          1989-02-06   6976    236  389  323  2078 908  373
2          1989-05-13   7072    77   62   591  2001 801  550
2          1989-05-29   7088    55   62   410  2001 801  550
2          1989-06-14   7104    351  508  456  1618 780  421

I hope this will help.

user_1989480 · Answer

An option using nearest rolling from data.table:

cols <- paste0("V", 1L:6L)
for (x in cols) {
    DT[is.na(get(x)), (x) := 
        DT[!is.na(get(x))][.SD, on=.(factorID, RDate), roll="nearest", get(paste0("x.",x))]]
}

output:

   factorID       Date RDate  V1  V2  V3   V4  V5  V6
1:        1 1989-02-06  6976 318 351 172  570 260 108
2:        1 1989-05-13  7072  77 305 591  835 801 550
3:        1 1989-05-29  7088  77 305 591  835 801 550
4:        1 1989-06-14  7104 252 305 286  835 271  85
5:        2 1989-02-06  6976 236 389 323 2078 908 373
6:        2 1989-05-13  7072  77  62 591 2001 801 550
7:        2 1989-05-29  7088  55  62 410 2001 801 550
8:        2 1989-06-14  7104 351 508 456 1618 780 421

data:

library(data.table)
DT <- fread("factorID   Date         RDate   V1   V2   V3   V4   V5   V6
1          1989-02-06   6976    318  351  172  570  260  108
1          1989-05-13   7072    77   NA   591  NA   801  550
1          1989-05-29   7088    NA   NA   NA   NA   NA   NA
1          1989-06-14   7104    252  305  286  835  271  85
2          1989-02-06   6976    236  389  323  2078 908  373
2          1989-05-13   7072    77   NA   591  NA   801  550
2          1989-05-29   7088    55   62   410  2001 NA   NA
2          1989-06-14   7104    351  508  456  1618 780  421")

Note that for factorID=1, for V2, 1989-06-14 is the nearest date both 1989-05-13 and 1989-05-29 and hence 305 should be used to fill these NA rows.

user_2378649 · Answer

The following is an attempt that matches your desired output, but it is not quite working as well as I was hoping.

library(zoo)
library(dplyr)

df2 <- df %>% 
  group_by(ID) %>% 
  mutate(next_date_closer = as.Date(Date)-lag(as.Date(Date)) >= lead(as.Date(Date)) - as.Date(Date))

df2 %>% 
  gather(key, value, -ID, -Date, -RDate, -next_date_closer) %>% 
  group_by(ID) %>% 
  mutate(
    new_val = ifelse(is.na(next_date_closer), value, na.locf(value, fromLast = next_date_closer[which(is.na(value))]))
    ) %>% 
  select(ID, Date, key, new_val) %>% 
  spread(key, new_val)

# A tibble: 8 x 8
# Groups:   ID [2]
     ID Date          V1    V2    V3    V4    V5    V6
              
1     1 1989-02-06   318   351   172   570   260   108
2     1 1989-05-13    77   305   591   835   801   550
3     1 1989-05-29   252   305   286   835   271    85
4     1 1989-06-14   252   305   286   835   271    85
5     2 1989-02-06   236   389   323  2078   908   373
6     2 1989-05-13    77    62   591  2001   801   550
7     2 1989-05-29    55    62   410  2001   780   421
8     2 1989-06-14   351   508   456  1618   780   421

user_12993861 · Answer

Using a toy dataset you can fill your dataset using tidyr::fill. Arrange your data by factor and date. Group by factor. Then apply tidyr::fill. At least for the toy dataset there are still some remaining NAs, when the NAs happen to be the first obs for a factor, But that can e.g. be tackled by applying tidyr::fill with argument .direction = "up" to fill upwards.

library(dplyr)
library(tidyr)

set.seed(123)

df <- data.frame(
  date = rep(as.Date(paste("2020", 1:4, "1", sep = "-")), 10),
  factor = rep(letters[1:10], each = 4),
  v1 = sample(c(1:2, NA), 40, replace = TRUE),
  v2 = sample(c(1:2, NA), 40, replace = TRUE),
  stringsAsFactors = FALSE
)
head(df)
#>         date factor v1 v2
#> 1 2020-01-01      a NA  2
#> 2 2020-02-01      a NA NA
#> 3 2020-03-01      a NA NA
#> 4 2020-04-01      a  2  1
#> 5 2020-01-01      b NA NA
#> 6 2020-02-01      b  2  1

df_fill <- df %>% 
  arrange(factor, date) %>%
  group_by(factor) %>% 
  fill(v1:v2) 
df_fill
#> # A tibble: 40 x 4
#> # Groups:   factor [10]
#>    date       factor    v1    v2
#>            
#>  1 2020-01-01 a         NA     2
#>  2 2020-02-01 a         NA     2
#>  3 2020-03-01 a         NA     2
#>  4 2020-04-01 a          2     1
#>  5 2020-01-01 b         NA    NA
#>  6 2020-02-01 b          2     1
#>  7 2020-03-01 b          2     1
#>  8 2020-04-01 b          2     2
#>  9 2020-01-01 c         NA     1
#> 10 2020-02-01 c          1     2
#> # ... with 30 more rows

# Check
df_fill %>% 
  left_join(df, by = c("date" = "date", "factor", "factor"), suffix = c("_fill", "_orig"))
#> # A tibble: 40 x 6
#> # Groups:   factor [10]
#>    date       factor v1_fill v2_fill v1_orig v2_orig
#>                      
#>  1 2020-01-01 a           NA       2      NA       2
#>  2 2020-02-01 a           NA       2      NA      NA
#>  3 2020-03-01 a           NA       2      NA      NA
#>  4 2020-04-01 a            2       1       2       1
#>  5 2020-01-01 b           NA      NA      NA      NA
#>  6 2020-02-01 b            2       1       2       1
#>  7 2020-03-01 b            2       1       2      NA
#>  8 2020-04-01 b            2       2       2       2
#>  9 2020-01-01 c           NA       1      NA       1
#> 10 2020-02-01 c            1       2       1       2
#> # ... with 30 more rows

^{Created on 2020-03-29 by the reprex package (v0.3.0)}

user_4552295 · Answer

A data.table alternative using joins. Should be fast if your memory can handle the melt/dcast.

DT_long <- melt(DT, id.vars = c("factorID", "Date", "RDate"))
DT_long[is.na(value),
        value := DT_long[!is.na(value)
                         ][.SD, 
                           on = .(factorID, variable, RDate), 
                           j = value, 
                           roll = "nearest",  
                           mult = "first"]]
dcast(DT_long, factorID + Date + RDate ~ variable, value.vars = "value")


   factorID       Date RDate  V1  V2  V3   V4  V5  V6
1:        1 1989-02-06  6976 318 351 172  570 260 108
2:        1 1989-05-13  7072  77 305 591  835 801 550
3:        1 1989-05-29  7088  77 305 591  835 801 550
4:        1 1989-06-14  7104 252 305 286  835 271  85
5:        2 1989-02-06  6976 236 389 323 2078 908 373
6:        2 1989-05-13  7072  77  62 591 2001 801 550
7:        2 1989-05-29  7088  55  62 410 2001 801 550
8:        2 1989-06-14  7104 351 508 456 1618 780 421

Input data in reproducible form (please provide it yourself next time):

DT <- fread(
"factorID   Date         RDate   V1   V2   V3   V4   V5   V6
1          1989-02-06   6976    318  351  172  570  260  108
1          1989-05-13   7072    77   NA   591  NA   801  550
1          1989-05-29   7088    NA   NA   NA   NA   NA   NA
1          1989-06-14   7104    252  305  286  835  271  85
2          1989-02-06   6976    236  389  323  2078 908  373
2          1989-05-13   7072    77   NA   591  NA   801  550
2          1989-05-29   7088    55   62   410  2001 NA   NA
2          1989-06-14   7104    351  508  456  1618 780  421")

Replacing NA values by nearest value and factor

4 Answers