0.0.5.0.cran

.Rbuildignore

@@ -31,3 +31,4 @@ develop
 ^vignettes/original$
 ^vignettes/Makefile$
 ^node_modules$
+^\.claude$

.lintr

@@ -1,5 +1,12 @@
 linters: linters_with_defaults(
   line_length_linter = line_length_linter(120),
-  cyclocomp_linter = NULL,
-  object_usage_linter = NULL
+  object_usage_linter = NULL,
+  return_linter = NULL,
+  object_name_linter = NULL,
+  object_length_linter = NULL,
+  pipe_consistency_linter = NULL,
+  indentation_linter = NULL
+  )
+exclusions: list(
+  "vignettes/original"
   )

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: psborrow2
 Title: Bayesian Dynamic Borrowing Analysis and Simulation
-Version: 0.0.4.0
+Version: 0.0.5.1
 Authors@R: c(
    person(
       given = "Matt",

NEWS.md

@@ -1,3 +1,10 @@
+# psborrow2 0.0.5
+
+- Fixed a bug where operating characteristics in no-borrowing scenarios
+  incorrectly varied by external drift
+- Fixed a bug with the fixed power prior
+- Additional test cases
+
 # psborrow2 0.0.4
 
 - Additional bug fixes impacting continuous endpoints

R/analysis_class.R

@@ -67,20 +67,24 @@ setMethod(
 
     cat("Data: Matrix with", nrow(object@data_matrix), "observations \n")
     cat(
-      "    - ", sum(object@data_matrix[, get_vars(object@treatment)] == 0 &
+      "    - ",
+      sum(object@data_matrix[, get_vars(object@treatment)] == 0 &
         object@data_matrix[, get_vars(object@borrowing)["ext_flag_col"]] == 0),
       " internal controls\n"
     )
     cat(
-      "    - ", sum(object@data_matrix[, get_vars(object@treatment)] == 0 &
+      "    - ",
+      sum(object@data_matrix[, get_vars(object@treatment)] == 0 &
         object@data_matrix[, get_vars(object@borrowing)["ext_flag_col"]] == 1),
-      " external controls", ifelse(is(object@borrowing, "BorrowingNone"),
+      " external controls",
+      ifelse(is(object@borrowing, "BorrowingNone"),
         " (ignored in this analysis)\n",
         "\n"
       )
     )
     cat(
-      "    - ", sum(object@data_matrix[, get_vars(object@treatment)] == 1 &
+      "    - ",
+      sum(object@data_matrix[, get_vars(object@treatment)] == 1 &
         object@data_matrix[, get_vars(object@borrowing)["ext_flag_col"]] == 0),
       " internal experimental\n\n"
     )

R/borrowing_details.R

@@ -2,13 +2,13 @@
 #'
 #' Please use one of `borrowing_hierarchical_commensurate()`, `borrowing_none()`, or `borrowing_full()` instead.
 #' @export
-#' 
+#'
 #' @return
-#' This function does not return a value. When called, it triggers an error 
-#' message indicating that `borrowing_details()` is deprecated and that 
+#' This function does not return a value. When called, it triggers an error
+#' message indicating that `borrowing_details()` is deprecated and that
 #' one of `borrowing_hierarchical_commensurate()`, `borrowing_none()`, or
 #' `borrowing_full()` should be used instead.
-#' 
+#'
 #' @param ... Deprecated arguments to `borrowing_details`.
 borrowing_details <- function(...) {
   .Defunct(

R/borrowing_hierarchical_commensurate.R

@@ -74,7 +74,8 @@
 #'   __Pharmaceut. Statist., 13: 41--54__. \doi{10.1002/pst.1589}
 #'
 #' Hobbes, B.P., Carlin, B.P., Mandrekar, S.J. and Sargent, D.J. (2011),
-#'  Hierarchical commensurate and power prior models for adaptive incorporation of historical information in clinical trials.
+#'  Hierarchical commensurate and power prior models for adaptive
+#'  incorporation of historical information in clinical trials.
 #'  __Biometrics, 67: 1047--1056__. \doi{10.1111/j.1541-0420.2011.01564.x}
 #'
 #' @return Object of class [`BorrowingHierarchicalCommensurate`][BorrowingHierarchicalCommensurate-class].

R/cast_mat_to_long_pem.R

@@ -20,7 +20,7 @@
 #'     "time",
 #'     "cnsr",
 #'     baseline_prior = prior_normal(0, 1000),
-#'     cut_points = c(1,2,3)
+#'     cut_points = c(1, 2, 3)
 #'   ),
 #'   borrowing = borrowing_hierarchical_commensurate(
 #'     "ext",
@@ -35,34 +35,43 @@
 #' anls_obj <- psborrow2:::cast_mat_to_long_pem(anls)
 #'
 cast_mat_to_long_pem <- function(analysis_obj) {
-
   ## Start with data.frame
   df <- as.data.frame(analysis_obj@data_matrix)
   cn <- colnames(df)
 
   ## Check cut points
   cut_points <- analysis_obj@outcome@cut_points
-  max_fup <- max(df[,analysis_obj@outcome@time_var])
+  max_fup <- max(df[, analysis_obj@outcome@time_var])
   cut_points_keep <- cut_points[cut_points < max_fup]
   if (length(cut_points_keep) < length(cut_points)) {
-    warning(paste0("Some cut points are greater than the maximum follow-up time of ", max_fup, ". These will be ignored."))
+    warning(
+      paste0(
+        "Some cut points are greater than the maximum follow-up time of ",
+        max_fup, ". These will be ignored."
+      )
+    )
   }
 
   ## Did they use a protected name?
   if (any(c("psb2__period", "psb2__start", "psb2__status", "__period__") %in% cn)) {
-    stop("The column names 'psb2__period', 'psb2__status', 'psb2__start', and '__period__' are reserved when using PEM. Please rename your columns.")
+    stop(
+      "The column names 'psb2__period', 'psb2__status', 'psb2__start', ",
+      "and '__period__' are reserved when using PEM. Please rename your columns."
+    )
   }
 
   ## Censorship flag -> event flag
   df$psb2__status <- 1 - df[, analysis_obj@outcome@cens_var]
 
   ## Create long data
-  long_df <- survival::survSplit(data = df,
-                                 cut = cut_points_keep,
-                                 event = "psb2__status",
-                                 episode = "psb2__period",
-                                 start = "psb2__tstart",
-                                 end = analysis_obj@outcome@time_var)
+  long_df <- survival::survSplit(
+    data = df,
+    cut = cut_points_keep,
+    event = "psb2__status",
+    episode = "psb2__period",
+    start = "psb2__tstart",
+    end = analysis_obj@outcome@time_var
+  )
   names(long_df)[which(names(long_df) == "psb2__period")] <- "__period__"
   long_df[, analysis_obj@outcome@cens_var] <- 1 - long_df[, "psb2__status"]
   long_df[, "time"] <- long_df[, "time"] - long_df[, "psb2__tstart"]
@@ -71,10 +80,9 @@ cast_mat_to_long_pem <- function(analysis_obj) {
 
   # Update data matrix
   analysis_obj@data_matrix <- long_mat
-  
+
   # Update periods
-  analysis_obj@outcome@n_periods <- NROW(unique(long_df[,"__period__"]))
+  analysis_obj@outcome@n_periods <- NROW(unique(long_df[, "__period__"]))
 
   return(analysis_obj)
-
 }

R/cmdstan.R

@@ -34,7 +34,6 @@ check_cmdstanr <- function(check_sampling = FALSE) {
 }
 
 
-
 #' @return `check_cmdstan()` returns `TRUE` if `CmdStan` seems to be installed, otherwise `FALSE`
 #' @describeIn check_cmdstanr Check if the `CmdStan` command line tools are available.
 #' @export

R/helpers.R

@@ -6,11 +6,11 @@
 #'
 #' Plots the density values as a curve with the lower vertical limit set to 0.
 #'
-#' 
+#'
 #' @return No return value, this function generates a plot in the current graphics device.
 #'
 #' @export
-#' 
+#'
 #' @examples
 #' x <- seq(-2, 2, len = 100)
 #' y <- dnorm(x)

R/load_and_interpolate_stan_model.R

@@ -8,7 +8,6 @@
 #' @return String containing the interpolated Stan model
 #' @include outcome_surv_pem.R
 build_model_string <- function(template_domain, template_filename, outcome, borrowing, analysis_obj, ...) {
-
   # Load the Stan template
   template <- load_stan_file(template_domain, template_filename)
 

R/load_stan_file.R

@@ -1,19 +1,19 @@
 #' Load a Stan `psborrow2` template
 #'
 #' This function loads a Stan template file from the package's 'inst/stan' directory.
-#' @param ... subidrectories
+#' @param ... subdirectories
 #' @return template string
 load_stan_file <- function(...) {
   # Construct the path within the package
   template_path <- system.file("stan", ..., package = "psborrow2")
-  
+
   # Check if the file exists
   if (template_path == "") {
     stop("Template file not found at path: ", file.path("inst/stan", ...))
   }
-  
+
   # Read the content of the file
   template_content <- paste(readLines(template_path), collapse = "\n")
-  
+
   return(template_content)
 }

R/outcome_bin_logistic.R

@@ -43,9 +43,11 @@
 #' The `baseline_prior` argument specifies the prior distribution for the
 #' baseline log odds. The interpretation of the `baseline_prior` differs
 #' slightly between borrowing methods selected.
-#' - \emph{Dynamic borrowing using `borrowing_hierarchical_commensurate()`}: the `baseline_prior` for Bayesian Dynamic Borrowing refers
+#' - \emph{Dynamic borrowing using `borrowing_hierarchical_commensurate()`}:
+#' the `baseline_prior` for Bayesian Dynamic Borrowing refers
 #' to the log odds of the external control arm.
-#' - \emph{Full borrowing} or \emph{No borrowing} using `borrowing_full()` or `borrowing_none()`: the `baseline_prior` for
+#' - \emph{Full borrowing} or \emph{No borrowing} using
+#' `borrowing_full()` or `borrowing_none()`: the `baseline_prior` for
 #' these borrowing methods refers to the log odds for the
 #' internal control arm.
 #'

R/outcome_surv_exponential.R

@@ -44,9 +44,11 @@
 #' The `baseline_prior` argument specifies the prior distribution for the
 #' baseline log hazard rate. The interpretation of the `baseline_prior` differs
 #' slightly between borrowing methods selected.
-#' - \emph{Dynamic borrowing using `borrowing_hierarchical_commensurate()`}: the `baseline_prior` for Bayesian Dynamic Borrowing
+#' - \emph{Dynamic borrowing using `borrowing_hierarchical_commensurate()`}:
+#' the `baseline_prior` for Bayesian Dynamic Borrowing
 #' refers to the log hazard rate of the external control arm.
-#' - \emph{Full borrowing} or \emph{No borrowing} using `borrowing_full()` or `borrowing_none()`: the `baseline_prior` for
+#' - \emph{Full borrowing} or \emph{No borrowing} using
+#' `borrowing_full()` or `borrowing_none()`: the `baseline_prior` for
 #' these borrowing methods refers to the log hazard rate for the
 #' internal control arm.
 #' @return Object of class [`OutcomeSurvExponential`][OutcomeSurvExponential-class].

R/outcome_surv_pem.R

@@ -49,8 +49,10 @@
 #' See `Details` for more information.
 #' @param cut_points numeric. Vector of internal cut points for the piecewise exponential model. Note: the choice of
 #' cut points will impact the amount of borrowing between arms when dynamic borrowing methods are selected. It is
-#' recommended to choose cut points that contain an equal number of events within each interval. Please include only internal
-#' cut points in the vector. For instance, for cut points of \[0, 15], (15, 20\], (20, Inf), the vector should be c(15, 20).
+#' recommended to choose cut points that contain an equal number of events
+#' within each interval. Please include only internal
+#' cut points in the vector. For instance, for cut points of
+#' \[0, 15], (15, 20\], (20, Inf), the vector should be c(15, 20).
 #' If you pass cut-points beyond the follow-up of the data, you will receive an informative warning when calling
 #' `create_analysis_object()` and these cut points will be ignored.
 #'
@@ -62,10 +64,13 @@
 #' consider different baseline priors within each cut point.
 #' The interpretation of the `baseline_prior` differs
 #' slightly between borrowing methods selected.
-#' - \emph{Dynamic borrowing using `borrowing_hierarchical_commensurate()`}: the `baseline_prior` for Bayesian Dynamic Borrowing
+#' - \emph{Dynamic borrowing using `borrowing_hierarchical_commensurate()`}:
+#' the `baseline_prior` for Bayesian Dynamic Borrowing
 #' refers to the log hazard rate of the external control arm.
-#' - \emph{Full borrowing} or \emph{No borrowing} using `borrowing_full()` or `borrowing_none()`: the `baseline_prior` for
-#' these borrowing methods refers to the log hazard rate for the internal control arm.
+#' - \emph{Full borrowing} or \emph{No borrowing} using
+#' `borrowing_full()` or `borrowing_none()`: the `baseline_prior` for
+#' these borrowing methods refers to the log hazard rate for the
+#' internal control arm.
 #' @return Object of class [`OutcomeSurvPEM`][OutcomeSurvPEM-class].
 #' @export
 #' @family outcome models
@@ -78,7 +83,6 @@
 #'   cut_points = c(10, 15, 30)
 #' )
 outcome_surv_pem <- function(time_var, cens_var, baseline_prior, weight_var = "", cut_points) {
-
   # Standard input checks
   assert_string(time_var)
   assert_string(cens_var)
@@ -94,8 +98,11 @@ outcome_surv_pem <- function(time_var, cens_var, baseline_prior, weight_var = ""
 
   cut_points_neg0 <- any(cut_points <= 0)
   cut_points_inf <- any(cut_points == Inf)
-  if (cut_points_neg0 | cut_points_inf) {
-    stop("`cut_points` must be positive, non-infinite and exclude 0. Just put internal cutpoints, the model will automatically add 0 and Inf.")
+  if (cut_points_neg0 || cut_points_inf) {
+    stop(
+      "`cut_points` must be positive, non-infinite and exclude 0. ",
+      "Just put internal cutpoints, the model will automatically add 0 and Inf."
+    )
   }
 
   n_cuts <- length(cut_points)

R/outcome_surv_weibull_ph.R

@@ -53,9 +53,11 @@
 #' The `baseline_prior` argument specifies the prior distribution for the
 #' baseline log hazard rate. The interpretation of the `baseline_prior` differs
 #' slightly between borrowing methods selected.
-#' - \emph{Dynamic borrowing using `borrowing_hierarchical_commensurate()`}: the `baseline_prior` for Bayesian Dynamic Borrowing
+#' - \emph{Dynamic borrowing using `borrowing_hierarchical_commensurate()`}:
+#' the `baseline_prior` for Bayesian Dynamic Borrowing
 #' refers to the log hazard rate of the external control arm.
-#' - \emph{Full borrowing} or \emph{No borrowing} using `borrowing_full()` or `borrowing_none()`: the `baseline_prior` for
+#' - \emph{Full borrowing} or \emph{No borrowing} using
+#' `borrowing_full()` or `borrowing_none()`: the `baseline_prior` for
 #' these borrowing methods refers to the log hazard rate for the
 #' internal control arm.
 #'

R/prior_bernoulli.R

@@ -85,10 +85,10 @@ setMethod(
 #' @param ... Deprecated arguments to `bernoulli_prior()`.
 #'
 #' @return
-#' This function does not return a value. When called, it triggers an error 
-#' message indicating that `bernoulli_prior()` is deprecated and that 
+#' This function does not return a value. When called, it triggers an error
+#' message indicating that `bernoulli_prior()` is deprecated and that
 #' `prior_bernoulli()` should be used instead.
-#' 
+#'
 #' @export
 bernoulli_prior <- function(...) {
   .Defunct(

R/prior_beta.R

@@ -90,12 +90,12 @@ setMethod(
 #'
 #' Please use `prior_beta()` instead.
 #' @param ... Deprecated arguments to `beta_prior()`.
-#' 
+#'
 #' @return
-#' This function does not return a value. When called, it triggers an error 
-#' message indicating that `beta_prior()` is deprecated and that 
+#' This function does not return a value. When called, it triggers an error
+#' message indicating that `beta_prior()` is deprecated and that
 #' `prior_beta()` should be used instead.
-#' 
+#'
 #' @export
 beta_prior <- function(...) {
   .Defunct(

R/prior_cauchy.R

@@ -87,17 +87,16 @@ setMethod(
 )
 
 
-
 #' Legacy function for the cauchy prior
 #'
 #' Please use `prior_cauchy()` instead.
 #' @param ... Deprecated arguments to `cauchy_prior()`.
-#' 
+#'
 #' @return
-#' This function does not return a value. When called, it triggers an error 
-#' message indicating that `cauchy_prior()` is deprecated and that 
+#' This function does not return a value. When called, it triggers an error
+#' message indicating that `cauchy_prior()` is deprecated and that
 #' `prior_cauchy()` should be used instead.
-#' 
+#'
 #' @export
 cauchy_prior <- function(...) {
   .Defunct(

R/prior_exponential.R

@@ -85,12 +85,12 @@ setMethod(
 #'
 #' Please use `prior_exponential()` instead.
 #' @param ... Deprecated arguments to `exponential_prior()`.
-#' 
+#'
 #' @return
-#' This function does not return a value. When called, it triggers an error 
-#' message indicating that `exponential_prior()` is deprecated and that 
+#' This function does not return a value. When called, it triggers an error
+#' message indicating that `exponential_prior()` is deprecated and that
 #' `prior_exponential()` should be used instead.
-#' 
+#'
 #' @export
 exponential_prior <- function(...) {
   .Defunct(