如何拆分某些列的某些子級別的數據框並在全局應用模型

Question

我以菱形數據集爲例。我可以通過剪切和顏色分割數據集，然後應用模型並提取r-平方，如下所示。

diamonds %>% group_by(cut, color) %>% 
      do(model=lm(price~carat, data=.)) %>% 
      mutate(r2 = summary(model)$adj.r.squared) %>% 
      select(-model) 

問題是，如果我只想通過剪切和顏色中的某些子級別對數據進行分組。例如：

cut_sub<- as.factor(c('Good','Fair')) 
color_sub <- as.factor(c('E', 'J')) 

我應該如何修改上面的代碼以實現該目的？我嘗試了Google搜索，但找不到解決方案。

Answer 1

下面是使用一個想法purrr devel的v0.2.2.9000

diamonds %>% 
    filter(cut %in% c("Fair", "Good"), 
     color %in% c("E", "J")) %>% 
    group_by(cut, color) %>% 
    nest() %>% 
    mutate(model = map(data, .f = ~lm(price ~ carat, data = .)) %>% 
      map(summary) %>% map_dbl("adj.r.squared")) 

其中給出：

## A tibble: 4 x 4 
# cut color    data  model 
# <ord> <ord>    <list>  <dbl> 
#1 Good  E <tibble [933 x 8]> 0.8298957 
#2 Good  J <tibble [307 x 8]> 0.9176254 
#3 Fair  E <tibble [224 x 8]> 0.8092058 
#4 Fair  J <tibble [119 x 8]> 0.7567011 

Answer 2

下面是做到這一點的purrr方式：

diamonds %>% 
    filter(cut %in% c("Fair", "Good"), 
     color %in% c("E", "J")) %>% 
    slice_rows(c("cut", "color")) %>% 
    by_slice(function(.x) { 
    lm(price~carat, data = .x) %>% 
     summary %>% 
     .$adj.r.squared 
    }, .to = "r2") %>% 
    unnest(r2)