R：在条形图上虚线“预测”在实心条上方

Question

我有一个数据集，该数据集按年度映射某种自然现象的发生率，以显示其随时间增加。这些数据是：

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

然而，2016年基于不完整的数据（最多只能到2016年七月底）。因此，我想基本上是一个正常的条形图，但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)