根据一些特定规则在R中聚合周和日期

Question

我不习惯使用R。我已经问了一个关于堆栈溢出的问题，得到了一个很好的答案。很抱歉发布类似的问题，但我尝试了很多次，得到了我没有想到的结果。这一次，我想做的与我之前的问题略有不同。使用R合并关于日期和周的两个数据我有两个数据。一个是year_month_week列，另一个是date列。

df1<-data.frame(id=c(1,1,1,2,2,2,2),
year_month_week=c(2022051,2022052,2022053,2022041,2022042,2022043,2022044),
points=c(65,58,47,21,25,27,43))
df2<-data.frame(id=c(1,1,1,2,2,2),
date=c(20220503,20220506,20220512,20220401,20220408,20220409),
temperature=c(36.1,36.3,36.6,34.3,34.9,35.3))

对于df1，2022051是指2022年5月的第一周。同样，2022052是指2022年5月的第2周。df220220503指2022年5月3日。我现在要做的是将df1和df2合并到year_month_week中。在这种情况下，20220503和20220506是2022年5月的第一周。如果year_month_week中有多个日期，我将只包括其中的第一个。现在，这是不同的部分。即使year_month_week内部没有date，也只保留它NA。因此，我的预期输出具有与df1相同的行数，其中包括列year_month_week

df<-data.frame(id=c(1,1,1,2,2,2,2),
year_month_week=c(2022051,2022052,2022053,2022041,2022042,2022043,2022044),
points=c(65,58,47,21,25,27,43),
temperature=c(36.1,36.6,NA,34.3,34.9,NA,NA))

Answer 1

首先我们可以将df2中的日期转换为年月日期格式，然后将两个表连接起来：

library(dplyr);library(lubridate)
df2$dt = ymd(df2$date)
df2$wk = day(df2$dt) %/% 7 + 1
df2$year_month_week = as.numeric(paste0(format(df2$dt, "%Y%m"), df2$wk))
df1 %>%
left_join(df2 %>% group_by(year_month_week) %>% slice(1) %>%
select(year_month_week, temperature))

结果

Joining, by = "year_month_week"
id year_month_week points temperature
1  1         2022051     65        36.1
2  1         2022052     58        36.6
3  1         2022053     47          NA
4  2         2022041     21        34.3
5  2         2022042     25        34.9
6  2         2022043     27          NA
7  2         2022044     43          NA

Answer 2

您可以在这里建立以前的答案，方法是使用函数计算一个月中的星期，然后在df2中生成一个联接键。参见此处

df1 <- data.frame(
id=c(1,1,1,2,2,2,2),
year_month_week=c(2022051,2022052,2022053,2022041,2022042,2022043,2022044),
points=c(65,58,47,21,25,27,43))
df2 <- data.frame(
id=c(1,1,1,2,2,2),
date=c(20220503,20220506,20220512,20220401,20220408,20220409),
temperature=c(36.1,36.3,36.6,34.3,34.9,35.3))
# Take the function from the previous StackOverflow question
monthweeks.Date <- function(x) {
ceiling(as.numeric(format(x, "%d")) / 7)
}
# Create a year_month_week variable to join on 
df2 <- 
df2 %>%
mutate(
date = lubridate::parse_date_time(
x = date, 
orders = "%Y%m%d"),
year_month_week = paste0(
lubridate::year(date), 
0,
lubridate::month(date),
monthweeks.Date(date)),
year_month_week = as.double(year_month_week)) 
# Remove duplicate year_month_weeks
df2 <- 
df2 %>%
arrange(year_month_week) %>% 
distinct(year_month_week, .keep_all = T)
# Join dataframes
df1 <- 
left_join(
df1, 
df2, 
by = "year_month_week")

生成此结果

id.x year_month_week points id.y       date temperature
1    1         2022051     65    1 2022-05-03        36.1
2    1         2022052     58    1 2022-05-12        36.6
3    1         2022053     47   NA       <NA>          NA
4    2         2022041     21    2 2022-04-01        34.3
5    2         2022042     25    2 2022-04-08        34.9
6    2         2022043     27   NA       <NA>          NA
7    2         2022044     43   NA       <NA>          NA
> 

编辑：忘记提到你需要tidyverse加载

library(tidyverse)