R：在条形图中用实线条点缀'预测'

Question

我有一个数据集可以按年度映射某种自然现象的出现次数，以显示它随着时间的推移而增加。数据是：

Year    Value
2012    10
2013    45
2014    212
2015    560
2016    570

但是，2016年是基于不完整的数据（仅截至2016年7月底）。因此，我基本上想要一个普通的条形图，但2016年的“预测”全值点缀在它的实心条上方。我正在使用ggplot2作为基本图，这是我到目前为止所做的：

test_DF = data.frame(Year = c("2012", "2013", "2014", "2015", "2016"),
                     Count = c(10, 45, 212, 560, 570))

base_graph = ggplot(test_DF, aes(x = test_DF$Year, y = test_DF$Count),
                    main = "Growth of Natural Phenomenon", xlab = "Year",
                    ylab = "Number of Occurences")

final_growth = base_graph + geom_bar(stat = 'identity', fill="#4F81BD") + theme_few() + labs(title="Growth of Natural Phenomenon", y="Number of Occurences",x="") + 
  geom_text(aes(label=test_DF$Count, vjust=-0.4)) + ylim(0, 1000)

但我不知道如何在最终栏上方添加虚线/纹理“预测”部分 - 我无法通过Google找到类似的内容。我想要的图是这样的：

提前感谢任何建议！

Answer 1

我认为这是处理任务的一种方法。我创建了一个组变量，因为您希望在2016年为数据的预测部分指定不同的颜色。您仍然需要清理图例，但我认为这是您可以处理的。

library(tidyverse)

foo %>%
add_row(Year = 2016, Value = 230) %>%
mutate(group = c("a", "a", "a", "a", "a", "b")) -> out


ggplot(data = out, aes(x = Year, y = Value, fill = group)) +
geom_bar(stat = "identity") +
scale_fill_manual(values = c("#4F81BD", "red")) +
labs(title = "Growth of Natural Phenomenon", x = "Year",
     y = "Number of Occurrences")

DATA

foo <- structure(list(Year = 2012:2016, Value = c(10L, 45L, 212L, 560L, 
570L)), .Names = c("Year", "Value"), class = "data.frame", row.names = c(NA, 
-5L))

Answer 2

似乎线图可以在这里运作良好：

library(ggplot2)
library(ggthemes)

test_DF = data.frame(Year = c(2015:2016, 2015:2016, 2012:2015),
                     Count = c(560, 570 + 230, 560, 570, 10, 45, 212, 560),
                     group=rep(c("predicted","measured: incomplete", "measured: complete"), 
                               c(2,2,4)))

test_DF$group = factor(test_DF$group, levels=c("predicted", "measured: incomplete","measured: complete"))

ggplot(test_DF, aes(Year, Count, colour=group, linetype=group, shape=group)) +
  geom_line(size=1) + 
  geom_point(size=2.5, stroke=1, fill="white") +
  theme_few() + labs(colour="", linetype="", shape="") +
  scale_colour_manual(values=hcl(c(15, 195,195),100,65)) +
  scale_linetype_manual(values=c(2,3,1)) +
  scale_shape_manual(values=c(16,21,16)) + 
  theme(legend.key.width=unit(2,"cm"))  +
  coord_cartesian(xlim=range(test_DF$Year) + c(-0.2,0.2), 
                  ylim=c(0, max(test_DF$Count)*1.04), expand=FALSE)

或者，使用文本值而不是点标记：

ggplot(test_DF, aes(Year, Count, colour=group, linetype=group, shape=group)) +
  geom_line(size=0.5, alpha=0.5) + 
  geom_text(aes(label=ifelse(Year==2015 & group != "measured: complete", NA, Count)), 
            size=3.8, fontface="bold", show.legend=FALSE) +
  theme_few() + labs(colour="", linetype="") +
  scale_colour_manual(values=hcl(seq(15,375,length=4)[1:3],100,65)) +
  scale_linetype_manual(values=c(2,3,1)) +
  theme(legend.key.width=unit(1.5,"cm")) +
  guides(colour=guide_legend(override.aes=list(alpha=1, size=0.8))) +
  coord_cartesian(xlim=range(test_DF$Year) + c(-0.2,0.25), 
                  ylim=c(0, max(test_DF$Count)*1.04), expand=FALSE)