首页 > 解决方案 > 将丢失的记录从另一个不同大小的数据帧插入一个数据帧 - 矢量化解决方案?

问题描述

我首先要说的是,用另一个数据框中的信息填充一个数据框中的缺失数据有一种解决方案可能适用于我的问题。但是,它使用 FOR 循环来解决它,我更喜欢矢量化解决方案。

我有 125 年的气候数据,包括年、月、温度、降水量和平底锅蒸发量。它是按月汇总的每日数据。1800 年代后期的某些年份缺少整个月份,我想用当时 30 年平均水平的等效月份代替那些缺少的月份。

我在下面粘贴了一些我一直在玩的代码:

# For simplicity, let's pretend there are 5 months in the year, so year 3 
# is the only year with a complete set of data, years 1 and 2 are missing some.

df1<-structure(
  list(
    Year=c(1,1,1,2,2,3,3,3,3,3),
    Month=c(1,2,4,2,5,1,2,3,4,5),
    Temp=c(-2,2,10,-4,12,2,4,8,14,16),
    Precip=c(20,10,50,10,60,26,18,40,60,46),
    Evap=c(2,6,30,4,48,4,10,32,70,40)
  )
)


# This represents the 30-year average data:

df2<-structure(
  list(
    Month=c(1,2,3,4,5),
    Temp=c(1,3,9,13,15),
    Precip=c(11,13,21,43,35),
    Evap=c(1,5,13,35,45)
  )
)

# to match my actual setup
df1<-as_tibble(df1)
df2<-as_tibble(df2)

# I can get to the list of months missing from a given year
full_year <- df2[,1]
compare_year1 <- df1[df1$Year==1,2]
missing_months <- setdiff(full_year,compare_year1)

# Or I can get the full data from each year missing one or more months
year_full <- df2[,1]
years_compare <- split(df1[,c(2)], df1$Year)
years_missing_months <- names(years_compare[sapply(years_compare,nrow)<5])
complete_years_missing_months <- df1[df1$Year %in% years_missing_months,]

这就是我被难住的地方。

我查看了 anti_join 和 merge,但看起来他们需要每帧中相同长度的数据。我可以从按年份分组的列表中获取缺少月份的年份,但我不确定如何实际获取从那里插入的行。似乎 lapply 可能有用,但答案还没有到来。

提前致谢。

编辑 7/19:作为我需要的说明,仅查看年份“1”,当前数据(df1)具有以下内容:
年份 | 星期一 | 温度 | 沉淀 | 蒸发
1 | 1 | -2 | 20 | 2
1 | 2 | 2 | 10 | 6
1 | 4 | 10 | 50 | 30

第 3 个月和第 5 个月缺少数据,因此我想插入 30 年平均表 (df2) 中的等效月份数据,因此“1”年的最终结果如下所示
:星期一 | 温度 | 沉淀 | 蒸发
1 | 1 | -2 | 20 | 2
1 | 2 | 2 | 10 | 6
1 | 3 | 9 | 21 | 13
1 | 4 | 10 | 50 | 30
1 | 5 | 15 | 35 | 45

然后以类似方式填写每年缺少的月份。“3”年没有变化,因为(在这个 5 个月的示例中)没有月份缺失数据。

标签: rjoinmergeinsert

解决方案


首先只需添加行来保存估算值,因为您知道缺少已知日期的行:

df1$date <- as.Date(paste0("200",df1$Year,"/",df1$Month,"/01"))

pretend_12months <- seq(min(df1$date),max(df1$date),by = "1 month")
pretend_5months  <- pretend_12months[lubridate::month(pretend_12months) < 6]
pretend_5months  <- data.frame(date=pretend_5months)

new <- merge(df1,
             pretend_5months, 
             by="date", 
             all=TRUE)

new$Year <- ifelse(is.na(new$Year),
                   substr(lubridate::year(new$date),4,4),
                   new$Year)
new$Month <- ifelse(is.na(new$Month),
                    lubridate::month(new$date),
                   new$Month)

NA使用左连接估算值:

# key part: left join using any library or builtin method (left_join,merge, etc)
fillin <- sqldf::sqldf("select a.date,a.Year,a.Month, b.Temp, b.Precip, b.Evap from new a left join df2 b on a.Month = b.Month")

# apply data set from join to the NA data
new$Temp[is.na(new$Temp)]     <- fillin$Temp[is.na(new$Temp)]
new$Precip[is.na(new$Precip)] <- fillin$Precip[is.na(new$Precip)]
new$Evap[is.na(new$Evap)]     <- fillin$Evap[is.na(new$Evap)]
         date Year Month Temp Precip Evap
1  2001-01-01    1     1   -2     20    2
2  2001-02-01    1     2    2     10    6
3  2001-03-01    1     3    9     21    9
4  2001-04-01    1     4   10     50   30
5  2001-05-01    1     5   15     35   15
6  2002-01-01    2     1    1     11    1
7  2002-02-01    2     2   -4     10    4
8  2002-03-01    2     3    9     21    9
9  2002-04-01    2     4   13     43   13
10 2002-05-01    2     5   12     60   48
11 2003-01-01    3     1    2     26    4
12 2003-02-01    3     2    4     18   10
13 2003-03-01    3     3    8     40   32
14 2003-04-01    3     4   14     60   70
15 2003-05-01    3     5   16     46   40

推荐阅读