使用 tidyr 收集时保留属性（属性不相同）

Posted 2023-02-14

【中文标题】使用 tidyr 收集时保留属性（属性不相同）

【英文标题】：Retain attributes when using gather from tidyr (attributes are not identical)

【发布时间】：2015-05-12 09:39:36

【问题描述】：

我有一个需要拆分为两个表以满足 Codd 的第三范式的数据框。在一个简单的情况下，原始数据框看起来像这样：

library(lubridate)
> (df <- data.frame(hh_id = 1:2,
                   income = c(55000, 94000),
                   bday_01 = ymd(c(20150309, 19890211)),
                   bday_02 = ymd(c(19850911, 20000815)),
                   gender_01 = factor(c("M", "F")),
                   gender_02 = factor(c("F", "F"))))

    hh_id income    bday_01    bday_02 gender_01 gender_02
  1     1  55000 2015-03-09 1985-09-11         M         F
  2     2  94000 1989-02-11 2000-08-15         F         F

当我使用收集功能时，它会警告属性不相同，并且会丢失性别因素和 bday 的 lubridate（或真实示例中的其他属性）。是否有一个很好的 tidyr 解决方案来避免丢失每列的数据类型？

library(tidyr)
> (person <- df %>% 
      select(hh_id, bday_01:gender_02) %>% 
      gather(key, value, -hh_id) %>%
      separate(key, c("key", "per_num"), sep = "_") %>%
      spread(key, value))

     hh_id per_num       bday gender
   1     1      01 1425859200      M
   2     1      02  495244800      F
   3     2      01  603158400      F
   4     2      02  966297600      F

   Warning message:
   attributes are not identical across measure variables; they will be dropped

> lapply(person, class)

  $hh_id
  [1] "integer"

  $per_num
  [1] "character"

  $bday
  [1] "character"

  $gender
  [1] "character"

我可以想出一种方法，即分别收集具有相同数据类型的每组变量，然后连接所有表，但必须有一个更优雅的解决方案，但我错过了。

【问题讨论】：

我认为目前没有一个优雅的解决方案 :( 对于这种情况，我 认为 收集可能需要创建一个列表列，以便属性不会会迷路。但我认为这会很慢，并且可能会让人们感到困惑。

@hadley 啊，我明白了。是的，我正在编写一个返回列表结果的函数，而且速度非常慢。我现在正在为此寻找更好的解决方案。

【参考方案1】：

你似乎不喜欢我的base solutions。让我再诱惑你一次

(df <- data.frame(hh_id = 1:2,
                  income = c(55000, 94000),
                  bday_01 = ymd(c(20150309, 19890211)),
                  bday_02 = ymd(c(19850911, 20000815)),
                  gender_01 = factor(c("M", "F")),
                  gender_02 = factor(c("F", "F"))))


reshape(df, idvar = 'hh_id', varying = list(3:4, 5:6), direction = 'long',
        v.names = c('bday','gender'), timevar = 'per_num')

#     hh_id income    per_num       bday gender
# 1.1     1  55000          1 2015-03-09      M
# 2.1     2  94000          1 1989-02-11      F
# 1.2     1  55000          2 1985-09-11      F
# 2.2     2  94000          2 2000-08-15      F

【讨论】：

这肯定是一个可行的解决方案。我将坚持看看是否有 tidyr 解决方案可用，因为我需要使用正则表达式来选择不同的列。不幸的是，数据源的列并不总是以相同的顺序排列。

【参考方案2】：

您可以将日期转换为字符，然后在最后将它们转换回日期：

(person <- df %>% 
      select(hh_id, bday_01:gender_02) %>% 
      mutate_each(funs(as.character), contains('bday')) %>%
      gather(key, value, -hh_id) %>%
      separate(key, c("key", "per_num"), sep = "_") %>%
      spread(key, value) %>%
      mutate(bday=ymd(bday)))

  hh_id per_num       bday gender
1     1      01 2015-03-09      M
2     1      02 1985-09-11      F
3     2      01 1989-02-11      F
4     2      02 2000-08-15      F

或者，如果您使用Date 而不是POSIXct，您可以这样做：

(person <- df %>% 
      select(hh_id, bday_01:gender_02) %>% 
      gather(per_num1, gender, contains('gender'), convert=TRUE) %>%
      gather(per_num2, bday, contains('bday'), convert=TRUE) %>%
      mutate(bday=as.Date(bday)) %>%
      mutate_each(funs(str_extract(., '\\d+')), per_num1, per_num2) %>%
      filter(per_num1 == per_num2) %>%
      rename(per_num=per_num1) %>%
      select(-per_num2))

编辑

您看到的警告：

Warning: attributes are not identical across measure variables; they will be dropped

来自收集性别列，这些列是因素并且具有不同的水平向量（请参阅str(df)）。如果您要将性别列转换为字符，或者您要将它们的关卡与类似的东西同步，

df <- mutate(df, gender_02 = factor(gender_02, levels=levels(gender_01)))

然后你会看到当你执行时警告消失了

person <- df %>% 
        select(hh_id, bday_01:gender_02) %>% 
        gather(key, value, contains('gender'))

【讨论】：

这就是我最终要做的。当我有时间时，我将查看源代码并了解@hadley 选择要求相同属性的原因。一定有充分的理由。

@josiekre 我已经更新了我的答案，以解释您收到该警告的原因。

【参考方案3】：

使用 tidyr 1.0.0 可以如下完成：

suppressPackageStartupMessages(
  library(tidyr)
  library(lubridate)
)
df <- data.frame(hh_id = 1:2,
                 income = c(55000, 94000),
                 bday_01 = ymd(c(20150309, 19890211)),
                 bday_02 = ymd(c(19850911, 20000815)),
                 gender_01 = factor(c("M", "F")),
                 gender_02 = factor(c("F", "F")))

pivot_longer(df, -(1:2), names_to = c(".value","per_num"),names_sep = "_" )
#> # A tibble: 4 x 5
#>   hh_id income per_num bday       gender
#>   <int>  <dbl> <chr>   <date>     <fct> 
#> 1     1  55000 01      2015-03-09 M     
#> 2     1  55000 02      1985-09-11 F     
#> 3     2  94000 01      1989-02-11 F     
#> 4     2  94000 02      2000-08-15 F

^{由reprex package (v0.3.0) 于 2019-09-14 创建}