geom_interval 中最后一个值的标签

Label of last value in geom_interval

我正在为接下来的 120 个月预测一个变量。使用 ggplot 时遇到以下问题:

在我创建的间隔中,我想显示每个间隔的最后一个值。理想情况下,我想要一些标签,上面写着 - 例如 - 对于间隔 0.8:“80%:(这里将是该间隔的最后一个值)”。如果这太难了,那这个值就完美了。

这是一个可重现的例子

#libraries
library(dplyr)
library(tidyr)
library(ggplot2)
library(ggfan)
library(gridExtra)
library(stringr)
library(scales)

#Create a dataframe 
month <- 1:120 
price_a <- 5000 
demand <- 10
data <- data.frame(month, price_a, demand)

#Create 100 simulations to project price_a and demand for the future
simulations <- 100
intervalo <- seq_len(120)
set.seed(96)
lista_meses <- lapply(setNames(intervalo, paste0("data", intervalo)), function(i) {
  cbind(
    data[rep(i, simulations),],
    growth_pricea = as.numeric(runif(simulations, min = -0.02, max = 0.05)),
    growth_demand = as.numeric(runif(simulations, min = -0.03, max = 0.03)),
    revenue = demand*price_a
   )
})

#Calculate the growth of each variable and revenue
for (i in 2:length(lista_meses)){
  lista_meses[[i]][["price_a"]] <- lista_meses[[i-1]][["price_a"]]*(1+lista_meses[[i]][["growth_pricea"]])
  lista_meses[[i]][["demand"]] <- lista_meses[[i-1]][["demand"]]*(1+lista_meses[[i]][["growth_demand"]])
  lista_meses[[i]][["revenue"]] <- lista_meses[[i]][["price_a"]]*lista_meses[[i]][["demand"]]
}

#Extract revenue columns from all dataframes in list
time <- 1:120 #10 years. 

extract_column <- lapply(lista_meses, function(x) x["revenue"]) 

fandataq <- do.call("cbind", extract_column) 
mandataq <- as.matrix.data.frame(fandataq)
pdataq <- data.frame(x=time, t(fandataq)) %>% gather(key=sim, value=y, -x)

#Graph: I WANT TO SHOW THE LAST VALUES OF EACH INTERVAL IN GEOM_INTERVAL
ggplot(pdataq, aes(x=x, y= y)) + geom_fan(intervals =c(80)/100, show.legend = FALSE) + 
  scale_fill_gradient(low="steelblue1", high="steelblue")+scale_y_continuous(labels = scales::comma)+
  geom_interval(intervals = c(0.80,1), show.legend = FALSE) + scale_linetype_manual(values=c("dotted", "dotted")) +
  theme_bw() 

有人知道如何实现吗?提前致谢!

这可以通过预先计算标签并将其作为文本输入来完成:

probs = c(0, 0.1, 0.9, 1)  # 80% interval from 0.1 to 0.9
label_table <- tibble(x = max(pdataq$x),
                      probs,
                      y = quantile(pdataq[pdataq$x == max(pdataq$x), "y"], 
                                   probs = probs),
                      y_label = scales::comma(y))

# OR, using ggfan::calc_quantiles:
#label_table <- calc_quantiles(pdataq, intervals = c(0.8, 1), x_var = "x", y_var = "y") %>%
#  ungroup() %>%
#  filter(x == max(x)) %>%
#  mutate(y_label = scales::comma(y))

## A tibble: 4 x 4
#      x probs       y y_label
#  <int> <dbl>   <dbl> <chr>  
#1   120   0   124311. 124,311
#2   120   0.1 198339. 198,339
#3   120   0.9 434814. 434,814
#4   120   1   520464. 520,464

ggplot(pdataq, aes(x=x, y= y)) + 
  geom_fan(intervals =c(80)/100, show.legend = FALSE) + 
  scale_fill_gradient(low="steelblue1", high="steelblue")+
  scale_y_continuous(labels = scales::comma)+
  geom_interval(intervals = c(0.80,1), show.legend = FALSE) +
  geom_text(data = label_table,
            aes(label = y_label), hjust = -0.1, size = 3) +
  coord_cartesian(clip = "off") +
  scale_x_continuous(expand = expansion(add = c(5, 20))) + 
  scale_linetype_manual(values=c("dotted", "dotted")) +
  theme_bw()