fix mini bug with pulling CIs from summary

NAMESPACE

 # Generated by roxygen2: do not edit by hand
 
 S3method(as.data.frame,seiqhrf)
-S3method(plot,list)
 S3method(plot,seiqhrf)
+S3method(plot,sirplus)
 S3method(print,control.seiqhrf)
 S3method(print,init.seiqhrf)
 S3method(print,param.seiqhrf)
 S3method(print,seiqhrf)
 S3method(print,summary.seiqhrf)
 S3method(summary,seiqhrf)
+export(add_known)
 export(arrivals.FUN)
 export(control_seiqhrf)
 export(cum_discr_si)
 export(departures.FUN)
+export(format_sims)
+export(get_ci)
 export(get_prev.FUN)
 export(infection.FUN)
 export(init_seiqhrf)
@@ -26,6 +29,7 @@ export(simulate_seiqhrf)
 export(vary_param)
 import(dplyr)
 import(ggplot2)
+import(lubridate)
 importFrom(EpiModel,get_prev.icm)
 importFrom(EpiModel,ssample)
 importFrom(EpiModel,verbose.icm)
@@ -45,3 +49,4 @@ importFrom(stats,rgeom)
 importFrom(stats,sd)
 importFrom(tidyr,pivot_longer)
 importFrom(tidyr,pivot_wider)
+importFrom(tidyr,separate)

R/FIN_plot.R

@@ -56,7 +56,6 @@ plot.seiqhrf <- function(x,
                          total_population = NULL, ...) {
     
     if(is.null(method)){
-        
         plot.sirplus(x, comp_remove = comp_remove,
                      time_lim = time_lim,
                      ci = ci,
@@ -160,7 +159,7 @@ plot.sirplus <- function(x,comp_remove = comp_remove,
 
     plot_df <- plot_df %>% filter(compartment %in% c(comp_plot)) 
 
-    # Plot!
+    # Plot with options
     p <- ggplot(plot_df, aes(x = Date, y = count, colour = compartment, linetype = sim)) + 
         geom_line(size = 1.2, alpha = 0.8) + 
         scale_x_date(date_breaks = "1 week", date_labels = "%m-%d") + 
@@ -169,7 +168,6 @@ plot.sirplus <- function(x,comp_remove = comp_remove,
         theme_bw() + theme(axis.text.x = element_text(angle = 90))
     
     if(length(unique(plot_df$experiment)) > 1){
-        print(unique(plot_df$experiment))
         p <- p + facet_grid(reo_exp(experiment) ~ ., scale = 'free')
     }
     
@@ -182,10 +180,9 @@ plot.sirplus <- function(x,comp_remove = comp_remove,
     }
     
     if(ci == 'y'){
-        print(max(plot_df$qntCI.2 - plot_df$qntCI.1))
-        print(max(plot_df$CI.2 - plot_df$CI.1))
         p <- p + geom_ribbon(aes(ymin=qntCI.1, ymax=qntCI.2, x=Date, 
-                                 fill = compartment, colour = NULL), alpha = 0.4) +
+                                 fill = compartment, colour = NULL),
+                             alpha = 0.4) +
             scale_color_manual(values = compcols, labels = complabels) +
             scale_fill_manual(values = compcols, guide = FALSE)
     }
@@ -211,7 +208,7 @@ plot.sirplus <- function(x,comp_remove = comp_remove,
 #' @importFrom dplyr filter
 #' 
 #' @export
-plot.times <- function(sim) {
+plot_times <- function(sim) {
     
     for (s in 1:sim$control$nsims) {
         if (s == 1) {
@@ -305,7 +302,7 @@ format_sims <- function(x, time_lim = time_lim, start_date = start_date){
 #'        projections
 #' 
 #' @return dataframe with CIs and sd added
-#' @importFrom dplyr separate
+#' @importFrom tidyr separate
 #' 
 #' @export
 #' 
@@ -313,7 +310,9 @@ get_ci <- function(x, plot_df){
     
     # Get sim variance metrics for single seiqhrf object
     if(class(x) == "seiqhrf"){
-        ci_info <- as.data.frame(summary.seiqhrf(x))
+        
+        ci_info <- as.data.frame.list(summary.seiqhrf(x))
+        print(head(ci_info))
         ci_info <- ci_info %>% mutate(time = as.numeric(row.names(ci_info))) %>%
             pivot_longer(cols = -time, names_to = 'compartment',
                          values_to = 'mean') %>%
@@ -321,9 +320,11 @@ get_ci <- function(x, plot_df){
             mutate(compartment = paste0(compartment, 'num'),
                    experiment = 'seiqhrf model') %>%
             pivot_wider(names_from = metric, values_from = mean)
+        
     }else{
+        
         sim_id <- names(x)
-        ci_info <- as.data.frame(summary.seiqhrf(x[[1]]))
+        ci_info <- as.data.frame.list(summary.seiqhrf(x[[1]]))
         ci_info <- ci_info %>% mutate(time =  as.numeric(row.names(ci_info))) %>%
             pivot_longer(cols = -time, names_to = 'compartment',
                          values_to = 'mean') %>%
@@ -331,14 +332,17 @@ get_ci <- function(x, plot_df){
             mutate(compartment = paste0(compartment, 'num'),
                    experiment = sim_id[1]) %>%
             pivot_wider(names_from = metric, values_from = mean) 
-        
+
         if(length(sim_id) > 1){
             for (i in (2:length(sim_id))) {
-                ci_tmp <- as.data.frame(summary.seiqhrf(x[[i]]))
-                ci_tmp <- ci_tmp %>% mutate(time =  as.numeric(row.names(ci_tmp))) %>%
+                
+                ci_tmp <- as.data.frame.list(summary.seiqhrf(x[[i]]))
+                ci_tmp <- ci_tmp %>% mutate(time = as.numeric(row.names(ci_tmp))) %>%
                     pivot_longer(cols = -time, names_to = 'compartment',
                                  values_to = 'mean') %>%
-                    tidyr::separate(compartment, into = c('compartment', 'metric'), sep='num.') %>%
+                    tidyr::separate(compartment, 
+                                    into = c('compartment', 'metric'), 
+                                    sep='num.') %>%
                     mutate(compartment = paste0(compartment, 'num'),
                            experiment = sim_id[i]) %>%
                     pivot_wider(names_from = metric, values_from = mean) 

R/FIN_summary.R

@@ -48,7 +48,7 @@ summary.seiqhrf <- function(object, ...){
         res[[prev_no]]$"sd" <- prev_sd
         res[[prev_no]]$"CI" <- prev_ci
         res[[prev_no]]$"qntCI" <- prev_qci
-       
+        
     }
     
     class(res) <- "summary.seiqhrf"