问题描述
我有一个问题,我需要根据 ID1 和 ID2 将长格式数据表改造成宽格式,并且条目不重叠。逻辑相当复杂,取决于 3 列(“Seq、“ID1”和“ID2”)。
如果属于 ID1 的 Value_1 与 ID2“重叠”,则应求和,反之亦然,但仅适用于不同的 ID。
请参阅下面的输入示例和输出,希望能澄清它。
输入:
df <- structure(list(Seq = c(9143L,916L,9293L,9301L,9302L,9304L,9305L,9306L,9307L,931L,9311L),ID1 = c("ID1_1","ID1_1",NA,"ID1_2","ID1_3","ID1_4","ID1_4"),value_1 = c(30L,30L,50L,50L),ID2 = c(NA,"ID2_1","ID2_2","ID2_3","ID2_4","ID2_5"),value_2 = c(NA,33L,200L,46L,58L,46L)),class = "data.frame",row.names = c(NA,-11L))
输出:
(注意例如最后一行,value_1 = 80,因为将属于 ID1_3 和 ID1_4 的值相加得到 30+50)
解决方法
我使用了 data.table 包中的 rleid()
函数,这是一个计算游程编码的迷人函数。这样做
library(data.table)
library(dplyr)
df %>%
mutate(d = cumsum( c(0,diff(rleid(ID1))) != 0 & c(0,diff(rleid(ID2))) != 0),value_1 = value_1 * c(1,diff(rleid(ID1))),value_2 = value_2 * c(1,diff(rleid(ID2)))) %>% group_by(d) %>%
summarise(Seq = toString(Seq),value_1 = sum(value_1,na.rm = T),value_2 = sum(value_2,na.rm = T)) %>%
ungroup() %>% select(-d)
# A tibble: 4 x 3
Seq value_1 value_2
<chr> <int> <int>
1 9143,916 30 0
2 9293 0 33
3 9301,9302 30 246
4 9304,9305,9306,9307,931,9311 80 104
旧答案
df %>% group_by(d = cumsum( c(0,diff(rleid(ID2))) != 0)) %>%
summarise(Seq = toString(Seq),value_1 = sum(unique(value_1),value_2 = sum(unique(value_2),na.rm = T)) %>%
ungroup() %>% select(-d)
,
首先,我真的很喜欢 AnilGoyal 的解决方案。我可以看到我需要开始使用 data.table 包。
话虽如此,我正在研究一种没有 data.table 的 dplyr 方法,这显然更加冗长。此外,我花了一段时间才弄清楚如何处理重复值。乘以 changei
列(0 或 1)删除重复项。以下是我的方法:
df %>%
mutate_if(is.numeric,replace_na,0) %>%
mutate_if(is.character,"NA") %>%
mutate(
change1 = ID1 != lag(ID1,default = "Start"),value_1 = value_1 * change1,change2 = ID2 != lag(ID2,value_2 = value_2 * change2,change = cumsum(change1 & change2)
) %>%
group_by(change) %>%
summarise(
Seq = toString(Seq),na.rm = T)
) %>%
ungroup()
结果是:
df
# change Seq value_1 value_2
# <int> <chr> <dbl> <dbl>
# 1 1 9143,916 30 0
# 2 2 9293 0 33
# 3 3 9301,9302 30 246
# 4 4 9304,9311 80 104
,
不像上面那样简洁,但仍然是一个基本的 R 解决方案:
# Function to calculate the aggregate value: .agg_func => function()
.agg_func <- function(df,id_col,value_col){
sbst <- subset(
df,!(is.na(df[,id_col])) & !(duplicated(df[,id_col])),select = c(id_col,value_col)
)
return(sum(sbst[,value_col],na.rm = TRUE))
}
# Function to group data by ids: .grouping_func => function()
.grouping_func <- function(df,id_col){
r_l_e <- rle(df[,id_col])
rle_id <- rep(seq_along(r_l_e$values),times = r_l_e$lengths)
return(c(0,diff(rle_id)) != 0)
}
# Group the data: grpd_df => data.frame
grpd_df <- transform(
df,grp = cumsum(
apply(
vapply(
names(df)[startsWith(names(df),"ID")],function(x).grouping_func(df,x),logical(nrow(df))
),1,all
)
)
)
# Split-apply-combine the aggregate function to the grouped data:
data.frame(do.call(rbind,lapply(with(grpd_df,split(grpd_df,grp)),function(s){
data.frame(
Seq = toString(s$Seq),value_1 = .agg_func(s,"ID1","value_1"),value_2 = .agg_func(s,"ID2","value_2")
)
}
)
),row.names = NULL,stringsAsFactors = FALSE
)