Population_Study/Scripts/Load_Custom_Functions/Fan_Chart_Creation_Functions.r
2025-12-12 16:16:25 -07:00

34 lines
2.2 KiB
R

#Functions to create consistent fan functions from simulations
###Create a data set which pairs of the upper and lower confidence intervals. This allows the layers to be plotted
GET_DATA <- function(RES,COL_NUM,SIM_START=2025){
LAST_HISTORIC <- SIM_START-1
YEARS <- min(RES$Year,na.rm=TRUE):max(RES$Year,na.rm=TRUE)
LEVELS <- seq(0.01,0.99,by=0.005)
GROUPS <- floor(length(LEVELS)/2)
FAN_DATA <- do.call(rbind,lapply(YEARS,function(x){quantile(as.numeric(t((RES %>% filter(Year==x))[,COL_NUM])),LEVELS)})) %>% as_tibble %>% mutate(Year=YEARS)
FAN_DATA <- rbind(FAN_DATA[1,],FAN_DATA)
START_VALUE <- (HIST %>% filter(Year==LAST_HISTORIC ))[,COL_NUM+1] %>% as.numeric
FAN_DATA <- FAN_DATA %>% pivot_longer(colnames(FAN_DATA %>% select(-Year)),names_to="Percentile") %>% filter(Year>LAST_HISTORIC) %>% unique
NUM_YEARS <- length(unique(FAN_DATA$Year) )
FAN_DATA$Group <- rep(c(1:GROUPS,0,rev(1:GROUPS)),NUM_YEARS)
FAN_DATA <- FAN_DATA %>% group_by(Year,Group) %>% summarize(MIN=min(value),MAX=max(value))
TEMP <- FAN_DATA %>% filter(Year==SIM_START) %>% mutate(Year=LAST_HISTORIC) %>% ungroup
TEMP[,3:4] <- START_VALUE
FAN_DATA <- rbind(TEMP,FAN_DATA %>% ungroup) %>% as_tibble
return(FAN_DATA)
}
###Create a data set which loops through many confidence bounds to create a layered fan chart. This output can be stacked on with other data later
MAKE_GRAPH <- function(GRAPH_DATA,ALPHA=0.03,COLOR='cadetblue',LINE_WIDTH=0.75){
PLOT <- ggplot(data=GRAPH_DATA)
LENGTH <- floor(nrow(GRAPH_DATA)/2)
for(i in 1:LENGTH){
C_DATA <- GRAPH_DATA%>% filter(Group==i)
PLOT <- PLOT +geom_ribbon(data=C_DATA,aes(x=Year,ymin=MIN,ymax=MAX),alpha=ALPHA,fill=COLOR)
}
CI_90 <- rbind(GRAPH_DATA%>% filter(Group==20) %>% mutate(Interval='80%'),GRAPH_DATA%>% filter(Group==5) %>% mutate(Interval='95%'),GRAPH_DATA%>% filter(Group==0) %>% mutate(Interval='Median Prediction'))
PLOT <- PLOT+geom_line(aes(x=Year,y=MIN,linetype=Interval,color=Interval),linewidth=LINE_WIDTH, data=CI_90)+geom_line(aes(x=Year,y=MAX,group=Interval,linetype=Interval,color=Interval),linewidth=LINE_WIDTH ,data=CI_90)+scale_color_manual(values=c("grey50","grey80","black"))+scale_linetype_manual(values = c("solid","solid","dotdash"))
return(PLOT)
}