r语言 - 如何每月汇总每日数据，使用dplyr和润滑油，只有每月少于10天是NAs?

Question

我有1955年至2017年不同地点的每日气象数据(温度和降水)，我想将每个变量汇总为月平均值，但前提是每个月的NAs数量

我以4个月不同NA量的温度数据为例(第1个月:1 NA，第2个月(31天):30 NA，第3个月:0 NA，第4个月:所有数据均为NA):

library(dplyr)
library(lubridate)    
exmpldf <- data.frame(DATE = c("1955-06-01", "1955-06-02", "1955-06-03", "1955-06-04", "1955-06-05", "1955-06-06", "1955-06-07", "1955-06-08", "1955-06-09", "1955-06-10", 
"1955-06-11", "1955-06-12", "1955-06-13", "1955-06-14", "1955-06-15", "1955-06-16", "1955-06-17", "1955-06-18", "1955-06-19", "1955-06-20", 
"1955-06-21", "1955-06-22", "1955-06-23", "1955-06-24", "1955-06-25", "1955-06-26", "1955-06-27", "1955-06-28", "1955-06-29", "1955-06-30", 
"1955-07-01", "1955-07-02", "1955-07-03", "1955-07-04", "1955-07-05", "1955-07-06", "1955-07-07", "1955-07-08", "1955-07-09", "1955-07-10", 
"1955-07-11", "1955-07-12", "1955-07-13", "1955-07-14", "1955-07-15", "1955-07-16", "1955-07-17", "1955-07-18", "1955-07-19", "1955-07-20", 
"1955-07-21", "1955-07-22", "1955-07-23", "1955-07-24", "1955-07-25", "1955-07-26", "1955-07-27", "1955-07-28", "1955-07-29", "1955-07-30", 
"1955-07-31", "1955-08-01", "1955-08-02", "1955-08-03", "1955-08-04", "1955-08-05", "1955-08-06", "1955-08-07", "1955-08-08", "1955-08-09", 
"1955-08-10", "1955-08-11", "1955-08-12", "1955-08-13", "1955-08-14", "1955-08-15", "1955-08-16", "1955-08-17", "1955-08-18", "1955-08-19", 
"1955-08-20", "1955-08-21", "1955-08-22", "1955-08-23", "1955-08-24", "1955-08-25", "1955-08-26", "1955-08-27", "1955-08-28", "1955-08-29", 
"1955-08-30", "1955-08-31", "1955-09-01", "1955-09-02", "1955-09-03", "1955-09-04", "1955-09-05", "1955-09-06", "1955-09-07", "1955-09-08", 
"1955-09-09", "1955-09-10", "1955-09-11", "1955-09-12", "1955-09-13", "1955-09-14", "1955-09-15", "1955-09-16", "1955-09-17", "1955-09-18", 
"1955-09-19", "1955-09-20", "1955-09-21", "1955-09-22", "1955-09-23", "1955-09-24", "1955-09-25", "1955-09-26", "1955-09-27", "1955-09-28", 
"1955-09-29", "1955-09-30"), 
TMAX = c(NA, 20, 27, 17,  26.5, 27, 17, 26.5, 20, 23, 23, 21.5, 24, 26.5, 27, 27, 26.5, 24.5, 23, 22.5, 24, 23, 21.5, 25, 26.5, 23, 
24, 23.5, 23, 23, 23, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, 24, 22, 21, 17, 17, 17, 21.5, 22, 22, 22.5, 22.5, 16.5, 20.5, 17.5, 23, 17, 21, 21.5, 21, 21, 20, 22, 22, 22, 21.5, 21.5, 21.5, 22.5, 20, 
21, 20, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA))

对于月聚合，我使用mutate创建列"MONTH"和一栏"YEAR">

exmpldf <- exmpldf %>%
mutate(month(DATE), year(DATE))
names(exmpldf) <- c("DATE", "TMAX", "MONTH", "YEAR")

为了创建月平均值，我使用summarize:

exmpldfmeanMonth <- exmpldf %>%
group_by(MONTH, YEAR) %>%
summarise(TMAX = mean(TMAX))

问题是，在我的时间序列(1955-2017)中，有许多月份至少有1个每日数据为NA，而其他月份的全部或几乎全部每日数据为NA，无论如何，月平均值为NA:

> exmpldfmeanMonth
# A tibble: 4 x 3
# Groups:   MONTH [4]
MONTH  YEAR  TMAX
<dbl> <dbl> <dbl>
1     6  1955  NA   (1 day is NA)
2     7  1955  NA   (all days but 1, are NA)
3     8  1955  20.7 (no NAs)
4     9  1955  NA   (all days are NA)

您可以添加na.rm = T，但随后它会计算平均值，即使每个月只有一个数据:

exmpldfmeanMonth <- exmpldf %>%
group_by(MONTH, YEAR) %>%
summarise(TMAX = mean(TMAX, na.rm = T))
> exmpldfmeanMonth
# A tibble: 4 x 3
# Groups:   MONTH [4]
MONTH  YEAR  TMAX
<dbl> <dbl> <dbl>
1     6  1955  23.7  (1 day is NA)
2     7  1955  23    (all days but 1, are NA)
3     8  1955  20.7  (no NAs)
4     9  1955 NaN    (all days are NA)

因此，我想生成一个条件，仅当每月有10个或更少的NAs时才计算每月平均值，否则应将其视为NA:

> exmpldfmeanMonth
# A tibble: 4 x 3
# Groups:   MONTH [4]
MONTH  YEAR  TMAX
<dbl> <dbl> <dbl>
1     6  1955  23.7  (1 day is NA)
2     7  1955 NAN    (all days but 1, are NA)
3     8  1955  20.7  (no NAs)
4     9  1955 NaN    (all days are NA)

你能指导我如何解决这个问题吗?提前非常感谢!

Answer 1

library(dplyr)
library(lubridate)
df %>% 
mutate(month = month(DATE),
year = year(DATE)) %>% 
group_by(month, year) %>% 
summarize(prcp = if (sum(is.na(TMAX)) <= 10) mean(TMAX, na.rm = T) else NA,
.groups = "drop")

或者，当您summarize时，您可以计算NA的数量，然后添加mutate语句以有条件地更改prcp:

df %>% 
mutate(month = month(DATE),
year = year(DATE)) %>% 
group_by(month, year) %>% 
summarize(prcp = mean(TMAX, na.rm = T),
numna = sum(is.na(TMAX)), # count number of NA
.groups = "drop") %>% 
mutate(prcp = ifelse(numna > 10, NA, prcp)) %>% 
select(-numna)

在您所显示的数据中，只有一个month和year组合，而该组有超过10个NA:

month  year prcp 
1     6  1955 NA   

---

更新

如果你已经用新数据更新了reprex，这个解决方案仍然有效:

str(exmpldf)
'data.frame':   122 obs. of  2 variables:
$ DATE: chr  "1955-06-01" "1955-06-02" "1955-06-03" "1955-06-04" ...
$ TMAX: num  NA 20 27 17 26.5 27 17 26.5 20 23 ...
exmpldf %>% 
mutate(month = month(DATE),
year = year(DATE)) %>% 
group_by(month, year) %>% 
summarize(prcp = if (sum(is.na(TMAX)) <= 10) mean(TMAX, na.rm = T) else NA,
.groups = "drop")
month  year  prcp
<dbl> <dbl> <dbl>
1     6  1955  23.7
2     7  1955  NA  
3     8  1955  20.7
4     9  1955  NA  

Answer 2

请根据您的方法使用data.table和lubridate包找到一个替代方案:

Reprex

library(data.table)
library(lubridate)
setDT(df1)[, DATE := ymd(DATE)
][, `:=` (month = month(DATE), year = year(DATE))
][, .(PRCP = fifelse(sum(is.na(TMAX)) <= 10, mean(TMAX, na.rm = TRUE), NA_real_)), by = .(month, year)][]

• 案例1:NA <= 10

1.1您的数据:

df1 <- data.frame(DATE = c("1955-06-01", "1955-06-02", "1955-06-03", "1955-06-04",
"1955-06-05", "1955-06-06", "1955-06-07", "1955-06-08",
"1955-06-09", "1955-06-10", "1955-06-11", "1955-06-12",
"1955-06-13", "1955-06-14", "1955-06-15", "1955-06-16"),
TMAX = c(NA, NA, NA, NA, NA, NA, NA, NA, 20, 23, 23, 21.5, 24, 26.5,
27, 27))

2.2输出:

#>    month year PRCP
#> 1:     6 1955   24

• 案例2:NA>10

2.1您的数据:

df1 <- data.frame(DATE = c("1955-06-01", "1955-06-02", "1955-06-03", "1955-06-04",
"1955-06-05", "1955-06-06", "1955-06-07", "1955-06-08",
"1955-06-09", "1955-06-10", "1955-06-11", "1955-06-12",
"1955-06-13", "1955-06-14", "1955-06-15", "1955-06-16"),
TMAX = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, 21.5, 24, 26.5,
27, 27))

2.2输出:

#>    month year PRCP
#> 1:     6 1955   NA

^{由reprex包(v0.3.0)于2021-10-28创建}

Answer 3

考虑创建一个帮助函数，您可以根据需要自定义它。此外，您可以指定是否要使用mean、sum或任何其他聚合。

agg_data<- function(x, n=10, f = 'avg'){
#' @param x a vector of values
#' @param n a minimum number of observations
#' @param f which function to apply (e.g. `avg`, `sum`)

# return NA if there are more than 10 NA
if( sum(is.na(x)) > n ) return( NA_real_ )

x <- dplyr::case_when(
f %in% 'avg' ~ mean(x, na.rm = TRUE),
f %in% 'sum' ~ sum(x, na.rm = TRUE),
TRUE ~ NA_real_
)

return( x )
}

然后你可以在summarise脚本中使用这个函数，例如

exmpldf %>% 
mutate(month = month(DATE),
year = year(DATE)) %>% 
group_by(month, year) %>% 
summarise(prcp = agg_data(TMAX, n = 10, f = 'avg'),
.groups = "drop")