时间戳

首页 > 解决方案 > sec.axis() 对每个方面都有不同的转换

r - sec.axis() 对每个方面都有不同的转换

问题描述

我想构建一个按区域分面的图，其中 y 轴是该区域的病例数，第二个 y 轴是每 10 万人口的病例数。

由于每个地区都有不同的人口，因此每个地区的转变都会有所不同。

我可以用 sec.axis() 做到这一点吗？

基本上是这样，但我想添加一个辅助 y 轴，显示每 100k 的病例数，因为安大略的人口是 1200 万，魁北克的人口是 800 万（所以将病例除以人口，然后乘以 10 万）

cases <- tibble::tribble(
  ~province, ~date_report, ~avg_cases_last7,
  "Ontario", "2020-08-26",              111,
  "Quebec", "2020-08-26", 89.8571428571429,
  "Ontario", "2020-08-27", 116.857142857143,
  "Quebec", "2020-08-27", 93.4285714285714,
  "Ontario", "2020-08-28", 113.142857142857,
  "Quebec", "2020-08-28", 89.8571428571429,
  "Ontario", "2020-08-29", 118.285714285714,
  "Quebec", "2020-08-29", 90.4285714285714,
  "Ontario", "2020-08-30", 117.714285714286,
  "Quebec", "2020-08-30",               97,
  "Ontario", "2020-08-31", 117.571428571429,
  "Quebec", "2020-08-31", 107.285714285714,
  "Ontario", "2020-09-01", 124.571428571429,
  "Quebec", "2020-09-01", 115.857142857143,
  "Ontario", "2020-09-02", 126.714285714286,
  "Quebec", "2020-09-02", 114.428571428571,
  "Ontario", "2020-09-03", 128.428571428571,
  "Quebec", "2020-09-03", 125.285714285714,
  "Ontario", "2020-09-04", 130.142857142857,
  "Quebec", "2020-09-04", 141.857142857143,
  "Ontario", "2020-09-05", 136.285714285714,
  "Quebec", "2020-09-05", 151.428571428571
) %>%
  mutate(date_report = as.Date(date_report))

ggplot(cases, aes(x= date_report, y = avg_cases_last7)) + 
  geom_line() +
  facet_wrap(~province,  scales = "free")

标签： rggplot2

解决方案

不确定是否有一种方法可以使用简单的刻面来完成这项工作。相反，我会去使用patchwork：

  1. 拆分您的数据province
  2. 为每个省份制作一个地块
  3. 使用patchwork

我下面的方法使用辅助函数进行绘图并利用purrr::pmap循环遍历各省。辅助函数采用三个参数，1. 省的数据，2. 省人口和 3. 模拟 facet warp 的行为，逻辑指示是否应标记 y 轴。

<!-- language-all: lang-r -->


library(ggplot2)
library(dplyr)
library(patchwork)

cases <- tibble::tribble(
  ~province, ~date_report, ~avg_cases_last7,
  "Ontario", "2020-08-26",              111,
  "Quebec", "2020-08-26", 89.8571428571429,
  "Ontario", "2020-08-27", 116.857142857143,
  "Quebec", "2020-08-27", 93.4285714285714,
  "Ontario", "2020-08-28", 113.142857142857,
  "Quebec", "2020-08-28", 89.8571428571429,
  "Ontario", "2020-08-29", 118.285714285714,
  "Quebec", "2020-08-29", 90.4285714285714,
  "Ontario", "2020-08-30", 117.714285714286,
  "Quebec", "2020-08-30",               97,
  "Ontario", "2020-08-31", 117.571428571429,
  "Quebec", "2020-08-31", 107.285714285714,
  "Ontario", "2020-09-01", 124.571428571429,
  "Quebec", "2020-09-01", 115.857142857143,
  "Ontario", "2020-09-02", 126.714285714286,
  "Quebec", "2020-09-02", 114.428571428571,
  "Ontario", "2020-09-03", 128.428571428571,
  "Quebec", "2020-09-03", 125.285714285714,
  "Ontario", "2020-09-04", 130.142857142857,
  "Quebec", "2020-09-04", 141.857142857143,
  "Ontario", "2020-09-05", 136.285714285714,
  "Quebec", "2020-09-05", 151.428571428571
) %>%
  mutate(date_report = as.Date(date_report))

cases_split <- cases %>% 
  split(.$province)

make_plot <- function(d, pop, axis_label) {
  labs <- if (!axis_label) labs(y = NULL)
  name <- if (!axis_label) "cases per 100k"
  
  ggplot(d, aes(x = date_report, y = avg_cases_last7)) + 
    geom_line() +
    scale_y_continuous(sec.axis = sec_axis(trans = ~ . / pop * 1e6, name = name)) +
    facet_wrap(~province,  scales = "free") +
    labs
}

purrr::pmap(list(d = cases_split, pop = list(12 * 1e6, 8 * 1e6), axis_label = c(TRUE, FALSE)), make_plot) %>% 
  patchwork::wrap_plots()

推荐阅读