R 数据可视化 —— ggplot 统计图层

前言

虽然我们介绍了这么多节的 ggplot2,我们在绘制图层时基本上使用的都是 geom_*() 函数,却很少使用 stat_*() 函数。

当然,使用 geom_*() 函数已经可以完成绝大部分的绘图工作了,那还有必要使用 stat_*() 函数吗?

我们来看一例子,假设有如下数据

> select(diamonds, cut, price)
# A tibble: 53,940 x 2
   cut       price
   <ord>     <int>
 1 Ideal       326
 2 Premium     326
 3 Good        327
 4 Premium     334
 5 Good        335
 6 Very Good   336
 7 Very Good   336
 8 Very Good   337
 9 Fair        337
10 Very Good   338
# … with 53,930 more rows

我们想要绘制一个柱状图,用于展示每种切工的平均价格。

常规的方法是,使用 tidyverse 的函数来对数据进行整理,然后计算出需要的统计数值,并映射到相应的图形属性,即

select(diamonds, cut, price) %>%
  group_by(cut) %>%
  summarise(
    mean_price = mean(price),
    .groups = "drop"
  ) %>%
  ggplot(aes(cut, mean_price, fill = cut)) +
  geom_col()

现在,我们并不满足于此。现在,我们想要在柱状图上添加误差线

当然,这也很简单,我们可以再对数据进行统计计算,然后绘制

select(diamonds, cut, price) %>%
  group_by(cut) %>%
  summarise(
    mean_price = mean(price),
    .groups = "drop",
    se = sqrt(var(price)/length(price))
  ) %>%
  mutate(lower = mean_price - se, upper = mean_price + se) %>%
  ggplot(aes(cut, mean_price, fill = cut)) +
  geom_col() +
  geom_errorbar(aes(ymin = lower, ymax = upper), width = 0.5)

en...,为了绘制这么一个简单的图片,我们写的代码比图片都长。

因为我们的观念还停留在,先准备好数据,然后将数据映射到图形属性。

这样就导致需要对数据进行很多统计计算,并不符合数据的整洁之道。

我们可以这样想,既然所有的统计信息都来源于同一个数据,那我们何不直接将数据传递给 ggplot,让数据的统计计算在内部进行呢?

我们可以这样改写

select(diamonds, cut, price) %>%
  ggplot(aes(cut, price, fill = cut)) +
  stat_summary(geom = "bar") +
  stat_summary(geom = "errorbar", width = 0.5)

两行代码就能搞定,为啥要写那么多呢,节约的时间喝杯茶多好。

原理解析

学习和理解了 stat_summary 函数的工作原理,那么其他的 stat_* 函数也就很好理解了。

那我们该如何理解 stat_summary 呢?还是来举个例子吧

使用上面的数据,我们绘制切工与价格的点图

select(diamonds, cut, price) %>%
  ggplot(aes(cut, price, colour = cut)) +
  geom_point()

然后使用不带参数的 stat_summary 来替换 geom_point 看看会发生什么

select(diamonds, cut, price) %>%
  ggplot(aes(cut, price, colour = cut)) +
  stat_summary()

绘制的是 pointrange 对象。

我们先看看 stat_summary 函数

stat_summary(
  mapping = NULL,
  data = NULL,
  geom = "pointrange",
  position = "identity",
  ...,
  fun.data = NULL,
  fun = NULL,
  fun.max = NULL,
  fun.min = NULL,
  fun.args = list(),
  na.rm = FALSE,
  orientation = NA,
  show.legend = NA,
  inherit.aes = TRUE,
  fun.y,
  fun.ymin,
  fun.ymax
)

默认绘制的是 pointrange,那 pointrange 需要定义哪些属性映射呢?

  • xy
  • yminxmin
  • ymaxxmax

但是,我们并没有定义 yminymax,那应该是 stat_summary 计算出了相应的值,并传递给 pointrange

如何验证我们的猜想?首先,我们看到运行上述代码会输出一个警告信息

No summary function supplied, defaulting to `mean_se()`

也就是说,默认情况下会应用 mean_se() 函数变换

我们来看看 mean_se() 做了什么操作

> mean_se
function (x, mult = 1) 
{
    x <- stats::na.omit(x)
    se <- mult * sqrt(stats::var(x)/length(x))
    mean <- mean(x)
    new_data_frame(list(y = mean, ymin = mean - se, ymax = mean + 
        se), n = 1)
}
<bytecode: 0x7fca56dfa5d0>
<environment: namespace:ggplot2>

我们可以看到,该函数返回的数据框包含三个值,正好是 pointrange 所需要传入的参数

我们可以使用 layer_data() 函数,来提取图层中使用的数据

> p <- select(diamonds, cut, price) %>%
+   ggplot(aes(cut, price, colour = cut)) +
+   stat_summary()
>
> layer_data(p, 1)
No summary function supplied, defaulting to `mean_se()`
     colour x group        y     ymin     ymax PANEL flipped_aes size linetype shape fill alpha stroke
1 #440154FF 1     1 4358.758 4270.025 4447.491     1       FALSE  0.5        1    19   NA    NA      1
2 #3B528BFF 2     2 3928.864 3876.302 3981.426     1       FALSE  0.5        1    19   NA    NA      1
3 #21908CFF 3     3 3981.760 3945.953 4017.567     1       FALSE  0.5        1    19   NA    NA      1
4 #5DC863FF 4     4 4584.258 4547.223 4621.293     1       FALSE  0.5        1    19   NA    NA      1
5 #FDE725FF 5     5 3457.542 3431.600 3483.484     1       FALSE  0.5        1    19   NA    NA      1

然后与使用 mean_se() 函数的计算结果对比

> select(diamonds, cut, price) %>%
+   group_by(cut) %>%
+   summarise(mean_se(price))
# A tibble: 5 x 4
  cut           y  ymin  ymax
* <ord>     <dbl> <dbl> <dbl>
1 Fair      4359. 4270. 4447.
2 Good      3929. 3876. 3981.
3 Very Good 3982. 3946. 4018.
4 Premium   4584. 4547. 4621.
5 Ideal     3458. 3432. 3483.

我们可以看到,yyminymax 这三个参数的值与 mean_se() 的计算结果是一致的

使用

既然可以定了变换函数,那我们定义自己的统计变换,就可以根据需要对图形进行一些个性化调整了。

stat_summary() 函数的参数 fun.data 可以指定统计变换函数,默认为 mean_se()

fun.data 传入的函数,要求返回数据框,而数据框变量名为属性映射参数

下面我们来绘制一些个性化的图片

1. 95% 置信区间误差线

select(diamonds, cut, price) %>%
  ggplot(aes(cut, price, fill = cut)) +
  stat_summary(geom = "bar") +
  stat_summary(
    geom = "errorbar", width = 0.5,
    fun.data = ~mean_se(., mult = 1.96)
  )

注意:我们使用 ~ 符号来构造匿名函数,相当于

function(x) {mean_se(x, mult = 1.96)}

2. 指定填充色

我们使用变换函数来设置满足条件的分组的颜色,将分组的中值大于和小于阈值的组用颜色分开

func_median_color <- function(x, cut_off) {
  tibble(y = median(x)) %>%
    mutate(fill = if_else(y < cut_off, "#80b1d3", "#fb8072"))
}

select(diamonds, cut, price) %>%
  ggplot(aes(cut, price)) +
  stat_summary(
    fun.data = func_median_color,
    fun.args = c(cut_off = 2800),
    geom = "bar"
  )
image

我们将额外的参数传递给 fun.args,替换匿名函数的方式,即相当于

fun.data = ~ func_median_color(., cut_off = 2800)

3. 设置点线图点的大小

我们根据分组中的观测值的数目来设置点线图中点的大小

select(diamonds, cut, price) %>%
  ggplot(aes(cut, price, colour = cut)) +
  stat_summary(
    fun.data = function(x) {
      mean_se(x) %>%
        mutate(size = length(x) * 5 / nrow(diamonds))
    }
  )
©著作权归作者所有,转载或内容合作请联系作者
  • 序言:七十年代末,一起剥皮案震惊了整个滨河市,随后出现的几起案子,更是在滨河造成了极大的恐慌,老刑警刘岩,带你破解...
    沈念sama阅读 215,539评论 6 497
  • 序言:滨河连续发生了三起死亡事件,死亡现场离奇诡异,居然都是意外死亡,警方通过查阅死者的电脑和手机,发现死者居然都...
    沈念sama阅读 91,911评论 3 391
  • 文/潘晓璐 我一进店门,熙熙楼的掌柜王于贵愁眉苦脸地迎上来,“玉大人,你说我怎么就摊上这事。” “怎么了?”我有些...
    开封第一讲书人阅读 161,337评论 0 351
  • 文/不坏的土叔 我叫张陵,是天一观的道长。 经常有香客问我,道长,这世上最难降的妖魔是什么? 我笑而不...
    开封第一讲书人阅读 57,723评论 1 290
  • 正文 为了忘掉前任,我火速办了婚礼,结果婚礼上,老公的妹妹穿的比我还像新娘。我一直安慰自己,他们只是感情好,可当我...
    茶点故事阅读 66,795评论 6 388
  • 文/花漫 我一把揭开白布。 她就那样静静地躺着,像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上,一...
    开封第一讲书人阅读 50,762评论 1 294
  • 那天,我揣着相机与录音,去河边找鬼。 笑死,一个胖子当着我的面吹牛,可吹牛的内容都是我干的。 我是一名探鬼主播,决...
    沈念sama阅读 39,742评论 3 416
  • 文/苍兰香墨 我猛地睁开眼,长吁一口气:“原来是场噩梦啊……” “哼!你这毒妇竟也来了?” 一声冷哼从身侧响起,我...
    开封第一讲书人阅读 38,508评论 0 271
  • 序言:老挝万荣一对情侣失踪,失踪者是张志新(化名)和其女友刘颖,没想到半个月后,有当地人在树林里发现了一具尸体,经...
    沈念sama阅读 44,954评论 1 308
  • 正文 独居荒郊野岭守林人离奇死亡,尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 37,247评论 2 331
  • 正文 我和宋清朗相恋三年,在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 39,404评论 1 345
  • 序言:一个原本活蹦乱跳的男人离奇死亡,死状恐怖,灵堂内的尸体忽然破棺而出,到底是诈尸还是另有隐情,我是刑警宁泽,带...
    沈念sama阅读 35,104评论 5 340
  • 正文 年R本政府宣布,位于F岛的核电站,受9级特大地震影响,放射性物质发生泄漏。R本人自食恶果不足惜,却给世界环境...
    茶点故事阅读 40,736评论 3 324
  • 文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹,春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 31,352评论 0 21
  • 文/苍兰香墨 我抬头看了看天上的太阳。三九已至,却和暖如春,着一层夹袄步出监牢的瞬间,已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 32,557评论 1 268
  • 我被黑心中介骗来泰国打工, 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留,地道东北人。 一个月前我还...
    沈念sama阅读 47,371评论 2 368
  • 正文 我出身青楼,却偏偏与公主长得像,于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子,可洞房花烛夜当晚...
    茶点故事阅读 44,292评论 2 352

推荐阅读更多精彩内容