186 lines
18 KiB
R
186 lines
18 KiB
R
library(tidyverse)
|
|
library(gt) #For nice color coded capacity limits table.
|
|
source("Scripts/Load_Custom_Functions/Fan_Chart_Creation_Functions.r") #Functions created to make nice graphs
|
|
if(!exists("SAVE_RES_LOC")){SAVE_RES_LOC <- "./Results/Primary_Simulation_Results/Main_Results/"}
|
|
dir.create(SAVE_RES_LOC, recursive = TRUE, showWarnings = FALSE)
|
|
|
|
###Process the simulations and save the main percentile results by year
|
|
RES <- read_csv("Results/Simulations/Kemmerer_2024_With_Data_Center_Simulation.csv")
|
|
RES[,"Year"] <- RES[,"Year"]
|
|
RES<- RES %>% filter(!is.na(Year))
|
|
RES <- RES %>% filter(!is.na(Population))
|
|
HIST <- readRDS("Data/Cleaned_Data/Population_Data/RDS/Kemmerer_Diamondville_Population_Data.Rds") %>% filter(County=='Lincoln') %>% mutate(Percentile="Actual Population") %>% filter(Year>=1940)
|
|
|
|
MAKE_GRAPH <- function(C_DATA,COL_NUM,TITLE=NA){
|
|
YEARS <- min(C_DATA$Year,na.rm=TRUE):max(RES$Year,na.rm=TRUE)
|
|
LEVELS <- seq(0.00,1,by=0.025)
|
|
FAN_DATA <- do.call(rbind,lapply(YEARS,function(x){quantile(as.numeric(t((C_DATA %>% filter(Year==x))[,COL_NUM])),LEVELS)})) %>% as_tibble %>% mutate(Year=YEARS)
|
|
LEVELS <- seq(0.00,1,by=0.025)
|
|
CI_BANDS <- do.call(rbind,lapply(YEARS,function(x){quantile(as.numeric(t((C_DATA %>% filter(Year==x))[,COL_NUM])),c(0.025,0.975,0.5,0.1,0.9))})) %>% as_tibble %>% mutate(Year=YEARS)
|
|
CI_BANDS <- CI_BANDS %>% pivot_longer(!Year,names_to="Percentile",values_to="value")
|
|
CI_BANDS$Interval <- ifelse(CI_BANDS$Percentile %in% c('2.5%','97.5%'),'95%',NA)
|
|
CI_BANDS$Interval <- ifelse(CI_BANDS$Percentile %in% c('10%','90%'),'80%',CI_BANDS$Interval)
|
|
CI_BANDS$Interval <- ifelse(CI_BANDS$Percentile %in% c('50%'),'Median Prediction',CI_BANDS$Interval)
|
|
|
|
FAN_DATA <- FAN_DATA %>% pivot_longer(!Year,names_to="Percentile",values_to="value") %>% group_by(Year) %>% mutate(DIFF=c(NA,diff(value)))
|
|
ST_VAL <- as.numeric((HIST %>% filter(Year==2024))[,COL_NUM+1])
|
|
FAN_DATA <- rbind(FAN_DATA %>% filter(Year==2025) %>% mutate(Year=2024,value=ST_VAL),FAN_DATA)
|
|
GRAPH_DATA <- FAN_DATA %>% group_by(Year) %>% mutate(MIN_RANGE=lag(parse_number(Percentile)/100),MAX_RANGE=parse_number(Percentile)/100,MIN_VAL=lag(value),MAX_VAL=value) %>% filter(!is.na(DIFF))
|
|
GRAPH_DATA[GRAPH_DATA$Year==2024,'DIFF'] <- 0
|
|
|
|
return(ggplot(GRAPH_DATA %>% filter(MIN_RANGE>=0.002,MAX_RANGE<=0.998) )+geom_ribbon(aes(group=Percentile,x=Year,ymin=MIN_VAL,ymax=MAX_VAL,fill=DIFF,alpha=-DIFF))+geom_line(data=CI_BANDS %>% filter(Interval=='Median Prediction'),aes(x=Year,y=value,group=Percentile,linetype=Interval,color=Interval),linewidth=0.75)+scale_color_manual(values=c("grey80","black"),name='Median Prediction')+scale_linetype_manual(values = c("dotdash"),guide="none")+ggtitle(TITLE)+ theme_gray(base_size = 16)+ theme(legend.position = "top",panel.grid.minor = element_blank())+scale_alpha(range = c(0, 1),guide="none")+theme(legend.text = element_blank()))
|
|
}
|
|
|
|
###Main Results
|
|
SCALE_FACTOR <- 1.25
|
|
|
|
png(paste0(SAVE_RES_LOC,"Population_Fan_Chart_Main_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES,3 ,"")+geom_line(data=HIST,aes(x=Year,y=Population),color='black',linewidth=1)+ scale_y_continuous(breaks = seq(0, 35000, by = 500))+ expand_limits( y = 0)+labs(y="Population")+ scale_x_continuous(breaks = c(seq(1940, 2060, by = 10),2065))+scale_fill_gradient(high= "#132B43", low= "#56B1F7",name ="Likelihood\n(0%-100%)", trans = 'reverse')
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC,"Birth_Fan_Chart_Main_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES,4 ,"")+geom_line(data=HIST %>% filter(!is.na(Births)),aes(x=Year,y=Births),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(0, 35000, by = 10))+ expand_limits( y = 0)+labs(y="Births")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= "#132B43", low= "#56B1F7",name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC,"Mortality_Fan_Chart_Main_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES,5 ,"")+geom_line(data=HIST %>% filter(!is.na(Deaths)),aes(x=Year,y=Deaths),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(0, 35000, by = 10))+ expand_limits( y = 0)+labs(y="Deaths")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= "#132B43", low= "#56B1F7",name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC,"Migration_Fan_Chart_Main_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES,6 ,"")+geom_line(data=HIST %>% filter(!is.na(Migration)),aes(x=Year,y=Migration),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(-1000, 35000, by = 100))+ expand_limits( y = 0)+labs(y="Migration")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= "#132B43", low= "#56B1F7",name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
dev.off()
|
|
###########High Estiamtes
|
|
if(!exists("SAVE_RES_LOC_HIGH")){SAVE_RES_LOC_HIGH <- "./Results/Primary_Simulation_Results/Upper_Bound_Results/"}
|
|
dir.create(SAVE_RES_LOC_HIGH, recursive = TRUE, showWarnings = FALSE)
|
|
RES_HIGH <- RES %>% filter(Growth_Rate=='HIGH')
|
|
COLOR1 <- 'forestgreen'
|
|
COLOR2 <- 'yellow'
|
|
|
|
png(paste0(SAVE_RES_LOC_HIGH,"Population_Fan_Chart_High_Growth_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES_HIGH,3 ,"")+geom_line(data=HIST,aes(x=Year,y=Population),color='black',linewidth=1)+ scale_y_continuous(breaks = seq(0, 35000, by = 500))+ expand_limits( y = 0)+labs(y="Population")+ scale_x_continuous(breaks = c(seq(1940, 2060, by = 10),2065))+scale_fill_gradient(high= COLOR1, low= COLOR2,name ="Likelihood\n(0%-100%)", trans = 'reverse')
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC_HIGH,"Birth_Fan_Chart_High_Growth_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES_HIGH,4 ,"")+geom_line(data=HIST %>% filter(!is.na(Births)),aes(x=Year,y=Births),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(0, 35000, by = 10))+ expand_limits( y = 0)+labs(y="Births")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= COLOR1, low= COLOR2,name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC_HIGH,"Mortality_Fan_Chart_High_Growth_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES_HIGH,5 ,"")+geom_line(data=HIST %>% filter(!is.na(Deaths)),aes(x=Year,y=Deaths),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(0, 35000, by = 10))+ expand_limits( y = 0)+labs(y="Deaths")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= COLOR1, low= COLOR2,name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC_HIGH,"Migration_Fan_Chart_High_Growth_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES_HIGH,6 ,"")+geom_line(data=HIST %>% filter(!is.na(Migration)),aes(x=Year,y=Migration),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(-1000, 35000, by = 100))+ expand_limits( y = 0)+labs(y="Migration")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= COLOR1, low= COLOR2,name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
dev.off()
|
|
###########Low Estiamtes
|
|
if(!exists("SAVE_RES_LOC_LOW")){SAVE_RES_LOC_LOW <- "./Results/Primary_Simulation_Results/Lower_Bound_Results/"}
|
|
dir.create(SAVE_RES_LOC_LOW, recursive = TRUE, showWarnings = FALSE)
|
|
RES_LOW <- RES %>% filter(Growth_Rate!='HIGH')
|
|
COLOR1 <- 'firebrick3'
|
|
COLOR2 <- 'white'
|
|
|
|
png(paste0(SAVE_RES_LOC_LOW,"Population_Fan_Chart_Low_Growth_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES_LOW,3 ,"")+geom_line(data=HIST,aes(x=Year,y=Population),color='black',linewidth=1)+ scale_y_continuous(breaks = seq(0, 35000, by = 500))+ expand_limits( y = 0)+labs(y="Population")+ scale_x_continuous(breaks = c(seq(1940, 2060, by = 10),2065))+scale_fill_gradient(high= COLOR1, low= COLOR2,name ="Likelihood\n(0%-100%)", trans = 'reverse')
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC_LOW,"Birth_Fan_Chart_Low_Growth_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES_LOW,4 ,"")+geom_line(data=HIST %>% filter(!is.na(Births)),aes(x=Year,y=Births),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(0, 35000, by = 10))+ expand_limits( y = 0)+labs(y="Births")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= COLOR1, low= COLOR2,name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC_LOW,"Mortality_Fan_Chart_Low_Growth_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES_LOW,5 ,"")+geom_line(data=HIST %>% filter(!is.na(Deaths)),aes(x=Year,y=Deaths),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(0, 35000, by = 10))+ expand_limits( y = 0)+labs(y="Deaths")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= COLOR1, low= COLOR2,name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
|
|
dev.off()
|
|
|
|
png(paste0(SAVE_RES_LOC_LOW,"Migration_Fan_Chart_Low_Growth_Results.png"), width = 12*SCALE_FACTOR, height = 8*SCALE_FACTOR, units = "in", res = 600)
|
|
MAKE_GRAPH(RES_LOW,6 ,"")+geom_line(data=HIST %>% filter(!is.na(Migration)),aes(x=Year,y=Migration),color='black',linewidth=0.75)+ scale_y_continuous(breaks = seq(-1000, 35000, by = 100))+ expand_limits( y = 0)+labs(y="Migration")+ scale_x_continuous(breaks = c(2009,seq(2015, 2065, by = 5)))+scale_fill_gradient(high= COLOR1, low= COLOR2,name ="Likelihood\n(0%-100%)", trans = 'reverse')+theme(legend.position = "none")
|
|
dev.off()
|
|
|
|
################################# Key Year Summaries
|
|
KEY_YEARS_OF_STUDY <- c(2027,2030,2035,2045,2055,2065)
|
|
CI_BANDS <- do.call(rbind,lapply(KEY_YEARS_OF_STUDY ,function(x){quantile(as.numeric(t((RES%>% filter(Year==x))[,3])),c(0.025,0.975,0.5))})) %>% as_tibble %>% mutate(Year=KEY_YEARS_OF_STUDY)
|
|
CI_BANDS <- CI_BANDS %>% pivot_longer(!Year,names_to="Percentile",values_to="value")
|
|
CI_BANDS$Interval <- ifelse(CI_BANDS$Percentile %in% c('2.5%','97.5%'),'95%',NA)
|
|
CI_BANDS$Interval <- ifelse(CI_BANDS$Percentile %in% c('50%'),'Median',CI_BANDS$Interval)
|
|
KEY_YEAR_SUMMARY_TBL <- CI_BANDS %>% group_by(Year) %>% summarize(CI_95_Lower=min(value),Median=median(value),CI_95_Upper=max(value))
|
|
write_csv(round(KEY_YEAR_SUMMARY_TBL,0),paste0(SAVE_RES_LOC,"Key_Year_Summary_Main_Results.csv"))
|
|
|
|
|
|
######High Results
|
|
CI_BANDS_HIGH <- do.call(rbind,lapply(KEY_YEARS_OF_STUDY ,function(x){quantile(as.numeric(t((RES_HIGH%>% filter(Year==x))[,3])),c(0.025,0.975,0.5))})) %>% as_tibble %>% mutate(Year=KEY_YEARS_OF_STUDY)
|
|
CI_BANDS_HIGH <- CI_BANDS_HIGH %>% pivot_longer(!Year,names_to="Percentile",values_to="value")
|
|
CI_BANDS_HIGH$Interval <- ifelse(CI_BANDS_HIGH$Percentile %in% c('2.5%','97.5%'),'95%',NA)
|
|
CI_BANDS_HIGH$Interval <- ifelse(CI_BANDS_HIGH$Percentile %in% c('50%'),'Median',CI_BANDS_HIGH$Interval)
|
|
KEY_YEAR_SUMMARY_TBL_HIGH <- CI_BANDS_HIGH %>% group_by(Year) %>% summarize(CI_95_Lower=min(value),Median=median(value),CI_95_Upper=max(value))
|
|
KEY_YEAR_SUMMARY_TBL_HIGH
|
|
write_csv(round(KEY_YEAR_SUMMARY_TBL_HIGH,0),paste0(SAVE_RES_LOC_HIGH,"Key_Year_Summary_Upper_Bound.csv"))
|
|
|
|
|
|
######Low Results
|
|
CI_BANDS_LOW <- do.call(rbind,lapply(KEY_YEARS_OF_STUDY ,function(x){quantile(as.numeric(t((RES_LOW%>% filter(Year==x))[,3])),c(0.025,0.975,0.5))})) %>% as_tibble %>% mutate(Year=KEY_YEARS_OF_STUDY)
|
|
CI_BANDS_LOW <- CI_BANDS_LOW %>% pivot_longer(!Year,names_to="Percentile",values_to="value")
|
|
CI_BANDS_LOW$Interval <- ifelse(CI_BANDS_LOW$Percentile %in% c('2.5%','97.5%'),'95%',NA)
|
|
CI_BANDS_LOW$Interval <- ifelse(CI_BANDS_LOW$Percentile %in% c('50%'),'Median',CI_BANDS_LOW$Interval)
|
|
KEY_YEAR_SUMMARY_TBL_LOW <- CI_BANDS_LOW %>% group_by(Year) %>% summarize(CI_95_Lower=min(value),Median=median(value),CI_95_Upper=max(value))
|
|
write_csv(round(KEY_YEAR_SUMMARY_TBL_LOW,0),paste0(SAVE_RES_LOC_LOW,"Key_Year_Summary_Lower_Bound.csv"))
|
|
################################# Histograms
|
|
KEY_YEAR_DATA <- RES %>% filter(Year %in% KEY_YEARS_OF_STUDY )
|
|
AVG_VALUES <- KEY_YEAR_DATA %>% group_by(Year) %>% summarize(MED=median(Population),MEAN=mean(Population))
|
|
AVG_VALUES <- rbind(AVG_VALUES[,1:2]%>% rename(Value=MED) %>% mutate('Summary Stat.'="Median"),AVG_VALUES[,c(1,3)] %>% rename(Value=MEAN) %>% mutate('Summary Stat.'="Mean"))
|
|
|
|
HISTOGRAM <- ggplot(KEY_YEAR_DATA, aes(x = Population,group=-Year,Color=Year,fill=Year)) + geom_histogram(alpha=0.3,bins=800)+geom_vline(data = AVG_VALUES, aes(xintercept = Value,group=`Summary Stat.`,color = `Summary Stat.`), linewidth= 0.75)+scale_color_manual(values=c("red","black","black"))+ facet_grid(rows=vars(Year))+ scale_x_continuous(breaks = c(seq(0, 10^6, by = 1000)))+ theme_bw()+ theme(legend.position = "top",panel.grid.minor = element_blank())+ylab("Number of Simulation")+guides(fill= guide_legend(nrow = 1))
|
|
HISTOGRAM
|
|
|
|
png(paste0(SAVE_RES_LOC,"Population_Histogram_Main_Results.png"), width = 8, height = 12, units = "in", res = 600)
|
|
HISTOGRAM
|
|
dev.off()
|
|
####Upper
|
|
KEY_YEAR_DATA <- RES_HIGH %>% filter(Year %in% KEY_YEARS_OF_STUDY )
|
|
AVG_VALUES <- KEY_YEAR_DATA %>% group_by(Year) %>% summarize(MED=median(Population),MEAN=mean(Population))
|
|
AVG_VALUES <- rbind(AVG_VALUES[,1:2]%>% rename(Value=MED) %>% mutate('Summary Stat.'="Median"),AVG_VALUES[,c(1,3)] %>% rename(Value=MEAN) %>% mutate('Summary Stat.'="Mean"))
|
|
|
|
HISTOGRAM <- ggplot(KEY_YEAR_DATA, aes(x = Population,group=-Year,Color=Year,fill=Year)) + geom_histogram(alpha=0.3,bins=800)+geom_vline(data = AVG_VALUES, aes(xintercept = Value,group=`Summary Stat.`,color = `Summary Stat.`), size = 0.75)+scale_fill_gradient(low = "grey", high = "darkgreen")+scale_color_manual(values=c("red","black","black"))+ facet_grid(rows=vars(Year))+ scale_x_continuous(breaks = c(seq(0, 10^6, by = 1000)))+ theme_bw()+ theme(legend.position = "top",panel.grid.minor = element_blank())+ylab("Number of Simulation")+guides(fill= guide_legend(nrow = 1))
|
|
png(paste0(SAVE_RES_LOC_HIGH,"Population_Histogram_Upper_Bound.png"), width = 8, height = 12, units = "in", res = 600)
|
|
HISTOGRAM
|
|
dev.off()
|
|
####Lower
|
|
KEY_YEAR_DATA <- RES_LOW %>% filter(Year %in% KEY_YEARS_OF_STUDY )
|
|
AVG_VALUES <- KEY_YEAR_DATA %>% group_by(Year) %>% summarize(MED=median(Population),MEAN=mean(Population))
|
|
AVG_VALUES <- rbind(AVG_VALUES[,1:2]%>% rename(Value=MED) %>% mutate('Summary Stat.'="Median"),AVG_VALUES[,c(1,3)] %>% rename(Value=MEAN) %>% mutate('Summary Stat.'="Mean"))
|
|
HISTOGRAM <- ggplot(KEY_YEAR_DATA, aes(x = Population,group=-Year,Color=Year,fill=Year)) + geom_histogram(alpha=0.3,bins=800)+geom_vline(data = AVG_VALUES, aes(xintercept = Value,group=`Summary Stat.`,color = `Summary Stat.`), size = 0.75)+scale_fill_gradient(low = "grey", high = "darkred")+scale_color_manual(values=c("red","black","black"))+ facet_grid(rows=vars(Year))+ scale_x_continuous(breaks = c(seq(0, 10^6, by = 500)))+ theme_bw()+ theme(legend.position = "top",panel.grid.minor = element_blank())+ylab("Number of Simulation")+guides(fill= guide_legend(nrow = 1))
|
|
|
|
png(paste0(SAVE_RES_LOC_LOW,"Population_Histogram_Lower_Bound.png"), width = 8, height = 12, units = "in", res = 600)
|
|
HISTOGRAM
|
|
dev.off()
|
|
############################Capacity Tables
|
|
MAKE_GT <- function(DATA,POP_LEVELS=seq(2000,6000,100)){
|
|
YEARS <- c(2027,2030,2035,2045,2055,2065)
|
|
if(exists("KEY_YEARS")){rm(KEY_YEARS)}
|
|
for(i in YEARS ){
|
|
KEY <- DATA%>% filter(Year==i ) %>% pull(Population)
|
|
ECDF <- ecdf(KEY)
|
|
ECDF_VALUES <- ECDF(POP_LEVELS)
|
|
if(!exists("KEY_YEARS")){KEY_YEARS<- ECDF_VALUES} else{KEY_YEARS<- cbind(KEY_YEARS,ECDF_VALUES)}
|
|
|
|
}
|
|
colnames(KEY_YEARS) <- YEARS
|
|
rownames(KEY_YEARS) <- POP_LEVELS
|
|
PLOT_GREEN <- "forestgreen"
|
|
PLOT_YELLOW <- "yellow"
|
|
PLOT_RED <- "red"
|
|
KEY_YEARS <- KEY_YEARS%>% as.data.frame
|
|
Capacity_Risk <- KEY_YEARS%>% gt(rownames_to_stub = TRUE,caption="Year") %>% data_color( fn = scales::col_numeric( palette = c(PLOT_RED, PLOT_YELLOW, PLOT_GREEN), domain = c(0, 1) ) ) %>% fmt_percent( decimals = 1, drop_trailing_zeros = FALSE) %>% tab_stubhead(label =c("Capacity"))
|
|
return(Capacity_Risk)
|
|
}
|
|
TBL_MAIN <- MAKE_GT(RES)
|
|
TBL_HIGH <- MAKE_GT(RES_HIGH)
|
|
TBL_LOW <- MAKE_GT(RES_LOW)
|
|
gtsave( data = TBL_MAIN, filename = "./Results/Primary_Simulation_Results/Main_Results/Capacity_Table_Main_Results.html")
|
|
gtsave( data = TBL_HIGH, filename = "./Results/Primary_Simulation_Results/Upper_Bound_Results/Capacity_Table_Upper_Bound.html")
|
|
gtsave( data = TBL_LOW, filename = "./Results/Primary_Simulation_Results/Lower_Bound_Results/Capacity_Table_Lower_Bound.html")
|
|
|
|
|
|
system("wkhtmltopdf --disable-smart-shrinking --no-stop-slow-scripts --enable-local-file-access --page-width 99mm --page-height 328mm ./Results/Primary_Simulation_Results/Main_Results/Capacity_Table_Main_Results.html ./Results/Primary_Simulation_Results/Main_Results/Capacity_Table_Main_Results.pdf")
|
|
system("wkhtmltopdf --disable-smart-shrinking --no-stop-slow-scripts --enable-local-file-access --page-width 101mm --page-height 331mm ./Results/Primary_Simulation_Results/Lower_Bound_Results/Capacity_Table_Lower_Bound.html ./Results/Primary_Simulation_Results/Lower_Bound_Results/Capacity_Table_Lower_Bound.pdf")
|
|
system("wkhtmltopdf --disable-smart-shrinking --no-stop-slow-scripts --enable-local-file-access --page-width 96mm --page-height 328mm ./Results/Primary_Simulation_Results/Upper_Bound_Results/Capacity_Table_Upper_Bound.html ./Results/Primary_Simulation_Results/Upper_Bound_Results/Capacity_Table_Upper_Bound.pdf")
|
|
|