按组嵌套数据框，但在每个组中包含额外的行答案

【问题标题】：Nest a dataframe by group, but include extra rows within each group按组嵌套数据框，但在每个组中包含额外的行
【发布时间】：2018-08-08 11:53:07
【问题描述】：

使用钻石数据集，我正在尝试运行回归模型，在每个切工级别内将颜色“D”与其他每种颜色进行比较（未在回归模型中指定交互作用）。

为此，我尝试创建按剪切和颜色分组的嵌套数据框，但在每个组中，我想要适当剪切的参考颜色“D”。

下面的代码没有做我想要的，因为每组颜色都不包含颜色“D”：

    library(tidyverse)

> diamonds %>% 
+     group_by(cut, color) %>% 
+     nest() %>% arrange(cut, color)
# A tibble: 35 x 3
   cut   color data              
   <ord> <ord> <list>            
 1 Fair  D     <tibble [163 x 8]>
 2 Fair  E     <tibble [224 x 8]>
 3 Fair  F     <tibble [312 x 8]>
 4 Fair  G     <tibble [314 x 8]>
 5 Fair  H     <tibble [303 x 8]>
 6 Fair  I     <tibble [175 x 8]>
 7 Fair  J     <tibble [119 x 8]>
 8 Good  D     <tibble [662 x 8]>
 9 Good  E     <tibble [933 x 8]>
10 Good  F     <tibble [909 x 8]>
# ... with 25 more rows

下面的代码可以完成这项工作，但我正在寻找一个 tidyverse 版本：

data_fair_de          =   diamonds %>% filter(cut=="Fair" & color %in% c("D", "E"))           %>%    mutate( grouping_var  =  "data_fair_de" )    
data_fair_df          =   diamonds %>% filter(cut=="Fair" & color %in% c("D", "F"))           %>%    mutate( grouping_var  =  "data_fair_df" )    
data_fair_dg          =   diamonds %>% filter(cut=="Fair" & color %in% c("D", "G"))           %>%    mutate( grouping_var  =  "data_fair_dg" )    
data_fair_dh          =   diamonds %>% filter(cut=="Fair" & color %in% c("D", "H"))           %>%    mutate( grouping_var  =  "data_fair_dh" )    
data_fair_di          =   diamonds %>% filter(cut=="Fair" & color %in% c("D", "I"))           %>%    mutate( grouping_var  =  "data_fair_di" )    
data_fair_dj          =   diamonds %>% filter(cut=="Fair" & color %in% c("D", "J"))           %>%    mutate( grouping_var  =  "data_fair_dj" )    
data_good_de          =   diamonds %>% filter(cut=="Good" & color %in% c("D", "E"))           %>%    mutate( grouping_var  =  "data_good_de "    )    
data_good_df          =   diamonds %>% filter(cut=="Good" & color %in% c("D", "F"))           %>%    mutate( grouping_var  =  "data_good_df "    )    
data_good_dg          =   diamonds %>% filter(cut=="Good" & color %in% c("D", "G"))           %>%    mutate( grouping_var  =  "data_good_dg "    )    
data_good_dh          =   diamonds %>% filter(cut=="Good" & color %in% c("D", "H"))           %>%    mutate( grouping_var  =  "data_good_dh "    )    
data_good_di          =   diamonds %>% filter(cut=="Good" & color %in% c("D", "I"))           %>%    mutate( grouping_var  =  "data_good_di "    )    
data_good_dj          =   diamonds %>% filter(cut=="Good" & color %in% c("D", "J"))           %>%    mutate( grouping_var  =  "data_good_dj "    )    
data_very_de          =   diamonds %>% filter(cut=="Very Good" & color %in% c("D", "E"))      %>%    mutate( grouping_var  =  "data_very_de "    )    
data_very_df          =   diamonds %>% filter(cut=="Very Good" & color %in% c("D", "F"))      %>%    mutate( grouping_var  =  "data_very_df "    )    
data_very_dg          =   diamonds %>% filter(cut=="Very Good" & color %in% c("D", "G"))      %>%    mutate( grouping_var  =  "data_very_dg "    )    
data_very_dh          =   diamonds %>% filter(cut=="Very Good" & color %in% c("D", "H"))      %>%    mutate( grouping_var  =  "data_very_dh "    )    
data_very_di          =   diamonds %>% filter(cut=="Very Good" & color %in% c("D", "I"))      %>%    mutate( grouping_var  =  "data_very_di "    )    
data_very_dj          =   diamonds %>% filter(cut=="Very Good" & color %in% c("D", "J"))      %>%    mutate( grouping_var  =  "data_very_dj "    )    
data_premium_de       =   diamonds %>% filter(cut=="Premium" & color %in% c("D", "E"))        %>%    mutate( grouping_var  =  "data_premium_de " )    
data_premium_df       =   diamonds %>% filter(cut=="Premium" & color %in% c("D", "F"))        %>%    mutate( grouping_var  =  "data_premium_df " )    
data_premium_dg       =   diamonds %>% filter(cut=="Premium" & color %in% c("D", "G"))        %>%    mutate( grouping_var  =  "data_premium_dg " )    
data_premium_dh       =   diamonds %>% filter(cut=="Premium" & color %in% c("D", "H"))        %>%    mutate( grouping_var  =  "data_premium_dh " )    
data_premium_di       =   diamonds %>% filter(cut=="Premium" & color %in% c("D", "I"))        %>%    mutate( grouping_var  =  "data_premium_di " )    
data_premium_dj       =   diamonds %>% filter(cut=="Premium" & color %in% c("D", "J"))        %>%    mutate( grouping_var  =  "data_premium_dj " )    
data_ideal_de         =   diamonds %>% filter(cut=="Ideal" & color %in% c("D", "E"))          %>%    mutate( grouping_var  =  "data_ideal_de "   )    
data_ideal_df         =   diamonds %>% filter(cut=="Ideal" & color %in% c("D", "F"))          %>%    mutate( grouping_var  =  "data_ideal_df "   )    
data_ideal_dg         =   diamonds %>% filter(cut=="Ideal" & color %in% c("D", "G"))          %>%    mutate( grouping_var  =  "data_ideal_dg "   )    
data_ideal_dh         =   diamonds %>% filter(cut=="Ideal" & color %in% c("D", "H"))          %>%    mutate( grouping_var  =  "data_ideal_dh "   )    
data_ideal_di         =   diamonds %>% filter(cut=="Ideal" & color %in% c("D", "I"))          %>%    mutate( grouping_var  =  "data_ideal_di "   )    
data_ideal_dj         =   diamonds %>% filter(cut=="Ideal" & color %in% c("D", "J"))          %>%    mutate( grouping_var  =  "data_ideal_dj "   )    

bind_rows( 
 data_fair_de   ,  data_fair_df   ,  data_fair_dg   ,  data_fair_dh   ,  data_fair_di   ,  data_fair_dj   , 
 data_good_de   ,  data_good_df   ,  data_good_dg   ,  data_good_dh   ,  data_good_di   ,  data_good_dj   , 
 data_very_de   ,  data_very_df   ,  data_very_dg   ,  data_very_dh   ,  data_very_di   ,  data_very_dj   , 
 data_premium_de,  data_premium_df,  data_premium_dg,  data_premium_dh,  data_premium_di,  data_premium_dj, 
 data_ideal_de  ,  data_ideal_df  ,  data_ideal_dg  ,  data_ideal_dh  ,  data_ideal_di  ,  data_ideal_dj  ) %>% 
    group_by(grouping_var) %>% 
    nest()

【问题讨论】：

您想在数据集中创建一个新变量吗？您可能需要expand 与“D”和所有其他“颜色”元素和“剪切”变量吗？
是的，我认为最好使用一个新变量，通过它我可以对数据集进行分组。我会调查expand，谢谢。

标签： r dplyr tidyverse

【解决方案1】：

我们可以按照你的想法，然后在嵌套的data.frames上循环，按组添加颜色行D，然后删除D行：

diamonds %>%
  nest(-cut,-color) %>%
  group_by(cut) %>%
  mutate(data = map(data, ~ bind_rows(data[[which(color=="D")]], .x))) %>%
  ungroup %>%
  filter(color != "D") %>%
  arrange(cut, color)
# # A tibble: 30 x 3
#       cut color                 data
#     <ord> <ord>               <list>
#   1  Fair     E   <tibble [387 x 8]>
#   2  Fair     F   <tibble [475 x 8]>
#   3  Fair     G   <tibble [477 x 8]>
#   4  Fair     H   <tibble [466 x 8]>
#   5  Fair     I   <tibble [338 x 8]>
#   6  Fair     J   <tibble [282 x 8]>
#   7  Good     E <tibble [1,595 x 8]>
#   8  Good     F <tibble [1,571 x 8]>
#   9  Good     G <tibble [1,533 x 8]>
#  10  Good     H <tibble [1,364 x 8]>
#   # ... with 20 more rows

【讨论】：

谢谢。使用该输出，我如何运行此模型：glm(price ~ color) 用于cut 的每个级别，其中变量颜色对于每个级别的切割都有两个级别（颜色中的两个级别将是颜色“D”和另一种颜色)?

【解决方案2】：

如果您想将 D 添加到每个组中，您只需在每个组中附加适当的“D”

df <- diamonds %>% 
    group_by(cut, color) %>% 
    nest() %>% 
    arrange(cut, color) %>%
    ungroup()%>%
    group_by(cut) %>%
    mutate(append_data = map(data, ~rbind(.x, data[[which(row_number() == 1)]])))

df
#    cut   color data               append_data         
#  1 Fair  D     <tibble [163 × 8]> <tibble [326 × 8]>  
#  2 Fair  E     <tibble [224 × 8]> <tibble [387 × 8]>  
#  3 Fair  F     <tibble [312 × 8]> <tibble [475 × 8]>  
#  4 Fair  G     <tibble [314 × 8]> <tibble [477 × 8]>  
#  5 Fair  H     <tibble [303 × 8]> <tibble [466 × 8]> 
#  # ... with 30 more rows

这应该会给你一个新的嵌套列，每组也有 D。

【讨论】：

【解决方案3】：

library(tidyverse)

# function to get data based on your filter
f = function(xx,yy,zz) {diamonds %>% filter(cut==xx & color %in% c(yy,zz))}

expand(diamonds, cut, color, color_D="D") %>%              # create all combinations of interest
  mutate_all(as.character) %>%                             # update to character variables
  rowwise() %>%                                            # for each row
  mutate(data = list(f(cut, color, color_D))) %>%          # apply your function
  ungroup() %>%                                            # forget the grouping
  filter(color != color_D)                                 # exclude cases where pair of colours is {D,D}

# # A tibble: 30 x 4
#     cut   color color_D data                 
#     <chr> <chr> <chr>   <list>               
#   1 Fair  E     D       <tibble [387 x 10]>  
#   2 Fair  F     D       <tibble [475 x 10]>  
#   3 Fair  G     D       <tibble [477 x 10]>  
#   4 Fair  H     D       <tibble [466 x 10]>  
#   5 Fair  I     D       <tibble [338 x 10]>  
#   6 Fair  J     D       <tibble [282 x 10]>  
#   7 Good  E     D       <tibble [1,595 x 10]>
#   8 Good  F     D       <tibble [1,571 x 10]>
#   9 Good  G     D       <tibble [1,533 x 10]>
#  10 Good  H     D       <tibble [1,364 x 10]>
#   # ... with 20 more rows

【讨论】：