Fatal编程技术网
  • r/
  • R 用最近的值和因子替换NA值

R 用最近的值和因子替换NA值

r dataframe

R 用最近的值和因子替换NA值,r,dataframe,dplyr,data.table,na,R,Dataframe,Dplyr,Data.table,Na,我已经解决了我的问题，但我想知道是否有一种更省时的方法来解决它 我有一个2200万行x 9列的数据框架，其中列具有以下结构： factorID=具有99000个级别的因子 Date=日期 RDate=数字（日期为R计算的累进数，自1970年1月1日起的天数） V1:V6=整数 每个因子水平由231个年内观测值的时间序列组成，时间跨度为40年。由于故障，一些观察值出现了NA值，这些值可在所有6个变量中共享，或仅限于1个变量。我想用时域中最近的观测值替换那些NA值，主要是前一个或下一个（最简单的情况

我已经解决了我的问题，但我想知道是否有一种更省时的方法来解决它

我有一个2200万行x 9列的数据框架，其中列具有以下结构：

factorID
=具有99000个级别的因子
Date
=日期
RDate
=数字（日期为R计算的累进数，自1970年1月1日起的天数）
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=",")
}
预期结果：

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
我希望这会有所帮助。

以下是一个与您期望的输出相匹配的尝试，但它没有像我希望的那样工作

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

图书馆（动物园）
图书馆（dplyr）
df2%
分组依据（ID）%>%
变异（下一个日期\u closer=as.date（date）-lag（as.date（date））>=lead（as.date（date））-as.date（date））
df2%>%
聚集（键、值、-ID、-Date、-RDate、-next\u Date\u closer）%>%
分组依据（ID）%>%
变异(
new\u val=ifelse（is.na（next\u date\u closer），value，na.locf（value，fromLast=next\u date\u closer[is.na（value））））
) %>% 
选择（ID、日期、键、新值）%>%
排列（键，新值）
#一个tibble:8x8
#组别:ID[2]
ID日期V1 V2 V3 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
使用玩具数据集，您可以使用
tidyr:：fill
填充数据集。按因素和日期排列数据。按因素分组。然后应用
tidyr:：fill
。至少对于玩具数据集，当NAs恰好是某个因子的第一个OB时，仍有一些剩余的NAs，但这可以通过应用
tidyr:：fill
和argument
.direction=“up”
向上填充来解决

库（dplyr）
图书馆（tidyr）
种子集（123）
日期因子v1 v2
#>1 2020-01-01 a NA 2
#>2 2020-02-01不适用
#>3 2020-03-01不适用
#>4 2020-04-01 a 2 1
#>5 2020-01-01 b不适用
#>6 2020-02-01 b 2 1
df_填充率%
安排（系数、日期）%>%
分组依据（因子）%>%
填充（v1:v2）
df_填充
#>#A tibble:40 x 4
#>#群体：系数[10]
#>日期因子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不适用
#>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
#> # ... 还有30行
#检查
df_填充%>%
左联接（df，by=c（“日期”=“日期”、“系数”、“系数”），后缀=c（“\u填充”，“原始”））
#>#A tible:40 x 6
#>#群体：系数[10]
#>日期系数v1\u填充v2\u填充v1\u原始v2\u原始
#>                      
#>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
#>5 2020-01-01 b不适用
#>6 2020-02-01 b 2 1
#>7 2020-03-01 b 2 1 2 NA
#>8 2020-04-01 b 2
#>9 2020-01-01 c NA 1 NA 1
#>10 2020-02-01 C1 2
#> # ... 还有30行
由（v0.3.0）创建于2020-03-29，该选项使用从
数据最近的滚动。表
：


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))]]
}


数据：


库（data.table）

DTA
data.table
alternative使用连接。如果您的内存能够处理熔化/凝固，则速度应该很快


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_long您能提供一些最基本的样本数据来突出问题和期望的结果吗？但感觉确实像
zoo:：na。fill
可能会有帮助。您可能想做的是，首先使用
complete.cases
或
anyNA
来确定哪些行不需要修改。也有专门设计用于插补缺失值的包。我认为这里有一些问题，但如果没有一些样本数据，就很难知道什么是最好的。也就是说，通过在循环之外重复一些计算，您将获得一些收益，例如，
levels（df$factorID）
——只做一次，而不是多次。我想你可以得到它，这样你只需要第三个循环，然后你就可以使用*apply函数或dplyr或purrr函数，是的，你要找的是
zoo:：na.locf
，无论是使用
fromLast=F
还是
fromLast=T
我都选择了这个答案，因为这是提出的最快、更精确的解决方案，尽管其他人也帮了我的忙

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



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