ggplot辅助轴缩放

Posted 2023-02-16

【中文标题】ggplot辅助轴缩放

【英文标题】：ggplot secondary axis scaling

【发布时间】：2020-10-29 01:33:27

【问题描述】：

我仍然是 R 和 ggplot 的新手。我有以下代码

library(ggplot2)  
library(dplyr)    
library(tidyr)  

maxDate <- "2020-07-07"

my_dates <- function(d) 
  seq( d[1] + (wday(maxDate) - wday(d[1])+1) %% 7, d[2] + 6, by = "week")


stateWeekly <- #structure at https://pastebin.com/jT8WV4dy
endpoints <- stateWeekly %>% 
  group_by(state) %>%
  filter(weekStarting == max(weekStarting)) %>%
  select(weekStarting, posRate, state, cumRate, posRateChange) %>%
  ungroup()

g <- stateWeekly %>% ggplot(aes(x = as.Date(weekStarting))) +
  geom_col(aes(y=100*dailyTest), size=0.75, color="darkblue", fill="white") +
  geom_line(aes(y=cumRate), size = 0.75, color="red") +
  geom_line(aes(y=posRate), size = 0.75, color="forestgreen") +
  geom_point(data = endpoints,size = 1.5,shape = 21,
             aes(y = cumRate), color = "red", fill = "red", show.legend = FALSE) +
  geom_label(data=endpoints, aes(label=paste(round(cumRate,1),"%",sep=""),
                                 x=as.Date("2020-04-07", format="%Y-%m-%d"), y = 80), 
             color="red",
             show.legend = FALSE, 
             nudge_y = 12) +
  geom_label(data=endpoints, aes(label=paste(round(posRateChange,1),"%",sep=""),
                                 x=as.Date("2020-04-28", format="%Y-%m-%d"), y = 80), 
             color="forestgreen",
             show.legend = FALSE, 
             nudge_y = 12) +
  scale_y_continuous(name = "Cum Test Positivity Rate", 
                     sec.axis = sec_axis(~./100, name="Weekly % of Pop Tested")) +
  scale_x_date(breaks = my_dates, date_labels = "%b %d") +
  labs(x = "Week Beginning") +
  #title = "COVID-19 Testing",
  #subtitle = paste("Data as of", format(maxDate, "%A, %B %e, %y")),
  #caption = "HQ AFMC/A9A \n Data: The COVID Tracking Project (https://covidtracking.com)") +
  theme(plot.title = element_text(size = rel(1), face = "bold"),
        plot.subtitle = element_text(size = rel(0.7)),
        plot.caption = element_text(size = rel(1)),
        axis.text.y = element_text(color='red'),
        axis.title.y = element_text(color="red"),
        axis.text.y.right = element_text(color="blue"),
        axis.title.y.right = element_text(color="blue"),
        axis.text.x = element_text(angle = 45,hjust = 1),
        strip.background =element_rect(fill="white"),
        strip.text = element_text(colour = 'blue')) +
  #coord_cartesian(ylim=c(0,90)) +
  facet_wrap(~ state)


print(g)

生成此图表

格鲁吉亚显然（再次）在搞砸他们的 COVID 数据，所以不要介意负面测试 :)

我想要做的是缩放辅助轴，这样测试率线就不会被压扁……它们是非常小的数字，但我希望能够看到更多的差异。任何有关如何实现这一目标的指导将不胜感激。

编辑： 下面的一个建议是将facet_wrap(~ state) 更改为facet_wrap(~ state, scales='free') 这样做只会稍微改变图表

我可以修复标签锚点，但这确实没有提供我希望的线图中的差异化水平。

第二个建议是将sec.axis = sec_axis(~./100, name="Weekly % of Pop Tested")) 更改为sec.axis = sec_axis(~./1000, name="Weekly % of Pop Tested"))

据我所知，这对实际绘图没有任何影响，只是改变了轴标记：

最后，我一直在努力实施从 Dag Hjermann 找到的 here 解决方案。我的第二轴是每周测试人口百分比，它在 geom_col 中表示。一个合理的范围是 0-1.1。主轴是线图，即测试阳性率，范围为 0-30。因此，如果我遵循该解决方案，我应该添加

ylim.prim <- c(0, 30)   
ylim.sec <- c(0, 1.1)

b <- diff(ylim.prim)/diff(ylim.sec)
a <- b*(ylim.prim[1] - ylim.sec[1])

然后将绘图代码改为读取

geom_col(aes(y=a + 100*dailyTest*b), size=0.75, color="darkblue", fill="white")

和次要轴到

sec.axis = sec_axis(~ (. -a)/(b*100), name="Weekly % of Pop Tested"))

这样做会产生以下结果

这显然是不对的。

冒着听起来很愚蠢的风险，问题是否至少在某种程度上是由于线图（我想要缩放的）位于主要轴上？

【问题讨论】：

尝试添加facet_wrap(~ state,scales='free')

嗨检查***.com/questions/3099219/… Dag Hjermann 提供的第二个答案

@Duck 查看对 OP 的编辑......这有点帮助，但并不是我想要实现的目标

@user12256545 查看对 OP 的编辑...努力弄清楚如何实施该解决方案。不幸的是，我想我只是没有“明白”。

【参考方案1】：

也许使用 permille 而不是百分比。

scale_y_continuous(name = "Cum Test Positivity Rate", 
                     sec.axis = sec_axis(~./1000, name="Weekly ‰ of Pop Tested"))