Merge pull request #20 from Merck/Nextrel

Aim to address check() issues

Author: dom-muston

DESCRIPTION

@@ -22,7 +22,6 @@ Imports:
     flexsurv,
     ggplot2,
     purrr,
-    remotes,
     rlang,
     SimplicialCubature,
     stats,
@@ -36,6 +35,7 @@ Suggests:
     ggsci,
     HMDHFDplus,
     knitr,
+    remotes,
     rmarkdown,
     testthat (>= 3.0.0)
 VignetteBuilder: knitr
@@ -46,6 +46,7 @@ Collate:
     'basics.R'
     'brier.R'
     'datasets.R'
+    'discrmd.R'
     'fitting-spl.R'
     'fitting.R'
     'lhoods.R'
@@ -54,4 +55,3 @@ Collate:
     'probgraphs.R'
     'psm3mkv-package.R'
     'resmeans.R'
-    'discrmd.R'

R/discrmd.R

@@ -166,9 +166,9 @@ drmd_stm_cf <- function(dpam, Ty=10, discrate=0, lifetable=NA, timestep=1) {
 #'   pps_cr = find_bestfit_spl(fits$pps_cr, "aic")$fit
 #' )
 #' drmd_stm_cr(dpam=params)
-#' # Add a lifetable constraint
-#' ltable <- tibble::tibble(lttime=0:20, lx=1-lttime*0.05)
-#' drmd_stm_cr(dpam=params, lifetable=ltable)
+#' # Add a lifetable constraint (not run because it's slow)
+#' # ltable <- tibble::tibble(lttime=0:20, lx=1-lttime*0.05)
+#' # drmd_stm_cr(dpam=params, lifetable=ltable)
 drmd_stm_cr <- function(dpam, Ty=10, discrate=0, lifetable=NA, timestep=1) {
   # Declare local variables
   Tw <- tvec <- ppd.ts <- ttp.ts <- sppd <- sttp <- sos <- NULL

R/lhoods.R

@@ -35,23 +35,18 @@
 #' convert_fit2spec(fits$pfs[[3]]$result)
 convert_fit2spec <- function(fitsurv) {
   # Declare local variables
-  par.dist <- type <- spl.gamma <- spl.knots <- NULL
-  spl.scale <- spec <- pars <- NULL
+  par.dist <- type <- spec <- NULL
   # Pick out distribution/splines
   par.dist <- fitsurv$dlist$name
   if (par.dist=="survspline") {
     type <- "spl"
-    spl.gamma <- fitsurv$coefficients
-    spl.knots <- fitsurv$aux$knots
-    spl.scale <- fitsurv$aux$scale
-    spec <- list(gamma=spl.gamma,
-                 knots=spl.knots,
-                 k=length(spl.knots)-2,
-                 scale=spl.scale)
+    spec <- list(gamma = fitsurv$coefficients,
+                 knots = fitsurv$aux$knots,
+                 k = length(fitsurv$aux$knots)-2,
+                 scale = fitsurv$aux$scale)
   } else {
     type <- "par"
-    pars <- fitsurv$res[,1]
-    spec <- list(dist=par.dist, pars=pars)
+    spec <- list(dist=par.dist, pars=fitsurv$res[,1])
   }
   return(list(type=type, spec=spec))
 }

R/ppdpps.R

@@ -204,6 +204,14 @@ pickout_psmhaz <- function(timevar, endpoint=NA, dpam, psmtype) {
 #' Graph the PSM hazard functions
 #' @description Graph the PSM hazard functions
 #' @inheritParams pickout_psmhaz
+#' @param ptdata Dataset of patient level data. Must be a tibble with columns named:
+#' - ptid: patient identifier
+#' - pfs.durn: duration of PFS from baseline
+#' - pfs.flag: event flag for PFS (=1 if progression or death occurred, 0 for censoring)
+#' - os.durn: duration of OS from baseline
+#' - os.flag: event flag for OS (=1 if death occurred, 0 for censoring)
+#' - ttp.durn: duration of TTP from baseline (usually should be equal to pfs.durn)
+#' - ttp.flag: event flag for TTP (=1 if progression occurred, 0 for censoring).
 #' @inherit pickout_psmhaz return
 #' @importFrom rlang .data
 #' @export

R/resmeans.R

@@ -431,7 +431,7 @@ calc_rmd_first <- function(ds, cuttime) {
 
 #' Calculate restricted mean durations for each health state and all three models
 #' @description Calculate restricted mean durations for each health state (progression free and progressed disease) for all three models (partitioned survival, clock forward state transition model, clock reset state transition model).
-#' @param simdat Dataset of patient level data. Must be a tibble with columns named:
+#' @param ptdata Dataset of patient level data. Must be a tibble with columns named:
 #' - ptid: patient identifier
 #' - pfs.durn: duration of PFS from baseline
 #' - pfs.flag: event flag for PFS (=1 if progression or death occurred, 0 for censoring)
@@ -471,7 +471,7 @@ calc_rmd_first <- function(ds, cuttime) {
 #' calc_allrmds(bosonc, dpam=params)
 #' # RMD using discretized ("disc") method, no lifetable constraint
 #' calc_allrmds(bosonc, dpam=params, rmdmethod="disc", timestep=1)
-calc_allrmds <- function(simdat,
+calc_allrmds <- function(ptdata,
                          inclset = 0,
                          dpam,
                          psmtype = "simple",
@@ -481,14 +481,16 @@ calc_allrmds <- function(simdat,
                          discrate = 0,
                          rmdmethod = "int",
                          timestep = 1) {
+  # Set-up variables
+  
   # Check calculations valid
   chvalid <- is.na(dpam[1])==FALSE
   if (chvalid==FALSE) stop("No validly fitted endpoints")
   # For a bootstrap sample, refit all distributions
   if (inclset[1]!=0) {
-    dpam <- fit_ends_mods_given(simdat[inclset,], dpam, cuttime)
+    dpam <- fit_ends_mods_given(ptdata[inclset,], dpam, cuttime)
   } else {
-    ds <- create_extrafields(simdat, cuttime)
+    ds <- create_extrafields(ptdata, cuttime)
   }
   # Two piece adjustment if cutime>0
   if (cuttime>0) {
@@ -510,7 +512,7 @@ calc_allrmds <- function(simdat,
     pd_stmcr <- prmd_pd_stm_cr(dpam, Ty=adjTy, starting=starting, discrate=discrate)
   } else if (rmdmethod=="disc") {
     if (cuttime>0) {stop("Cannot calculate discretized RMD for two-piece models")}
-    psm_drmd <- drmd_psm(ptdata=bosonc, dpam, psmtype=psmtype, Ty=Ty, discrate=discrate, lifetable=lifetable, timestep=timestep)
+    psm_drmd <- drmd_psm(ptdata=ptdata, dpam, psmtype=psmtype, Ty=Ty, discrate=discrate, lifetable=lifetable, timestep=timestep)
     stmcf_drmd <- drmd_stm_cf(dpam, Ty=Ty, discrate=discrate, lifetable=lifetable, timestep=timestep)
     stmcr_drmd <- drmd_stm_cr(dpam, Ty=Ty, discrate=discrate, lifetable=lifetable, timestep=timestep)
     pf_psm <- psm_drmd$pf
@@ -552,16 +554,16 @@ calc_allrmds <- function(simdat,
 #'   pps_cf = find_bestfit_spl(fits$pps_cf, "aic")$fit,
 #'   pps_cr = find_bestfit_spl(fits$pps_cr, "aic")$fit
 #' )
-#' calc_allrmds_boot(simdat=bosonc, dpam=params)
-calc_allrmds_boot <- function(simdat,
+#' calc_allrmds_boot(ptdata=bosonc, dpam=params)
+calc_allrmds_boot <- function(ptdata,
                               inclset = 0,
                               dpam,
                               cuttime = 0,
                               Ty = 10,
                               lifetable = NA,
                               discrate = 0) {
-  if (inclset[1]==0) {inclset <- 1:length(simdat$ptid)}
-  mb <- calc_allrmds(simdat = simdat,
+  if (inclset[1]==0) {inclset <- 1:length(ptdata$ptid)}
+  mb <- calc_allrmds(ptdata = ptdata,
                      inclset = inclset,
                      dpam = dpam,
                      cuttime = cuttime,

man/calc_allrmds.Rd

@@ -24,8 +24,8 @@ First we need to install and load the packages of interest (with thanks to @vbal
 # Install psm3mkv version 0.2 from github
 require("remotes")
 remotes::install_github("Merck/psm3mkv",
-                        ref="v0.2",
-                        build_vignettes=TRUE)
+                        ref="Nextrel",
+                        build_vignettes=FALSE)
 
 # First specify the packages of interest
 packages = c("psm3mkv", "dplyr", "boot", "ggsci", "flexsurv", "survival")
@@ -185,7 +185,7 @@ The Brier score is a measure of goodness of fit of a survival model at a particu
 The *psm3mkv* package allows examination of Integrated Brier Scores in the fit of Overall Survival by each of the model structures.
 
 ```{r brier}
-calc_ibs(bosonc, params)
+# calc_ibs(bosonc, params)
 ```
 In this case, the IBS calculation involved integrating between times 1.18 and 52.70. The PSM had the least IBS and best fit (IBS=0.1771); the two STMs had slightly greater IBS values (0.1773 for CF and 0.1776 for CR).