colwise.Rmd

# 列方向和行方向 {#colwise}

dplyr宏包是数据科学tidyverse集合的核心部件之一，Hadley  Wickham大神说将会在5月15日发布dplyr 1.0版本，欢呼。

为迎接新时代的到来，我在线上同大家一起分享dplyr 1.0版本新的特点和功能，看看都为我们带来哪些惊喜？


## 体验新版本

New dplyr - 8 things to know:

1) Built in tidyselect 
2) relocate() 
3) Superpowered summarise() 
4) colwise using across() 
5) cur_data() cur_group() and cur_column()
6) new rowwise() grammar 
7) easy modeling inside dataframes 
8) nest_by()  


```{r, eval=FALSE}
devtools::install_github("tidyverse/dplyr")
```


```{r message = FALSE, warning = FALSE}
library(dplyr, warn.conflicts = FALSE)
library(tidyr)
```


## 简单回顾
```{r, eval=FALSE}
mutate()
select()
filter()
group_by()
summarise()
arrange()
rename()
left_join()
```




## summarise()更强大了

在dplyr 1.0之前，`summarise()`会把统计结果整理成一行一列的数据框，现在可以根据函数返回的结果，可以有多种形式：

- 长度为 1 的向量，比如，`min(x), n(), or sum(is.na(y))`
- **长度为 n 的向量**，比如，`quantile()`
- **数据框**


```{r}
df <- tibble(
  grp = rep(c("a", "b"), each = 5),
  x = c(rnorm(5, -0.25, 1), rnorm(5, 0, 1.5)),
  y = c(rnorm(5, 0.25, 1), rnorm(5, 0, 0.5))
)
df
```


```{r}
df %>%
  group_by(grp) %>%
  summarise(rng = mean(x))
```

当统计函数返回多个值的时候，比如`range()`返回是最小值和最大值，`summarise()`很贴心地将结果整理成多行，这样符合tidy的格式。
```{r}
df %>%
  group_by(grp) %>%
  summarise(rng = range(x))
```

类似的还有`quantile()`函数，也是返回多个值
```{r}
df %>%
  group_by(grp) %>%
  summarise(
    rng = quantile(x, probs = c(0.05, 0.5, 0.95))
  )
```

```{r}
df %>%
  group_by(grp) %>%
  summarise(
    x = quantile(x, c(0.25, 0.5, 0.75)),
    q = c(0.25, 0.5, 0.75)
  )
```



`summarise()`可以输出数据框，比如

```{r}
my_quantile <- function(x, probs) {
  tibble(x = quantile(x, probs), probs = probs)
}
mtcars %>%
  group_by(cyl) %>%
  summarise(my_quantile(disp, c(0.25, 0.75)))
```


再比如：

dplyr 1.0 之前是需要`group_modify()`来实现`数据框进，数据框出`
```{r}
mtcars %>%
  group_by(cyl) %>%
  group_modify(
    ~ broom::tidy(lm(mpg ~ wt, data = .))
  )
```


dplyr 1.0 之后，有了新的方案

```{r}
mtcars %>%
  group_by(cyl) %>%
  summarise(
    broom::tidy(lm(mpg ~ wt))
  )
```






## summarise()后的分组信息是去是留？

当 `group_by()`与`summarise()`配合使用的时候，`summarise()`默认会**抵消掉**最近一次的分组信息，比如下面按照`cyl`和`vs`分组，但`summarise()`后，就只剩下`cyl`的分组信息了。

```{r}
mtcars %>%
  group_by(cyl, vs) %>%
  summarise(cyl_n = n())
```


```{r}
mtcars %>%
  group_by(cyl, vs) %>%
  summarise(cyl_n = n()) %>%
  group_vars()
```

如果想保留vs的分组信息，就需要设置`.groups = keep`参数
```{r}
mtcars %>%
  group_by(cyl, vs) %>%
  summarise(cyl_n = n(), .groups = "keep") %>%
  group_vars()
```


当然`summarise()`可以控制输出的更多形式

- 丢弃所有的分组信息
```{r}
mtcars %>%
  group_by(cyl, vs) %>%
  summarise(cyl_n = n(), .groups = "drop") %>%
  group_vars()
```

- 变成行方向分组，即，每行是一个分组
```{r}
mtcars %>%
  group_by(cyl, vs) %>%
  summarise(cyl_n = n(), .groups = "rowwise") %>%
  group_vars()
```




## 选择某列

- 通过位置索引进行选取
```{r}
df %>% select(1, 3)
df %>% select(2:3)
```

- 通过列名
```{r}
df %>% select(grp, x, y)
df %>% select(x:y)
```

- 通过函数选取
```{r}
df %>% select(starts_with("x"))
df %>% select(ends_with("p"))
df %>% select(contains("x"))
df %>% select(matches("x"))
```

- 通过类型
```{r}
df %>% select(is.character)
df %>% select(is.numeric)
```



- 通过各种组合
```{r}
df %>% select(!is.character)
df %>% select(is.numeric & starts_with("x"))
df %>% select(starts_with("g") | ends_with("y"))
```

```{r, eval=FALSE}
# 注意any_of和all_of的区别

vars <- c("x", "y", "z")
df %>% select(all_of(vars))
df %>% select(any_of(vars))
```



## 重命名某列
```{r}
df %>% rename(group = grp)
```


```{r}
df %>% rename_with(toupper)
df %>% rename_with(toupper, is.numeric)
df %>% rename_with(toupper, starts_with("x"))
```

## 调整列的位置

我们前面一章讲过`arrange()`排序，这是行方向的排序， 比如按照x变量绝对值的大小从高到低排序。
```{r}
df %>% arrange(desc(abs(x)))
```


我们现在想调整**列的位置**，比如，这里调整数据框三列的位置，让`grp`列放在`x`列的后面
```{r}
df %>% select(x, grp, y)
```

如果列变量很多的时候，上面的方法就不太好用，因此推荐大家使用`relocate()`
```{r}
df %>% relocate(grp, .after = y)
df %>% relocate(x, .before = grp)
```

还有
```{r}
df %>% relocate(grp, .after = last_col())
```



## 强大的across函数

我们必须为这个函数点赞。大爱Hadley Wickham !!!

我们经常需要对数据框的**多列**执行相同的操作。比如

```{r}
iris
```

```{r}
iris %>%
  group_by(Species) %>%
  summarise(
    mean_Sepal_Length = mean(Sepal.Length),
    mean_Sepal_Width = mean(Sepal.Width),
    mean_Petal_Length = mean(Petal.Length),
    mean_Petal_Width = mean(Petal.Width)
  )
```

dplyr 1.0之后，使用`across()`函数异常简练
```{r}
iris %>%
  group_by(Species) %>%
  summarise(
    across(everything(), mean)
  )
```

或者更科学的
```{r}
iris %>%
  group_by(Species) %>%
  summarise(
    across(is.numeric, mean)
  )
```

可以看到，以往是一列一列的处理，现在对**多列同时操作**，这主要得益于`across()`函数，它有两个主要的参数：
```{r, eval = FALSE}
across(.cols = , .fns = )
```

- 第一个参数.cols，选取我们要需要的若干列，选取多列的语法与`select()`的语法一致
- 第二个参数.fns，我们要执行的函数（或者多个函数），函数的语法有三种形式可选：
  - A function, e.g. mean.
  - A purrr-style lambda, e.g. ~ mean(.x, na.rm = TRUE)
  - A list of functions/lambdas, e.g. list(mean = mean, n_miss = ~ sum(is.na(.x))



再看看这个案例

```{r}
std <- function(x) {
  (x - mean(x)) / sd(x)
}

iris %>%
  group_by(Species) %>%
  summarise(
    across(starts_with("Sepal"), std)
  )

# purrr style
iris %>%
  group_by(Species) %>%
  summarise(
    across(starts_with("Sepal"), ~ (.x - mean(.x)) / sd(.x))
  )
```



```{r}
iris %>%
  group_by(Species) %>%
  summarise(
    across(starts_with("Petal"), list(min = min, max = max))
    # across(starts_with("Petal"), list(min = min, max = max), .names = "{fn}_{col}")
  )
```



```{r}
iris %>%
  group_by(Species) %>%
  summarise(
    across(starts_with("Sepal"), mean),
    Area = mean(Petal.Length * Petal.Width),
    across(c(Petal.Width), min),
    n = n()
  )
```


除了在`summarise()`里可以使用外，在其它函数也是可以使用的
```{r}
iris %>% mutate(across(is.numeric, mean))
iris %>% mutate(across(starts_with("Sepal"), mean))

iris %>% mutate(across(is.numeric, std)) # std function has defined before

iris %>% mutate(
  across(is.numeric, ~ .x / 2),
  across(is.factor, stringr::str_to_upper)
)
```



## "current" group or "current" variable

- `n()`, 返回当前分组的多少行
- `cur_data()`, 返回当前分组的数据内容（不包含分组变量）
- `cur_group()`, 返回当前分组的分组变量（一行一列的数据框）
- `across(cur_column())`, 返回当前列的列名

这些函数**返回当前分组的信息**，因此只能在特定函数内部使用，比如`summarise()` and `mutate()`


```{r}
df <- tibble(
  g = sample(rep(letters[1:3], 1:3)),
  x = runif(6),
  y = runif(6)
)
df
```


```{r}
df %>%
  group_by(g) %>%
  summarise(
    n = n()
  )
```


```{r}
df %>%
  group_by(g) %>%
  summarise(
    data = list(cur_group())
  )
```



```{r}
df %>%
  group_by(g) %>%
  summarise(
    data = list(cur_data())
  )
```


```{r}
mtcars %>%
  group_by(cyl) %>%
  summarise(
    broom::tidy(lm(mpg ~ wt, data = cur_data()))
  )
```



```{r}
df %>%
  group_by(g) %>%
  mutate(across(everything(), ~ paste(cur_column(), round(.x, 2))))
```



```{r}
wt <- c(x = 0.2, y = 0.8)

df %>%
  mutate(
    across(c(x, y), ~ .x * wt[cur_column()])
  )
```

## 行方向操作

数据框中向量de方向，事实上可以看做有两个方向，横着看是row-vector，竖着看是col-vector。
```{r out.width = '100%', fig.align='left', echo = FALSE}
knitr::include_graphics(path = "images/vctr.png")
```

tidyverse遵循的tidy原则，一列表示一个变量，一行表示一次观察。
这种数据的存储格式，对ggplot2很方便，但对**行方向**的操作或者运算不同友好。比如

### 行方向上的统计
```{r}
df <- tibble(id = letters[1:6], w = 10:15, x = 20:25, y = 30:35, z = 40:45)
df
```

计算每行的均值，
```{r}
df %>% mutate(avg = mean(c(w, x, y, z)))
```
好像不对？为什么呢？




- 按照tidy的方法
```{r}
df %>%
  pivot_longer(
    cols = -id,
    names_to = "variable",
    values_to = "value"
  ) %>%
  group_by(id) %>%
  summarize(
    r_mean = mean(value)
  )
```
如果保留原始数据，就还需要再`left_join()`一次，虽然思路清晰，但还是挺周转的。


- 按照Jenny Bryan的方案，使用`purrr`宏包的`pmap_dbl`函数
```{r}
library(purrr)
df %>%
  mutate(r_mean = pmap_dbl(select_if(., is.numeric), lift_vd(mean)))
```
但需要学习新的语法，代价也很高。



- `rowwise()`

```{r}
df %>%
  rowwise() %>%
  mutate(avg = mean(c(w, x, y, z)))
```
变量名要是很多的话，又变了体力活了，怎么才能变的轻巧一点呢？



- `rowwise() + c_across()`，现在dplyr 1.0终于给出了一个很好的解决方案

```{r}
df %>%
  rowwise() %>%
  mutate(
    avg = mean(c_across(w:z))
  )
```

这个很好的解决方案中，`rowwise()`工作原理类似与`group_by()`，是按每一行进行分组，然后按行（行方向）统计

```{r}
df %>%
  rowwise(id) %>%
  mutate(total = mean(c_across(w:z)))


df %>%
  rowwise(id) %>%
  mutate(mean = mean(c_across(is.numeric)))


df %>%
  rowwise(id) %>%
  summarise(
    m = mean(c_across(is.numeric))
  )
```


因此，我们可以总结成下面这张图

```{r out.width = '100%', fig.align='left', echo = FALSE}
knitr::include_graphics(path = "images/colwise_vs_rowwise.jpg")
```

### 行方向处理与列表列是天然一对

`rowwise()`不仅仅用于计算行方向均值这样的简单统计，而是当处理**列表列**时，方才显示出`rowwise()`与`purrr::map`一样的强大。那么，什么是**列表列**？
**列表列**指的是数据框的一列是一个列表， 比如

```{r}
tb <- tibble(
  x = list(1, 2:3, 4:6)
)
```

如果想显示列表中每个元素的长度，用purrr包，可以这样写
```{r}
tb %>% mutate(l = purrr::map_int(x, length))
```

如果从行方向的角度理解，其实很简练
```{r}
tb %>%
  rowwise() %>%
  mutate(l = length(x))
```




### 行方向上的建模
```{r}
mtcars
```

以cyl分组，计算每组中`mpg ~ wt`的线性模型的系数.

```{r}
mtcars %>%
  group_by(cyl) %>%
  nest()
```


#### 列方向的做法

分组建模后，形成**列表列**，此时列表中的每个元素对应一个模型，我们需要依次提取每次模型的系数，列方向的做法是，借用`purrr::map`完成列表中每个模型的迭代，

```{r}
mtcars %>%
  group_by(cyl) %>%
  nest() %>%
  mutate(model = purrr::map(data, ~ lm(mpg ~ wt, data = .))) %>%
  mutate(result = purrr::map(model, ~ broom::tidy(.))) %>%
  unnest(result)
```

用`purrr::map`实现列表元素一个一个的依次迭代，从数据框的角度来看（数据框是列表的一种特殊形式），因此实质上就是一行一行的处理。所以，尽管purrr很强大，但需要一定学习成本，从解决问题的路径上也比较周折。




#### 行方向的做法

事实上，分组建模后，形成**列表列**，这种存储格式，天然地符合**行处理的范式**，因此一开始就使用行方向分组（这里`nest_by()` 类似于 `group_by()`）


```{r}
mtcars %>%
  nest_by(cyl) %>%
  mutate(model = list(lm(mpg ~ wt, data = data))) %>%
  summarise(broom::tidy(model))
```


```{r}
# or
mtcars %>%
  nest_by(cyl) %>%
  summarise(
    broom::tidy(lm(mpg ~ wt, data = data))
  )
```


至此，tidyverse框架下，实现分组统计中的`数据框进，数据框输出`， 现在有四种方法了
```{r,eval = FALSE}
mtcars %>%
  group_nest(cyl) %>%
  mutate(model = purrr::map(data, ~ lm(mpg ~ wt, data = .))) %>%
  mutate(result = purrr::map(model, ~ broom::tidy(.))) %>%
  tidyr::unnest(result)


mtcars %>%
  group_by(cyl) %>%
  group_modify(
    ~ broom::tidy(lm(mpg ~ wt, data = .))
  )


mtcars %>%
  nest_by(cyl) %>%
  summarise(
    broom::tidy(lm(mpg ~ wt, data = data))
  )


mtcars %>%
  group_by(cyl) %>%
  summarise(
    broom::tidy(lm(mpg ~ wt, data = cur_data()))
  )

# or
mtcars %>%
  group_by(cyl) %>%
  summarise(broom::tidy(lm(mpg ~ wt)))
```





## 参考资料

- https://dplyr.tidyverse.org/dev/articles/rowwise.html
- https://dplyr.tidyverse.org/dev/articles/colwise.html







```{r, echo = F}
# remove the objects
# rm(list=ls())
rm(df, my_quantile, std, tb, wt)
```

```{r, echo = F, message = F, warning = F, results = "hide"}
pacman::p_unload(pacman::p_loaded(), character.only = TRUE)
```