99 plot oc

DESCRIPTION

@@ -9,7 +9,7 @@ Authors@R: c(
     person("Jiawen", "Zhu", , "[email protected]", role = "aut"),
     person("James", "Lymp", role = "aut"),
     person("Anastasia", "Teterina", , "[email protected]", role = "aut"),
-    person("Audrey", "Yeo", , "audrey.yeo@roche.com", role = c("aut")),
+    person("Audrey", "Yeo", , "audrey.yeo@finc-research.com", role = c("aut")),
     person("F. Hoffmann-La Roche Ltd", role = c("cph", "fnd"))
   )
 Description: The phase1b R package is intended to be used when conducting
@@ -32,16 +32,24 @@ Suggests:
     shinyjs,
     shinythemes,
     reshape,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    magrittr,
+    tidyverse,
+    devtools,
+    vdiffr
 Imports:
     ggplot2,
     checkmate,
-    devtools,
     lifecycle,
-    vdiffr,
     tools,
     tidyr,
-    dplyr (>= 1.0.0)
+    dplyr (>= 1.0.0),
+    tibble,
+    devtools,
+    magrittr,
+    tidyverse,
+    tools,
+    vdiffr
 VignetteBuilder:
     knitr
 Encoding: UTF-8

NAMESPACE

@@ -20,6 +20,7 @@ export(plotBeta)
 export(plotBetaDiff)
 export(plotBounds)
 export(plotDecision)
+export(plotOc)
 export(postprob)
 export(postprobBeta)
 export(postprobDist)
@@ -30,11 +31,13 @@ export(qbetadiff)
 export(runShinyPhase1b)
 export(sumBetadiff)
 export(sumTable)
-export(vintage_plotOc)
 import(checkmate)
+importFrom(ggplot2,geom_area)
+importFrom(ggplot2,geom_bar)
+importFrom(ggplot2,geom_line)
+importFrom(ggplot2,ggtitle)
 importFrom(graphics,abline)
 importFrom(graphics,axis)
-importFrom(graphics,barplot)
 importFrom(graphics,box)
 importFrom(graphics,grid)
 importFrom(graphics,hist)
@@ -43,7 +46,6 @@ importFrom(graphics,mtext)
 importFrom(graphics,par)
 importFrom(graphics,plot)
 importFrom(graphics,polygon)
-importFrom(graphics,title)
 importFrom(lifecycle,deprecated)
 importFrom(stats,acf)
 importFrom(stats,binom.test)

R/plotBeta.R

@@ -51,7 +51,7 @@ plotBeta <- function(alpha, beta) {
 #'
 #' @example examples/plotBetaDiff.R
 #'
-#' @importFrom graphics par axis polygon mtext
+#' @importFrom ggplot2 geom_line ggtitle geom_area
 #' @importFrom stats integrate
 #'
 #' @export

R/plotOc.R

@@ -1,16 +1,9 @@
 #' Helper function for simulation result as input for `plotOc()`
 #'
-#' Data frame input for bar plot for simulated results of :
-#' - `[ocPostprob()]`
-#' - `[ocPostprobDist()]`
-#' - `[ocPostpred()]`
-#' - `[ocPostpredDist()]`
-#' - `[ocRctPostprobDist()]`
-#' - `[ocRctPredprobDist()]`
-#'
 #' @inheritParams h_get_oc
 #' @typed all_looks : numeric
 #' original looks before adjustment by `wiggle = TRUE`, if applied.
+#' Different to `all_sizes` which is after the adjustment, if made.
 #'
 #' @return A data frame or tibble with the following variables :
 #'  - `decision` : decision `flag` with `TRUE` for Go, `FALSE` for Stop, `NA` for Gray zone.
@@ -20,73 +13,85 @@
 #'
 #' @keywords internal
 #'
-h_get_dataframe_oc <- function(decision, sample_size, all_looks) {
-  assert_logical(decision)
-  assert_numeric(sample_size)
-  assert_numeric(all_looks)
+h_get_dataframe_oc <- function(decision, all_sizes, all_looks) {
   df <- data.frame(
     decision = decision,
-    sample_size = sample_size,
-    look = all_looks
+    all_sizes = all_sizes,
+    all_looks = all_looks # original looks
   )
   # summarise into frequency table
-  df <- df %>%
-    dplyr::group_by(decision, look) %>%
-    dplyr::summarise(prop = sum(length(decision)) / nrow(df)) %>%
-    dplyr::as_tibble()
+  df <- df |>
+    dplyr::group_by(decision, all_looks) |>
+    dplyr::summarise(prop = sum(length(decision)) / nrow(df)) |>
+    tibble::as_tibble()
   # setting levels of factors
-  all_decision <- c(TRUE, FALSE, NA)
-  all_looks <- unique(sort(all_looks))
-  df$decision <- factor(df$decision, levels = all_decision)
-  df$look <- factor(df$look, levels = all_looks)
-  df %>%
-    tidyr::complete(decision, look, fill = list(prop = 0))
+  decision_levels <- c(TRUE, FALSE, NA)
+  look_levels <- unique(sort(all_looks))
+  df$decision <- factor(df$decision, levels = decision_levels)
+  df$look <- factor(df$all_looks, levels = look_levels)
+  df <- df |>
+    tidyr::complete(decision, all_looks, fill = list(prop = 0))
+  df
 }
 
-#' Display the operating characteristics using an oc object
-#'
-#' Reads results from [ocPredprob()]
-#' etc. and displays a bar plot of the operating characteristics
+
+#' Display the operating characteristics results using an `oc` object
 #'
-#' @typed oc : list
-#' returned oc parameters
-#' @return nothing, only plots as side effect
+#' Plots results from simulated results of :
+#' - `[ocPostprob()]`
+#' - `[ocPostprobDist()]`
+#' - `[ocPostpred()]`
+#' - `[ocPostpredDist()]`
+#' - `[ocRctPostprobDist()]`
+#' - `[ocRctPredprobDist()]`
 #'
-#' @importFrom graphics barplot title
+#' @inheritParams h_get_dataframe_oc
+#' @typed wiggle_status : flag
+#' from `wiggle` flag in object.
+#' @return ggplot object
 #'
 #' @example examples/plotOc.R
+#'
+#' @importFrom ggplot2 geom_bar ggtitle
+#'
 #' @export
 #' @keywords graphics
-vintage_plotOc <- function(oc) {
-  if (wiggle == FALSE) {
-    data <- table(oc$Decision, oc$SampleSize) / oc$params$sim
-  } else {
-
-  }
-  ggplot(oc, aes(x = name, y = value)) +
-    geom_bar(stat = "identity") +
-    ggtitle("Percentage of trials that Go and Stop per look") +
-    ylabs("Percentage %") +
-    xlabs("Looks and sample size")
-
-  ## plot function for oc.predprob or oc.postprob, or the dist versions of them
-  graphics::barplot(table(oc$Decision, oc$SampleSize) / oc$params$sim, beside = TRUE)
-
-  ## get the parameter
-  parDat <- lapply(z$params, deparse)
-
-  ## get parameters, which are saved in parDat
-  allParNames <- c(
-    "p", "p0", "p1",
-    "delta", "deltaE", "deltaF", "relativeDelta",
-    "phiL", "phiU", "tL", "tU", "tT", "parE", "parS"
+plotOc <- function(decision, all_sizes, all_looks, wiggle_status) {
+  assert_logical(decision)
+  assert_numeric(all_sizes)
+  assert_numeric(all_looks)
+  assert_flag(wiggle_status)
+  df <- h_get_dataframe_oc(
+    decision = decision,
+    all_sizes = all_sizes,
+    all_looks = all_looks
   )
-  parInds <- which(names(parDat) %in% allParNames)
+  barplot <-
+    ggplot2::ggplot(df, ggplot2::aes(fill = decision, x = look, y = prop)) +
+    ggplot2::geom_bar(position = "dodge", stat = "identity") +
+    ggplot2::ggtitle(
+      "Results from simulation : \nProportion of Go/Stop/Grey zone decisions per interim/final analysis"
+    ) +
+    ggplot2::theme(title = ggplot2::element_text(size = 13)) +
+    ggplot2::ylab("percentage") +
+    ggplot2::theme(axis.text.x = ggplot2::element_text(size = 12)) +
+    ggplot2::xlab("look (n)") +
+    ggplot2::scale_fill_manual(
+      values = c("#009E73", "#FF0046", "lightgrey"),
+      labels = c("Go", "Stop", "Grey zone")
+    ) +
+    ggplot2::labs(fill = "Decision")
+  generic_title <-
+    "Results from simulation : \nProportion of Go/Stop/Grey zone decisions per interim/final analysis"
+  wiggle_warning_footnote <- paste("\nNote that sample sizes may differ slightly from the ones labeled")
 
-  graphics::title(paste(names(parDat[parInds]), parDat[parInds],
-    sep = "=", collapse = ", "
-  ))
-  graphics::title(xlab = paste(dimnames(z$oc)[[2]], signif(z$oc, 3),
-    sep = " = ", collapse = ", "
-  ))
+  if (wiggle_status) {
+    barplot +
+      ggplot2::ggtitle(label = generic_title) +
+      ggplot2::labs(caption = wiggle_warning_footnote) +
+      ggplot2::theme(plot.caption = ggplot2::element_text(hjust = 0, size = 10))
+  } else {
+    barplot +
+      ggplot2::ggtitle(generic_title)
+  }
 }

_pkgdown.yml

@@ -2,7 +2,7 @@ url: https://genentech.github.io/phase1b
 
 template:
   bootstrap: 5
-  bootswatch: cerulean
+  bootswatch: zephyr
   includes:
     in_header: |
        <!-- Global site tag (gtag.js) - Google Analytics -->
@@ -18,3 +18,4 @@ navbar:
   right:
     - icon: fa-github
       href: https://github.com/genentech/phase1b
+