R将时间序列中的重复行与数据表中的不同列类型组合在一起

Question

这个问题建立在另一个问题R combining duplicate rows by ID with different column types in a dataframe 之上。我有一个数据表，其中有一列 time 和其他一些不同类型的列（因子和数字）。这是一个例子：

dt <- data.table(time  = c(1, 1, 1, 1, 1, 2, 2, 3, 3, 4, 4, 4, 4),
             abst  = c(0, NA, 2, NA, NA, NA, 0, 0, NA, 2, NA, 3, 4),
             farbe = as.factor(c("keine", NA, "keine", NA, NA, NA, "keine", "keine", NA, NA, NA, "rot", "blau")),
             gier  = c(0, NA, 5, NA, NA, NA, 0, 0, NA, 1, NA, 6, 2),
             goff  = as.factor(c("haus", "maus", "toll", NA, "haus", NA, "maus", NA, NA, NA, NA, NA, "maus")),
             huft  = as.factor(c(NA, NA, NA, NA, NA, "wolle", NA, NA, "wolle", NA, NA, "holz", NA)),
             mode  = c(4, 2, NA, NA, 6, 5, 0, NA, NA, NA, NA, NA, 3))

现在我想合并time 列中的重复时间。数字列定义为所有相同 ID 的平均值（没有 NA！）。因子列合并为一个。 NA 可以省略。

dtRes <- data.table(time  = c(1, 1, 1, 2, 3, 4, 4),
                abst  = c(1, 1, 1, 0, 0, 3, 3),
                farbe = as.factor(c("keine", "keine", "keine", "keine", "keine", "rot", "blau")),
                gier  = c(2.5, 2.5, 2.5, 0, 0, 3, 3),
                goff  = as.factor(c("haus", "maus", "toll", "maus", NA, "maus", "maus")),
                huft  = as.factor(c(NA, NA, NA, "wolle", "wolle", "holz", "holz")),
                mode  = c(4, 4, 4, 2.5, NA, 3, 3))

我需要一些快速计算，因为我有大约一百万个观察值。

对此问题的一些额外想法：farbe 可能不是唯一的。在这种情况下，我认为对我的数据最好的想法是有一个重复的行，但只有一个不同的farbe，所以有 2 个相同的时间，其余的时间保持不变，但 farbe 的值不同。这应该只是非常罕见的情况，但会是一个很好的补充。

另外：我的真实数据中有更多的数值列和因子列，所以我不想单独定义每一列。在某些数据表中，没有因子列。因此，即使没有数字（time 始终存在且数字）或因子列，该解决方案也必须有效。

提前谢谢！

Answer 1

我们可以通过mean做一个群

library(data.table)
library(tidyr)
library(dplyr)
dt[, lapply(.SD, function(x) if(is.numeric(x)) mean(x, na.rm = TRUE)
     else toString(unique(x[!is.na(x)]))), .(time)] %>%
     separate_rows(farbe, goff)
# A tibble: 7 x 7
#   time  abst farbe  gier goff   huft     mode
#  <dbl> <dbl> <chr> <dbl> <chr>  <chr>   <dbl>
#1     1     1 keine   2.5 "haus" ""        4  
#2     1     1 keine   2.5 "maus" ""        4  
#3     1     1 keine   2.5 "toll" ""        4  
#4     2     0 keine   0   "maus" "wolle"   2.5
#5     3     0 keine   0   ""     "wolle" NaN  
#6     4     3 rot     3   "maus" "holz"    3  
#7     4     3 blau    3   "maus" "holz"    3  

---

或cSplit

library(splitstackshape)
cSplit(dt[, lapply(.SD, function(x) if(is.numeric(x)) 
    mean(x, na.rm = TRUE) else toString(unique(x[!is.na(x)]))), .(time)], 
    c('farbe', 'goff'), sep= ',\\s*', 'long', fixed = FALSE)
#   time abst farbe gier goff  huft mode
#1:    1    1 keine  2.5 haus        4.0
#2:    1    1  <NA>  2.5 maus        4.0
#3:    1    1  <NA>  2.5 toll        4.0
#4:    2    0 keine  0.0 maus wolle  2.5
#5:    3    0 keine  0.0 <NA> wolle  NaN
#6:    4    3   rot  3.0 maus  holz  3.0
#7:    4    3  blau  3.0 <NA>  holz  3.0

Answer 2

也可以实现预期结果（对于给定的样本数据集）随后调用separate_rows() 或cSplit()：

library(data.table) # version 1.12.9
dt[, lapply(.SD, function(x) if (is.numeric(x)) mean(x, na.rm = TRUE) 
            else unlist(na.omit(unique(x)))), by = time]

   time abst farbe gier goff  huft mode
1:    1    1 keine  2.5 haus  <NA>  4.0
2:    1    1 keine  2.5 maus  <NA>  4.0
3:    1    1 keine  2.5 toll  <NA>  4.0
4:    2    0 keine  0.0 maus wolle  2.5
5:    3    0 keine  0.0 <NA> wolle  NaN
6:    4    3   rot  3.0 maus  holz  3.0
7:    4    3  blau  3.0 maus  holz  3.0

请注意，这种方法适用于数字列和因子列的任意组合； no 列名需要明确说明。

---

但是，我确实相信对潜在问题的正确答案是每个time返回一行，而不是一种部分聚合（您的里程可能会有所不同，当然）：

dt[, lapply(.SD, function(x) if (is.numeric(x)) mean(x, na.rm = TRUE) 
                   else list(na.omit(unique(x)))), by = time]

   time abst    farbe gier           goff  huft mode
1:    1    1    keine  2.5 haus,maus,toll        4.0
2:    2    0    keine  0.0           maus wolle  2.5
3:    3    0    keine  0.0                wolle  NaN
4:    4    3 rot,blau  3.0           maus  holz  3.0

请注意，list() 而非 toString() 已用于聚合因子列。这有利于避免在因子水平之一偶然包含逗号, 的情况下出现问题。此外，更容易在大型生产数据集中根据time 识别具有非唯一因素的案例：

# compute aggregate as before
dtRes <- dt[, lapply(.SD, function(x) if (is.numeric(x)) mean(x, na.rm = TRUE) 
                   else list(na.omit(unique(x)))), by = time]
# find cases with non-unique factors per group
# note .SDcols = is.list is available with data.table version 1.12.9
tmp <- dtRes[, which(Reduce(sum, lapply(.SD, function(x) lengths(x) > 1L)) > 0), .SDcols = is.list, by = time]
tmp

   time V1
1:    1  1
2:    4  1

# show affected rows
dtRes[tmp, on = "time"]

   time abst    farbe gier           goff huft mode V1
1:    1    1    keine  2.5 haus,maus,toll         4  1
2:    4    3 rot,blau  3.0           maus holz    3  1

# show not affected rows
dtRes[!tmp, on = "time"]

   time abst farbe gier goff  huft mode
1:    2    0 keine    0 maus wolle  2.5
2:    3    0 keine    0      wolle  NaN