Diff of /R/s3_generics.R [000000] .. [d9ee58]

Switch to side-by-side view

--- a
+++ b/R/s3_generics.R
@@ -0,0 +1,239 @@
+#' Prints synthesised recruitment as a dataframe with
+#' one column for each treatment and control arm, and
+#' one row for each week.
+#' 
+#' @name print
+#' @aliases print.accrual
+#' 
+#' @param x An object of class `accrual`.
+#' 
+#' @importFrom S7 new_generic method
+#' 
+#' @export
+#' 
+S7::new_generic("print", "accrual")
+S7::method(print, accrual) <- function(x) {
+  print(data.frame(rowSums(x@accrual, dims = 2)))
+}
+
+
+#' Summary of predicted accrual.
+#' 
+#' @name summary
+#' @aliases summary.accrual
+#' 
+#' @param x An object of class `accrual`.
+#' 
+#' @importFrom S7 new_generic method
+#' 
+#' @export
+#' 
+S7::new_generic("summary", "accrual")
+S7::method(summary, accrual) <- function(x) {
+  
+  # Summary of accrual by arm
+  cat("Recruitment by experimental arm\n")
+  print(summary(data.frame(rowSums(x@accrual, dims = 2))))
+
+  # Summary of accrual by site
+  cat("\nRecruitment by site\n")
+  print(summary(data.frame(rowSums(
+    aperm(x@accrual, c(1, 3, 2)),
+    dims = 2
+  ))))
+
+  # Summary of phase change weeks
+  cat("\nExperimental arm closure weeks\n")
+  acw <- as.vector(x@phase_changes)
+  names(acw) <- dimnames(x@accrual)$Arms[seq_len(length(acw))]
+  print(acw)
+
+  # Summary of accrual totals by arm
+  cat("\nAccrual totals by experimental arm\n")
+  print(treat_sums(x))
+}
+
+
+#' Plot method for an object of class `accrual`.  Creates
+#' a line plot of cumulative recruitment, grouped by trial arm,
+#' using ggplot2.
+#' 
+#' @name plot
+#' @aliases plot.accrual
+#' 
+#' @param accrual_obj Object of class `accrual`.
+#' @param plot_prefix Prefix for file name to identify plot type.
+#' Defaults to `accrual_plot`.
+#' @param run_time Specify a particular instance of `biomkrAccrual()`
+#' execution using a date-time format `yyyy-mm-dd-hh-mm-ss`.
+#' @param output_path = Directory where the output files from the 
+#' `biomkrAccrual()` instance are located.
+#' @param figs_path Folder where figures generated during execution
+#' will be stored; defaults to the `figures` subdirectory in
+#' `output_path`.
+#' 
+#' @export
+#' 
+S7::new_generic("plot", "accrual")
+S7::method(plot, accrual) <- function(
+  accrual_obj,
+  plot_prefix = "accrual_plot",
+  run_time = "2024-08-07-18-35-09",
+  output_path = "../biomkrAccrual_output_data/",
+  figs_path = paste0(output_path, "figures/")
+) {
+  accrual_ar <- accrual_obj@accrual
+
+  # Sum across sites
+  accrual_df <- data.frame(rowSums(accrual_ar, dims = 2))
+
+  # Convert to long format of class "accrualplotdata"
+  accrual_df <- accrual_to_long(accrual_df)
+
+  # Plot and save plot in figs_path
+  plot(
+    accrual_df, 
+    plot_prefix = plot_prefix,
+    run_time = run_time,
+    figs_path = figs_path,
+    target_arm_size = accrual_obj@target_arm_size,
+    target_control = accrual_obj@target_control,
+    target_interim = accrual_obj@target_interim,
+    accrual_period = accrual_obj@accrual_period,
+    interim_period = accrual_obj@interim_period
+  )
+}
+
+
+#' Prints initial trial structure as a matrix of prevalences by recruitment
+#' and experimental arms.
+#' 
+#' @name print
+#' @aliases print.trial_strucutre
+#' 
+#' @param x An object of class `trial_structure`.
+#' 
+#' @importFrom S7 new_generic method
+#' @importFrom withr with_options
+#' 
+#' @export
+#' 
+S7::new_generic("print", "trial_structure")
+S7::method(print, trial_structure) <- function(x) {
+  
+  orig_struct_df <- data.frame(
+    x@treatment_arm_struct_start
+  )
+
+  colnames(orig_struct_df) <- names(x@treatment_arm_ids_start)
+  rownames(orig_struct_df) <- x@recruit_arm_names
+
+  print(orig_struct_df)
+
+}
+
+
+#' Prints initial trial structure as a matrix of prevalences by recruitment
+#' and experimental arms.
+#' 
+#' @name plot
+#' @aliases plot.trial_structure
+#' 
+#' @param x An object of class `trial_structure`.
+#' 
+#' @importFrom S7 new_generic method
+#' @importFrom stats reshape
+#' @importFrom grDevices palette.colors
+#' 
+#' @export
+#' 
+S7::new_generic("plot", "trial_structure")
+S7::method(plot, trial_structure) <- function(x) {
+  
+  orig_struct_df <- data.frame(
+    x@treatment_arm_struct_start
+  )
+
+  colnames(orig_struct_df) <- names(x@treatment_arm_ids_start)
+  orig_struct_df$Recruitment <- x@recruit_arm_names
+
+  orig_struct_df <- stats::reshape(
+    orig_struct_df,
+    direction = "long",
+    v.names = "Recruits",
+    varying = list(names(x@treatment_arm_ids_start)),
+    idvar = "Recruitment",
+    timevar = "Treatment",
+    times = names(x@treatment_arm_ids_start)
+  )
+
+  orig_struct_df$Recruits <- as.factor(as.integer(orig_struct_df$Recruits))
+
+  p <- ggplot2::ggplot(
+    data = orig_struct_df,
+    ggplot2::aes(x = Treatment, y = Recruitment, fill = Recruits)
+  ) +
+    ggplot2::geom_tile(
+      color = "white",
+      lwd = 1.5,
+      linetype = 1
+    ) +
+    ggplot2::coord_fixed() +
+    ggplot2::scale_fill_manual(
+      values = c("white", grDevices::palette.colors(4)[4]),
+      labels = c("No", "Yes")
+    ) +
+    ggplot2::scale_y_discrete(limits = rev) +
+    ggplot2::labs(
+      x = "Treatment arm",
+      y = "Recruitment arm",
+      title = "Trial structure",
+      subtitle = paste0(
+        ifelse(x@shared_control, "Shared", "Individual"), 
+        " control arm",
+        ifelse(x@shared_control, "", "s")
+      )
+    ) +
+    theme_bma(base_size = 16)
+
+  return(p)
+}
+
+
+#' Summary of trial structure.
+#' 
+#' @name summary
+#' @aliases summary.trial_structure
+#' 
+#' @param x An object of class `trial_structure`.
+#' 
+#' @importFrom S7 new_generic method
+#' @importFrom withr with_options
+#' 
+#' @export
+#' 
+S7::new_generic("summary", "trial_structure")
+S7::method(summary, trial_structure) <- 
+  function(
+    x, 
+    maxsum = 7L, 
+    digits = max(3L, getOption("digits") - 3L), ...
+  ) {
+
+    summary_ls <- vector(mode = "list", length = 1)
+
+    # Site prevalences by recruitment arm
+
+    orig_prev_df <- data.frame(
+      x@recruit_arm_prevalence_start,
+      row.names = x@recruit_arm_names
+    )
+    colnames(orig_prev_df) <- paste("Site", seq_len(ncol(orig_prev_df)))
+
+    summary_ls$site_prev <- withr::with_options(
+      list(scipen = 10),
+      print(round(orig_prev_df, digits = digits))
+    )
+
+    summary_ls
+  }
\ No newline at end of file