Замена значений NA на ближайшее значение и коэффициент - PullRequest
Новая
       49

Замена значений NA на ближайшее значение и коэффициент

2 голосов
/ 29 марта 2020

Я уже решил свою проблему, но я хочу знать, есть ли более эффективный способ ее решения.

У меня есть 22 миллиона строк x 9 столбцов данных, со столбцами, имеющими следующая структура:

factorID = коэффициент с 99000 уровнями
Date = дата
RDate = число c (дата в виде прогрессивного числа, вычисленного как R, количество дней с момента 01.01.1970)
V1:V6 = целое число

Каждый факторный уровень состоит из временного ряда из 231 внутригодовых наблюдений, охватывающих промежуток времени в 40 лет. Из-за сбоев в некоторых наблюдениях представлены значения NA, которые могут быть общими для всех 6 переменных или ограничены только 1. Я хотел заменить эти значения NA ближайшим наблюдением во временной области, главным образом предыдущим или следующим. (самый простой случай, но иногда предыдущий или следующий тоже были NA).

Чтобы решить мою проблему, я попытался и преуспел с помощью вложенных циклов for: 

## 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=",")
}

Как вы можете себе представить, решение этой проблемы занимает очень много времени (использование data.table с двумя потоками на моем ноутбуке заняло около 12 часов: весь фрейм данных занимает более 1 ГБ, а каждая итерация всего l oop пишет что-то вроде 15-30 КБ данных). Как я уже упоминал, поскольку у каждого удостоверения есть свои особенности, я не мог придумать что-либо, чтобы лучше автоматизировать задачу. Как вы думаете, как можно ускорить всю операцию?

Большое спасибо.

Редактировать По запросу я прилагаю несколько примеров; Я не хотел делать пост длиннее, чем он был.

Пример данных: 

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

Желаемый результат: 

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

Надеюсь, что так и будет помощь.

Ответы [ 4 ]

0 голосов
/ 30 марта 2020

A data.table альтернатива с использованием объединений. Должно быть быстрым, если ваша память может обрабатывать 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

Входные данные в воспроизводимом виде (укажите их в следующий раз): 

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")
0 голосов
/ 29 марта 2020

Используя набор игрушечных данных, вы можете заполнить свой набор данных, используя tidyr::fill. Расставьте свои данные по фактору и дате. Группировка по фактору. Затем примените tidyr::fill. По крайней мере, для набора игрушечных данных все еще есть некоторые оставшиеся NA, когда NA оказываются первыми наблюдателями для фактора, но это может быть решено, например, путем применения tidyr::fill с аргументом .direction = "up" для заполнения вверх. 

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
#>    <date>     <chr>  <int> <int>
#>  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
#>    <date>     <chr>    <int>   <int>   <int>   <int>
#>  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

Создано в 2020-03-29 пакетом Представления (v0.3.0)

0 голосов
/ 30 марта 2020

Опция, использующая ближайший переход от 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))]]
}

выход: 

   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

данные: 

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")

Обратите внимание, что для factorID=1 для V2 1989-06-14 является ближайшей датой как 1989-05-13, так и 1989-05-29, и, следовательно, 305 следует использовать для заполнения этих строк NA.

0 голосов
/ 29 марта 2020

Следующая попытка соответствует желаемому результату, но она не совсем работает, как я и надеялся. 

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
  <int> <fct>      <int> <int> <int> <int> <int> <int>
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
...