Merge branch 'main' into new_check

.Rbuildignore

@@ -20,3 +20,4 @@ images
 ^maicplus\.Rcheck$
 ^maicplus.*\.tar\.gz$
 ^maicplus.*\.tgz$
+^inst/dev/MAIC/MAIC-main/.Rbuildignore

DESCRIPTION

@@ -6,21 +6,17 @@ Date: 2023-03-03
 Authors@R:
     person("hta-pharma", , , "hta-pharma@example.com", role = c("aut", "cre"))
 Description: R package template with GitHub Actions workflows included.
-License: Apache License 2.0 | file LICENSE
+License: Apache License 2.0
 URL: https://github.com/hta-pharma/maicplus/
 BugReports: https://github.com/hta-pharma/maicplus/issues
 Depends:
     R (>= 3.6)
 Imports:
-    plumber,
-    shiny,
-    survival,
-    stringr
+    graphics,
+    stats,
+    survival
 Suggests:
-    future,
-    httr,
     knitr,
-    shinytest,
     testthat (>= 2.0)
 VignetteBuilder:
     knitr

NAMESPACE

@@ -1,2 +1,25 @@
 # Generated by roxygen2: do not edit by hand
 
+export(bucher)
+export(center_ipd)
+export(estimate_weights)
+export(log_cum_haz_plot)
+export(maic_tte_unanchor)
+export(medSurv_makeup)
+export(plot_weights)
+export(process_agd)
+export(process_ipd)
+export(resid_plot)
+export(survfit_makeup)
+import(stats)
+importFrom(graphics,abline)
+importFrom(graphics,axis)
+importFrom(graphics,hist)
+importFrom(graphics,legend)
+importFrom(graphics,lines)
+importFrom(graphics,par)
+importFrom(graphics,points)
+importFrom(survival,Surv)
+importFrom(survival,cox.zph)
+importFrom(survival,coxph)
+importFrom(survival,survfit)

R/bucher.R

@@ -4,33 +4,38 @@
 
 #' Bucher method for adjusted treatment effect
 #'
-#' Given two estimated treatment effects of A vs. C and B vs. C (i.e. two point estimates and corresponding standard errors),
-#' derive the adjusted treatment of A vs. B using Bucher method, with two-sided confidence limits and Z-test p-value
+#' Given two estimated treatment effects of A vs. C and B vs. C
+#' (i.e. two point estimates and corresponding standard errors),
+#' derive the adjusted treatment of A vs. B using Bucher method,
+#' with two-sided confidence limits and Z-test p-value
 #'
-#' @param trt a list with two named scalars for the study with interested experimental arm, one named 'est' for the point estimate, and the other named 'se' for the standard error
+#' @param trt a list with two named scalars for the study with interested experimental arm,
+#' one named `'est'` for the point estimate, and the other named `'se'` for the standard error
 #' @param com same as \code{trt}, but for the study with interested control arm
-#' @param conf_lv a numerical scalar, prescribe confidence level to derive two-sided confidence interval for the adjusted treatment effect
+#' @param conf_lv a numerical scalar, prescribe confidence level to derive two-sided
+#' confidence interval for the adjusted treatment effect
 #'
 #' @return a list with 5 elements,
 #' \describe{
-#'   \item est - a scalar, point estimate of the adjusted treatment effect
-#'   \item se - a scalar, standard error of the adjusted treatment effect (i.e. \code{est} in return)
-#'   \item ci_l - a scalor, lower confidence limit of a two-sided CI with prescribed nominal level by \code{conf_lv}
-#'   \item ci_u - a scalor, upper confidence limit of a two-sided CI with prescribed nominal level by \code{conf_lv}
-#'   \item pval - p-value of Z-test, with null hypothesis that \code{est} is zero
+#'   \item{est}{a scalar, point estimate of the adjusted treatment effect}
+#'   \item{se}{a scalar, standard error of the adjusted treatment effect (i.e. \code{est} in return)}
+#'   \item{ci_l}{a scalar, lower confidence limit of a two-sided CI with prescribed nominal level by \code{conf_lv}}
+#'   \item{ci_u}{a scalar, upper confidence limit of a two-sided CI with prescribed nominal level by \code{conf_lv}}
+#'   \item{pval}{p-value of Z-test, with null hypothesis that \code{est} is zero}
 #' }
 #' @export
+#' @import stats
 #'
 #' @examples
 bucher <- function(trt, com, conf_lv = 0.95) {
   est <- trt$est - com$est
   se <- sqrt(trt$se^2 + com$se^2)
-  ci_l <- est - qnorm(0.5 + conf_lv / 2) * se
-  ci_u <- est + qnorm(0.5 + conf_lv / 2) * se
+  ci_l <- est - stats::qnorm(0.5 + conf_lv / 2) * se
+  ci_u <- est + stats::qnorm(0.5 + conf_lv / 2) * se
   if (est > 0) {
-    pval <- 2 * (1 - pnorm(est, 0, se))
+    pval <- 2 * (1 - stats::pnorm(est, 0, se))
   } else {
-    pval <- 2 * pnorm(est, 0, se)
+    pval <- 2 * stats::pnorm(est, 0, se)
   }
 
   list(
@@ -44,13 +49,14 @@ bucher <- function(trt, com, conf_lv = 0.95) {
 
 # functions NOT to be exported ---------------------------------------
 
-#' Report-friendly output format for resutl from Bucher's method
+#' Report-friendly output format for result from Bucher's method
 #'
 #' @param output output from \code{\link{bucher}} function
 #' @param ci_digits an integer, number of decimal places for point estimate and derived confidence limits
 #' @param pval_digits an integer, number of decimal places to display Z-test p-value
 #'
-#' @return a character vector of two elements, first element inf format of 'est (ci_l; ci_u)', second element is Z-test p-value, rounded according to \code{pval_digits}
+#' @return a character vector of two elements, first element in format of 'est (ci_l; ci_u)'`,
+#'  second element is the Z-test p-value, rounded according to \code{pval_digits}
 
 print_bucher <- function(output, ci_digits = 2, pval_digits = 3) {
   res <- paste0(

R/maic_unanchored_tte.R

@@ -2,7 +2,7 @@
 #'
 #' @param useWt a numeric vector of individual MAIC weights, length should the same as \code{nrow(dat)}
 #' @param dat a data frame that meet format requirements in 'Details', individual patient data (IPD) of internal trial
-#' @param dat_ext a data frame, pseudo IPD from digitalized KM curve of external trial
+#' @param dat_ext a data frame, pseudo IPD from digitized KM curve of external trial
 #' @param trt  a character string, name of the interested treatment in internal trial (real IPD)
 #' @param trt_ext character string, name of the interested comparator in external trial used to subset \code{dat_ext} (pseudo IPD)
 #' @param endpoint_name a character string, name of the endpoint
@@ -13,11 +13,12 @@
 #' \itemize{
 #'   \item treatment - character or factor column
 #'   \item status - logical column, TRUE for censored/death, FALSE for otherwise
-#'   \time time - numeric column, observation time of the \code{status}; unit in days
+#'   \item time - numeric column, observation time of the \code{status}; unit in days
 #' }
 #'
 #' @return
 #' @importFrom survival Surv survfit coxph cox.zph
+#' @importFrom graphics par axis lines points legend abline
 #' @export
 #'
 #' @examples
@@ -50,10 +51,10 @@ maic_tte_unanchor <- function(useWt, dat, dat_ext, trt, trt_ext,
   # derive km w and w/o weights
   kmobj <- survfit(Surv(time, status) ~ treatment, dat, conf.type = "log-log")
   kmobj_adj <- survfit(Surv(time, status) ~ treatment, dat, weights = dat$weight, conf.type = "log-log")
-  
+
   par(cex.main=0.85)
-  km_makeup(kmobj, kmobj_adj, time_scale = time_scale, 
-            trt = trt, trt_ext = trt_ext, 
+  km_makeup(kmobj, kmobj_adj, time_scale = time_scale,
+            trt = trt, trt_ext = trt_ext,
             endpoint_name = endpoint_name)
   res[["plot_km"]] <- grDevices::recordPlot()
 
@@ -131,13 +132,14 @@ maic_tte_unanchor <- function(useWt, dat, dat_ext, trt, trt_ext,
 }
 
 #' helper function: sort out a nice report table to summarize survival analysis results
-#' for maic_tte_unanchor
+#' for `maic_tte_unanchor`
 #'
 #' @param coxobj returned object from \code{\link[survival]{coxph}}
 #' @param medSurvobj returned object from \code{\link{medSurv_makeup}}
 #' @param tag a string, by default NULL, if specified, an extra 1st column is created in the output
 #'
-#' @return a data frame with sample size, incidence rate, median survival time with 95%CI, hazard ratio estimate with 95%CI and wald test of hazard ratio
+#' @return a data frame with sample size, incidence rate, median survival time with 95% CI, hazard ratio estimate with
+#' 95% CI and Wald test of hazard ratio
 
 report_table <- function(coxobj, medSurvobj, tag = NULL) {
   hr_res <- format(round(summary(coxobj)$conf.int[-2], 2), nsmall = 2)

R/matching.R

@@ -10,16 +10,18 @@
 #' @param data a numeric matrix, centered covariates of IPD, no missing value in any cell is allowed
 #' @param centered_colnames a character or numeric vector (column indicators) of centered covariates
 #' @param startVal a scalar, the starting value for all coefficients of the propensity score regression
-#' @param method a string, name of the optimization algorithm (see 'method' argument of \code{base::optim()}). The default is "BFGS", other options are "Nelder-Mead", "CG", "L-BFGS-B", "SANN", and "Brent"
+#' @param method a string, name of the optimization algorithm (see 'method' argument of \code{base::optim()}).
+#' The default is `"BFGS"`, other options are `"Nelder-Mead"`, `"CG"`, `"L-BFGS-B"`, `"SANN"`, and `"Brent"`
 #' @param ... all other arguments from \code{base::optim()}
 #'
 #' @return a list with the following 4 elements,
 #' \describe{
-#'   \item data - a data.frame, includes the input \code{data} with appended column 'weights' and 'scaled_weights'. Scaled weights has a summation to be the number of rows in \code{data} that has no missing value in any of the effect modifiers
-#'   \item centered_colnames - column names of centered effect modifiers in \code{data}
-#'   \item nr_missing - number of rows in \code{data} that has at least 1 missing value in specified centered effect modifiers
-#'   \item ess - effective sample size, square of sum divided by sum of squares
-#'   \item opt - R object returned by \code{base::optim()}, for assess convergence and other details
+#'   \item{data}{a data.frame, includes the input \code{data} with appended column 'weights' and 'scaled_weights'.
+#'   Scaled weights has a summation to be the number of rows in \code{data} that has no missing value in any of the effect modifiers}
+#'   \item{centered.colnames}{column names of centered effect modifiers in \code{data}}
+#'   \item{nr_missing}{number of rows in \code{data} that has at least 1 missing value in specified centered effect modifiers}
+#'   \item{ess}{effective sample size, square of sum divided by sum of squares}
+#'   \item{opt}{R object returned by \code{base::optim()}, for assess convergence and other details}
 #' }
 #' @export
 #'
@@ -105,6 +107,7 @@ estimate_weights <- function(data, centered_colnames = NULL, startVal = 0, metho
 #' @param main_title a character string, main title of the plot
 #'
 #' @return a plot of unscaled or scaled weights
+#' @importFrom graphics hist
 #' @export
 
 plot_weights <- function(wt, main_title = "Unscaled Individual Weights") {

R/process_data.R

@@ -88,7 +88,8 @@ process_agd <- function(raw_agd) {
   with(use_agd, use_agd[tolower(ARM)=="total",,drop=FALSE])
 }
 
-#' Dummize categorical variables in an individual patient data (ipd)
+
+#' Create dummy variables from categorical variables in an individual patient data (ipd)
 #' 
 #' This is a convenient function to convert categorical variables into dummy binary variables.
 #' This would be especially useful if the variable has more than two factors.
@@ -173,9 +174,11 @@ center_ipd <- function(ipd, agd){
 }
 
 
+
 # Functions NOT to be exported ---------------------------------------
 
-#' Calculate pooled arm statistics in AgD based on arm-specific statistics
+
+#' Calculate pooled arm statistics in Aggregated Data (AgD) based on arm-specific statistics
 #'
 #' This is a convenient function to pool arm statistics ## FILL IN
 #'
@@ -194,8 +197,8 @@ complete_agd <- function(use_agd) {
   use_agd$ARM[rowId] <- "total"
 
   # complete N and count
-  NN <- use_agd$N[rowId] <- sum(use_agd$N, na.rm=TRUE)
-  nn <- use_agd$N[-rowId]
+  NN <- use_agd[["N"]][rowId] <- sum(use_agd[["N"]], na.rm=TRUE)
+  nn <- use_agd[["N"]][-rowId]
   for(i in grep("_COUNT$",names(use_agd),value=TRUE)){
     use_agd[[i]][rowId] <- sum(use_agd[[i]], na.rm=TRUE)
   }
@@ -207,7 +210,7 @@ complete_agd <- function(use_agd) {
 
   # complete SD
   for(i in grep("_SD$",names(use_agd),value=TRUE)){
-    use_agd[[i]][rowId] <- sqrt( sum(use_agd[[i]]^2*(nn-1))/(N-1) )
+    use_agd[[i]][rowId] <- sqrt( sum(use_agd[[i]]^2*(nn-1))/(NN-1) )
   }
 
   # complete MEDIAN, approximately!!
@@ -220,7 +223,6 @@ complete_agd <- function(use_agd) {
 }
 
 
-
 #' helper function: transform TTE ADaM data to suitable input for survival R pkg
 #'
 #' @param dd data frame, ADTTE read via haven::read_sas

R/survival-helper.R

@@ -1,12 +1,12 @@
-#' helper function: makeup to get median survival time from a survival::survfit object
+#' helper function: makeup to get median survival time from a `survival::survfit` object
 #'
 #' extract and display median survival time with confidence interval
 #'
 #' @param km_fit returned object from \code{survival::survfit}
 #' @param legend a character string, name used in 'type' column in returned data frame
 #' @param time_scale a character string, 'year', 'month', 'week' or 'day', time unit of median survival time
 #'
-#' @return a data frame with a index column 'type', mdian survival time and confidence interval
+#' @return a data frame with a index column 'type', median survival time and confidence interval
 #' @export
 medSurv_makeup <- function(km_fit, legend = "before matching", time_scale) {
   timeUnit <- list("year" = 365.24, "month" = 30.4367, "week" = 7, "day" = 1)
@@ -30,7 +30,7 @@ medSurv_makeup <- function(km_fit, legend = "before matching", time_scale) {
 
 
 
-#' helper function: makeup survival::survfit object for km plot
+#' helper function: makeup `survival::survfit` object for km plot
 #'
 #' @param km_fit returned object from \code{survival::survfit}
 #'
@@ -210,9 +210,9 @@ log_cum_haz_plot <- function(clldat, time_scale, log_time = TRUE, endpoint_name
 }
 
 
-#' Plot schoenfeld residual plot for a Cox model fit
+#' Plot Schoenfeld residuals for a Cox model fit
 #'
-#' @param coxobj object returned from \code{\link[surival]{coxph}}
+#' @param coxobj object returned from \code{\link[survival]{coxph}}
 #' @param time_scale a character string, 'year', 'month', 'week' or 'day', time unit of median survival time
 #' @param log_time logical, TRUE (default) or FALSE
 #' @param endpoint_name a character string, name of the endpoint
@@ -233,7 +233,7 @@ resid_plot <- function(coxobj, time_scale = "month", log_time = TRUE, endpoint_n
     cex = 0.9, col = "navyblue", yaxt = "n",
     ylab = "Unscaled Schoenfeld Residual", xlab = paste0(ifelse(log_time, "Log-", ""), "Time in ", time_scale),
     main = paste0(
-      "Diagnosis Plot: Unscaled Schoefeld Residual\nEndpoint: ", endpoint_name,
+      "Diagnosis Plot: Unscaled Schoenfeld Residual\nEndpoint: ", endpoint_name,
       ifelse(subtitle == "", "", "\n"), subtitle
     )
   )

inst/WORDLIST

@@ -10,3 +10,17 @@ initializer
 pre
 repo
 Forkers
+comparator
+Bucher
+Bucher's
+unadjusted
+MAIC
+ci
+ESS
+IPD
+Schoenfeld
+ADTTE
+ADaM
+unanchored
+TTE
+AgD

inst/dev/maicplus/maicplus-main/bucher.R

@@ -5,24 +5,24 @@
 #'
 #' @param trt a list with two named scalars for the study with interested experimental arm, one named 'est' for the point estimate, and the other named 'se' for the standard error
 #' @param com same as \code{trt} for the study with interested control arm
-#' @param conf.lv a numerical scalar, prescribe confidence level to derive two-sided confidence interval for the adjusted treatment effect
+#' @param conf_lv a numerical scalar, prescribe confidence level to derive two-sided confidence interval for the adjusted treatment effect
 #'
 #' @return a list with 5 elements,
 #' \describe{
 #'   \item est - a scalar, point estimate of the adjusted treatment effect
 #'   \item se - a scalar, standard error of the adjusted treatment effect (i.e. \code{est} in return)
-#'   \item ci_l - a scalor, lower confidence limit of a two-sided CI with prescribed nominal level by \code{conf.lv}
-#'   \item ci_u - a scalor, upper confidence limit of a two-sided CI with prescribed nominal level by \code{conf.lv}
+#'   \item ci_l - a scalor, lower confidence limit of a two-sided CI with prescribed nominal level by \code{conf_lv}
+#'   \item ci_u - a scalor, upper confidence limit of a two-sided CI with prescribed nominal level by \code{conf_lv}
 #'   \item pval - p-value of Z-test, with null hypothesis that \code{est} is zero
 #' }
 #' @export
 #'
 #' @examples
-bucher <- function(trt, com, conf.lv = 0.95) {
+bucher <- function(trt, com, conf_lv = 0.95) {
   est <- trt$est - com$est
   se <- sqrt(trt$se^2 + com$se^2)
-  ci_l <- est - qnorm(0.5 + conf.lv / 2) * se
-  ci_u <- est + qnorm(0.5 + conf.lv / 2) * se
+  ci_l <- est - qnorm(0.5 + conf_lv / 2) * se
+  ci_u <- est + qnorm(0.5 + conf_lv / 2) * se
   if (est > 0) {
     pval <- 2 * (1 - pnorm(est, 0, se))
   } else {