r - ggplot辅助轴缩放
问题描述
我仍然是 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找到的解决方案。我的第二轴是每周测试人口百分比,它在 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"))
这样做会产生以下结果
这显然是不对的。
冒着在这里听起来很愚蠢的风险,问题是否至少在某种程度上是由于线图(我想要缩放的)在主轴上?
解决方案
也许使用 permille 而不是百分比。
scale_y_continuous(name = "Cum Test Positivity Rate",
sec.axis = sec_axis(~./1000, name="Weekly ‰ of Pop Tested"))
推荐阅读
- c - 带有无源蜂鸣器的 Arduino 超声波距离传感器可实现不同的音调
- python - cv2.error:(-215:Assertion failed) !_src.empty() in function 'cv::cvtColor'
- kubernetes - Kubernetes DNS 间歇性失败,kube-dns 服务和 CoreDNS pod 似乎正常
- javascript - 通过单个表单提交在后台选项卡中打开多个网站搜索查询
- javascript - 如何在 AngularJS 中更改 URL 并且不重新加载页面
- pandas - 在 Python 中循环移动平均线
- ios - 堆栈布局没有正确反映在模拟器上
- c++ - 为什么在等待 ICMPv6 ping 回复时调用 recv 超时?
- php - 使用准备好的语句时如何创建多维数组?
- powershell - 调用命令参数未正确传递