Search code examples
rggplot2intervals

Label of last value in geom_interval


I'm projecting a variable for the next 120 months. I'm having trouble with the following when using ggplot:

In the intervals I'm creating I want to display the last value of each one. Ideally, I want some label that says -for example- for the interval 0.8: "80%:(here would go the last value of that interval)". If this is too difficult, then just the value would be perfect.

Here is a reproducible example

#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() 

Does anybody knows how to achieve this? Thanks in advance!


Solution

  • This could be accomplished by pre-calculating the labels and feeding those in as text:

    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() 
    

    enter image description here