r 有条件的从宽到长，列名模式答案

【问题标题】：r conditional wide to long with column name patternr 有条件的从宽到长，列名模式
【发布时间】：2021-04-26 15:02:21
【问题描述】：

这是一个有点棘手的数据集，其中列的布局是这样的。

ID   C.Date      T.Date      C(Area)   T(Area)    Level(closet)_1   Venti_1    Level(closet)_2   Venti_2
733  2013.06.18  2013.06.18  65.2      42.1       C6                0          C3                1
537  2015.10.01  2015.15.01  34.5      27.2       C3                0          T11               0
909  2016-01-14  2016-01-14  15.1      25.9       T4                1          T2                1

规则

Step1 :  Consider columns: ID, C.Date, C(Area), Level(closet)_1, Venti_1, Level(closet)_2, Venti_2
         Rearrange the data like this.

         ID  Index   Date       Ref.Level   Area    Level(closet)    Venti
         733 1       2013.06.18 C           65.2    C6                0 
         733 2       2013.06.18 C           65.2    C3                1 

Step2 :  Consider columns: ID, T.Date, T(Area), Level(closet)_1, Venti_1, Level(closet)_2, Venti_2
         Rearrange the data like this.

         ID  Index   Date       Ref.Level   Area    Level(closet)    Venti
         733 3       2013.06.18 T           42.1    NA                NA

请注意，Step1 和 Step2 都引用了 Level(closet)_1, Venti_1, Level(closet)_2, Venti_2 列中的值。区别在于步骤 2，当有 T.Date 和 T(Area) 的值时，期望 Level(closet) 值中的任何一个都将以 T* 开头，在第一个 ID 733 中没有 NONE。因此，转换后的数据集第 3 行的列 Level(closet), Venti 的值为 NA。第二个 ID 537 再次同时具有 T.Date 和 T(Area) 值，再次基于 Step2 我们查找以 T* 开头的 Level(closet) 列值，在这种情况下，Level(closet)_2 包含值 T11 所以对于宽ID 523 的 -to-long 转换数据将是

Step1：考虑列：ID、C.Date、C(Area)、Level(closet)_1、Venti_1、Level(closet)_2、Venti_2 像这样重新排列数据。

     ID  Index    Date       Ref.Level   Area    Level(closet)    Venti
     537  1       2015.10.01 C           34.5    C3                0

Step2：考虑列：ID、T.Date、T(Area)、Level(closet)_1、Venti_1、Level(closet)_2、Venti_2 像这样重新排列数据。

     ID  Index   Date       Ref.Level   Area    Level(closet)    Venti
     537  2      2015.15.01 T           27.2    T11                0

最终的预期数据集如下所示

     ID   Index   Date       Ref.Level   Area    Level(closet)    Venti
     733  1       2013.06.18 C           65.2    C6                0 
     733  2       2013.06.18 C           65.2    C3                1 
     733  3       2013.06.18 T           42.1    NA                NA 
     537  1       2015.10.01 C           34.5    C3                0 
     537  2       2015.15.01 T           27.2    T11               0 
     909  1       2016-01-14 C           15.1    NA                NA
     909  2       2016-01-14 T           25.9    T4                1
     909  3       2016-01-14 T           25.9    T2                1

抱歉，这有点复杂。从表面上看，这看起来像是在宽格式中取几行并将其重新整形为长格式，但是有一个嵌套的 ifelse 来查看Level(closet) 列中是否有任何以T* 开头的值。我完全空白如何以这样的长格式构造它。任何帮助或建议都非常有用。谢谢。

图书馆（tidyverse）

df <- tibble::tribble(~`ID`, ~`C.Date`, ~`T.Date`, ~`C(Area)`, ~`T(Area)`, ~`Level(closet)_1`, ~`Venti_1`, ~`Level(closet)_2`, ~`Venti_2`,
                "733", "2013.06.18", "2013.06.18", "65.2", "42.1", "C6", "0", "C3", "1",
                "537", "2015.10.01", "2015.15.01", "34.5", "27.2", "C3", "0", "T11", "0",
                "909", "2016-01-14", "2016-01-14", "15.1", "25.9", "T4", "1", "T2", "1"
                )

【问题讨论】：

您能否提供一个可重现的小数据示例？
@deschen，用数据更新了问题

标签： r reshape tidyr melt data-transform

【解决方案1】：

为简单起见，假设数据框中的所有列都是字符串格式。
然后您可以通过以下代码获得预期的数据集（但这绝对不是最好的方法）：

df %>% pivot_longer(cols=c(C.Date, T.Date, `C(Area)`, `T(Area)`)) %>%
  separate(col="name", into=c("Ref.Level", "name"), sep="(\\.)|(\\()") %>%
  mutate(name=str_replace(name, "\\)", "")) %>% pivot_wider() %>%
  pivot_longer(cols=c(`Level(closet)_1`, `Level(closet)_2`, Venti_1, Venti_2)) %>%
  separate(col="name", into=c("name", "index"), sep="_") %>% pivot_wider() %>% select(-index) %>%
  nest(data=c(`Level(closet)`, Venti)) %>% mutate(data=map2(data, Ref.Level, function(data, ref_level){
    data <- data %>% filter(str_detect(`Level(closet)`, ref_level))
    if(nrow(data)==0) data <- tibble(`Level(closet)`=NA_character_, Venti=NA_character_)
    return(data)
  })) %>% unnest(cols=data) %>% group_by(ID) %>% mutate(Index=row_number(), .after=ID) %>% ungroup(ID)

诀窍是首先将数据框更改为非常长的格式并嵌套Level(closet), Venti 列以过滤行。

【讨论】：

pivot_wider 步骤让我有些头疼。数据包含一些嵌套对象。这主要是由于重复读取某些行。后来我意识到添加一行来包含 row.numbers 可以解决这个问题。感谢您的建议。

【解决方案2】：

以下代码有效，您可以轻松地按照它进行操作，但可能不是执行此操作的有效方式，但确实可以完成工作。

library(tidyverse)

tibble::tribble(~`ID`, ~`C.Date`, ~`T.Date`, ~`C(Area)`, ~`T(Area)`, ~`Level(closet)_1`, ~`Venti_1`, ~`Level(closet)_2`, ~`Venti_2`,
                "733", "2013.06.18", "2013.06.18", "65.2", "42.1", "C6", "0", "C3", "1",
                "537", "2015.10.01", "2015.15.01", "34.5", "27.2", "C3", "0", "T11", "0",
                "909", "2016-01-14", "2016-01-14", "15.1", "25.9", "T4", "1", "T2", "1"
                ) -> df
df
#> # A tibble: 3 x 9
#>   ID    C.Date T.Date `C(Area)` `T(Area)` `Level(closet)_… Venti_1
#>   <chr> <chr>  <chr>  <chr>     <chr>     <chr>            <chr>  
#> 1 733   2013.… 2013.… 65.2      42.1      C6               0      
#> 2 537   2015.… 2015.… 34.5      27.2      C3               0      
#> 3 909   2016-… 2016-… 15.1      25.9      T4               1      
#> # … with 2 more variables: `Level(closet)_2` <chr>, Venti_2 <chr>

df %>% 
  mutate(across(c(1,4,5,7,9), as.numeric)) %>% 
  janitor::clean_names()-> df1

df1
#> # A tibble: 3 x 9
#>      id c_date t_date c_area t_area level_closet_1 venti_1 level_closet_2
#>   <dbl> <chr>  <chr>   <dbl>  <dbl> <chr>            <dbl> <chr>         
#> 1   733 2013.… 2013.…   65.2   42.1 C6                   0 C3            
#> 2   537 2015.… 2015.…   34.5   27.2 C3                   0 T11           
#> 3   909 2016-… 2016-…   15.1   25.9 T4                   1 T2            
#> # … with 1 more variable: venti_2 <dbl>
  
df1 %>% 
  select(id, c_date, c_area) -> df2

df2
#> # A tibble: 3 x 3
#>      id c_date     c_area
#>   <dbl> <chr>       <dbl>
#> 1   733 2013.06.18   65.2
#> 2   537 2015.10.01   34.5
#> 3   909 2016-01-14   15.1

df1 %>% 
  select(id, t_date, t_area) -> df3

df3
#> # A tibble: 3 x 3
#>      id t_date     t_area
#>   <dbl> <chr>       <dbl>
#> 1   733 2013.06.18   42.1
#> 2   537 2015.15.01   27.2
#> 3   909 2016-01-14   25.9

df1 %>% 
  select(id, level_closet_1, level_closet_2) %>% 
  pivot_longer(-1) %>% 
  left_join(df2) %>% 
  filter(str_detect(value, "C")) %>% 
  rename(date = c_date,
         area = c_area)-> c_df
#> Joining, by = "id"

c_df
#> # A tibble: 3 x 5
#>      id name           value date        area
#>   <dbl> <chr>          <chr> <chr>      <dbl>
#> 1   733 level_closet_1 C6    2013.06.18  65.2
#> 2   733 level_closet_2 C3    2013.06.18  65.2
#> 3   537 level_closet_1 C3    2015.10.01  34.5

df1 %>% 
  select(id, level_closet_1, level_closet_2) %>% 
  pivot_longer(-1) %>% 
  left_join(df3) %>% 
  filter(str_detect(value, "T")) %>% 
  rename(date = t_date,
         area = t_area) -> t_df
#> Joining, by = "id"

t_df
#> # A tibble: 3 x 5
#>      id name           value date        area
#>   <dbl> <chr>          <chr> <chr>      <dbl>
#> 1   537 level_closet_2 T11   2015.15.01  27.2
#> 2   909 level_closet_1 T4    2016-01-14  25.9
#> 3   909 level_closet_2 T2    2016-01-14  25.9

c_df %>% 
  bind_rows(t_df) -> ct_df

ct_df
#> # A tibble: 6 x 5
#>      id name           value date        area
#>   <dbl> <chr>          <chr> <chr>      <dbl>
#> 1   733 level_closet_1 C6    2013.06.18  65.2
#> 2   733 level_closet_2 C3    2013.06.18  65.2
#> 3   537 level_closet_1 C3    2015.10.01  34.5
#> 4   537 level_closet_2 T11   2015.15.01  27.2
#> 5   909 level_closet_1 T4    2016-01-14  25.9
#> 6   909 level_closet_2 T2    2016-01-14  25.9

df1 %>% 
  select(id, level_closet_1, venti_1) %>% 
  bind_rows(df1 %>% 
              select(id, level_closet_2, venti_2)) -> df_venti

t(apply(df_venti, 1, function(x) c(x[!is.na(x)], x[is.na(x)]))) -> df_venti[] 

df_venti
#> # A tibble: 6 x 5
#>   id    level_closet_1 venti_1 level_closet_2 venti_2
#>   <chr> <chr>          <chr>   <chr>          <chr>  
#> 1 733   C6             " 0"    <NA>           <NA>   
#> 2 537   C3             " 0"    <NA>           <NA>   
#> 3 909   T4             " 1"    <NA>           <NA>   
#> 4 733   C3             " 1"    <NA>           <NA>   
#> 5 537   T11            " 0"    <NA>           <NA>   
#> 6 909   T2             " 1"    <NA>           <NA>

df_venti %>% 
  select(1:3) %>% 
  rename(value = level_closet_1,
         venti = venti_1) %>% 
  mutate(venti = venti %>% as.numeric(),
         id = id %>% as.numeric()) -> venti_df2

venti_df2
#> # A tibble: 6 x 3
#>      id value venti
#>   <dbl> <chr> <dbl>
#> 1   733 C6        0
#> 2   537 C3        0
#> 3   909 T4        1
#> 4   733 C3        1
#> 5   537 T11       0
#> 6   909 T2        1

ct_df %>% 
  left_join(venti_df2) -> df_with_venti
#> Joining, by = c("id", "value")

df_with_venti
#> # A tibble: 6 x 6
#>      id name           value date        area venti
#>   <dbl> <chr>          <chr> <chr>      <dbl> <dbl>
#> 1   733 level_closet_1 C6    2013.06.18  65.2     0
#> 2   733 level_closet_2 C3    2013.06.18  65.2     1
#> 3   537 level_closet_1 C3    2015.10.01  34.5     0
#> 4   537 level_closet_2 T11   2015.15.01  27.2     0
#> 5   909 level_closet_1 T4    2016-01-14  25.9     1
#> 6   909 level_closet_2 T2    2016-01-14  25.9     1


df_with_venti %>%
  mutate(value = value %>% str_remove_all('[0-9]+')) %>% 
  mutate(mm = 1) %>% 
  complete(id, value, fill = list(mm = 0)) %>% 
  group_by(id, value) %>% 
  summarise(count = sum(mm)) %>% 
  filter(count == 0) -> missing_df
#> `summarise()` regrouping output by 'id' (override with `.groups` argument)

missing_df
#> # A tibble: 2 x 3
#> # Groups:   id [2]
#>      id value count
#>   <dbl> <chr> <dbl>
#> 1   733 T         0
#> 2   909 C         0

missing_df %>% 
  filter(value == "C") %>% 
  pull(id) -> c_missing

c_missing
#> [1] 909

missing_df %>% 
  filter(value == "T") %>% 
  pull(id) -> t_missing 

t_missing
#> [1] 733

df1 %>% 
  filter(id %in% c_missing) %>% 
  select(id, c_date, c_area) %>% 
  rename(date = c_date,
         area = c_area) %>% 
  mutate(ref_level = "C",
         value = NA,
         venti = NA) -> c_fill_df

c_fill_df
#> # A tibble: 1 x 6
#>      id date        area ref_level value venti
#>   <dbl> <chr>      <dbl> <chr>     <lgl> <lgl>
#> 1   909 2016-01-14  15.1 C         NA    NA

df1 %>% 
  filter(id %in% t_missing) %>% 
  select(id, t_date, t_area) %>% 
  rename(date = t_date,
         area = t_area) %>% 
  mutate(ref_level = "T",
         value = NA,
         venti = NA) -> t_fill_df

t_fill_df
#> # A tibble: 1 x 6
#>      id date        area ref_level value venti
#>   <dbl> <chr>      <dbl> <chr>     <lgl> <lgl>
#> 1   733 2013.06.18  42.1 T         NA    NA

df_with_venti %>% 
  select(id, date, area, value, venti) %>% 
  mutate(ref_level = value %>% str_remove_all('[0-9]+')) %>% 
  bind_rows(c_fill_df) %>% 
  bind_rows(t_fill_df) %>% 
  group_by(id) %>% 
  mutate(index = row_number()) %>% 
  arrange(id) %>% 
  select(id, index, date, ref_level, area, value, venti) %>% 
  rename(level_closet = value)
#> # A tibble: 8 x 7
#> # Groups:   id [3]
#>      id index date       ref_level  area level_closet venti
#>   <dbl> <int> <chr>      <chr>     <dbl> <chr>        <dbl>
#> 1   537     1 2015.10.01 C          34.5 C3               0
#> 2   537     2 2015.15.01 T          27.2 T11              0
#> 3   733     1 2013.06.18 C          65.2 C6               0
#> 4   733     2 2013.06.18 C          65.2 C3               1
#> 5   733     3 2013.06.18 T          42.1 <NA>            NA
#> 6   909     1 2016-01-14 T          25.9 T4               1
#> 7   909     2 2016-01-14 T          25.9 T2               1
#> 8   909     3 2016-01-14 C          15.1 <NA>            NA

^{由reprex package (v0.3.0) 于 2021-01-22 创建}

【讨论】：

@MohanGovindasmy ，您的解决方案中的 left joins 正在创建比预期更多的行。主要是由于一对多的情况。这造成了一些问题。我们假设如何修复这部分。谢谢。
@Science11 left_join 不应创建更多行，它将保留原始数据框中的所有行，如果第二个数据框中不存在密钥，则返回 NA。我无法理解代码的哪一部分导致了您提到的问题。可以指点一下吗？
您正在创建df_venti，这不包括日期列。然后它变为df_venti2。然后你将这个df_venti2 与ct_df 合并。 df_venti2 和 ct_df 都缺少日期列。如果left_join 仅基于id 执行，则忽略date。我们不知道这种合并是否准确。不仅仅是id，date 列也很重要。我们需要确保在date 上捕获id 的测量值，而不仅仅是基于id 的盲合并。这有意义吗？
我大量借鉴了您的想法，并在少数情况下修改了代码，并且成功了。再次感谢。
@Science11 很高兴我能提供帮助。抱歉没有解决最新的问题，因为给定的示例数据很难理解