我已经解决了我的问题,但是我想知道是否有更省时的方法来解决它。
我有一个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=",")
}
您可以想象,以这种方式解决问题非常耗时(在笔记本上使用具有两个线程的data.table
大约需要12个小时:整个数据帧超过1 GB,并且整个循环的每次迭代写入大约15-30 KB的数据)。正如我提到的那样,由于每个ID都有其自身的特性,因此我无法提出任何更好的自动化任务的方法。您如何看待整个操作?
非常感谢。
编辑根据要求,我附上一些例子;我不想将帖子的时间延长到已经超过的时间。
样本数据:
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
我希望这会有所帮助。
以下是与您期望的输出匹配的尝试,但是效果不如我希望的那样。
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
使用玩具数据集,您可以使用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
由reprex package(v0.3.0)在2020-03-29创建
使用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")