r - 复杂的长到宽整形算法

Question

我遇到一个问题，我需要根据 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_2", NA, "ID1_3", "ID1_3", "ID1_3", "ID1_4", 
"ID1_4"), value_1 = c(30L, 30L, NA, 30L, 30L, NA, 30L, 30L, 30L, 
50L, 50L), ID2 = c(NA, NA, "ID2_1", "ID2_2", "ID2_3", "ID2_4", 
"ID2_4", "ID2_4", "ID2_4", "ID2_4", "ID2_5"), value_2 = c(NA, 
NA, 33L, 200L, 46L, 58L, 58L, 58L, 58L, 58L, 46L)), class = "data.frame", row.names = c(NA, 
-11L))

输出:

(注意例如最后一行，value_1 = 80，因为 30+50 是属于 ID1_3 和 ID1_4 的值的总和)

Answer 1

我使用了 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(ID1))) != 0 & c(0, diff(rleid(ID2))) != 0)) %>%
  summarise(Seq = toString(Seq),
            value_1 = sum(unique(value_1), na.rm = T),
            value_2 = sum(unique(value_2), na.rm = T)) %>%
  ungroup() %>% select(-d)