From 602f8f671f0e5d6a966cf545a49c0bf70491bece Mon Sep 17 00:00:00 2001
From: cazodi <cazodi@svi.edu.au>
Date: Thu, 16 Apr 2020 11:23:21 +1000
Subject: [PATCH] fix mini bug with pulling CIs from summary
---
NAMESPACE | 7 ++++++-
R/FIN_plot.R | 32 ++++++++++++++++++--------------
R/FIN_summary.R | 2 +-
3 files changed, 25 insertions(+), 16 deletions(-)
diff --git a/NAMESPACE b/NAMESPACE
index 0a697e9..68872e5 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -1,18 +1,21 @@
# 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)
diff --git a/R/FIN_plot.R b/R/FIN_plot.R
index 91f7bfd..43258f9 100644
--- a/R/FIN_plot.R
+++ b/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)
diff --git a/R/FIN_summary.R b/R/FIN_summary.R
index 33c5ab3..5721607 100644
--- a/R/FIN_summary.R
+++ b/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"
--
GitLab