R/ctrlSpec.R

In scientific-computing-solutions/eventPrediction: Event Prediction in Clinical Trials with Time-to-Event Outcomes

#This file contains the code required for the
#CtrlSpec class used in predict from parameters
#It is not exported for users
#and is used to translate the event/drop out rate 
#specifications in the Study constructors to a common 
#form to be stored within the Study object
#it is also used for the dropout specification in predict from
#data

# The CtrlSpec (control arm specification) class
# is not exported for user use but is used within the
# package to allow different ways of specifying the
# contorl arm rate when specifying a Study/CRGI study
# It also includes the text to be output in the summary text 
# concerning the control (and experimental) arm event rates.
# This class is also used when specifying the drop out rate for the 
# control arm
# @slot median The control arm median event time
# @slot text The control arm text to be included in the summary
# @slot experimentaltext a function which takes a HR and shape and outputs 
# the summary text information for the rate spec of the control arm    
setClass( "CtrlSpec", 
          slots= list(median="numeric",  
                      text="character", 
                      experimentaltext="function"
                      )
)


# Create a \code{CtrlSpec} by giving the control arm median survival
# time as used in the Oncology study constructor
# @param ctrl.median The control arm median time to event
# @return A \code{CtrlSpec} object
CtrlSpecfromMedian <- function(ctrl.median){

  if(!is.na(ctrl.median)){
    if(!is.numeric(ctrl.median) || length(ctrl.median) > 1 || ctrl.median < 0){
     stop("Invalid ctrl.median argument, it must be numeric and positive")
    }
  }
  
  f <- function(HR,shape){
    paste("median=",round(ctrl.median/HR^(1/shape),2),sep="")
  }
  
  new("CtrlSpec",median=ctrl.median,text=paste("median=",ctrl.median,sep=""),
      experimentaltext=f)  
    
}


# Create A CtrlSpec object from a list
# 
# The function calls \code{CtrlSpecfromProportion} with the appropriate
# arguments taken from a list. It is used when creating the dropout slot of 
# the \code{Study} object in the various Study constructors
#
# @param eventtext The text to be output in the summary of the ctrlspec object
# for example either "had an event by" or "(in absence of events) would drop out by"
# @param var.list A list with elements labelled time and proportion
# (and optionally shape). Or NULL for creating a CtrlSpec object with infinite median
# (i.e. specifying the median for drop outs given no drop outs)
# @param n.arms The number of arms for which to create CtrlSpec objects  
# @return A list of CtrlSpec objects one for each arm
CtrlSpecFromList <- function(var.list,eventtext,n.arms){
  
  #Infinite median if no "events" (used when specifying the median there are no drop outs)
  if(is.null(var.list)){
    x <- CtrlSpecfromProportion(time=Inf,proportion.had.event=0.5,shape=1)
    return(if(n.arms==1) list(ctrl=x) else list(ctrl=x,active=x))
  }
  
  if(!is.list(var.list) || is.null(var.list$time) || is.null(var.list$proportion) || length(var.list$proportion) > 2
     || length(var.list$proportion)!= n.arms){
    stop(paste("Invalid argument(s) to CtrlSpecFromList.",
               "See help for the dropout argument to Study function",
               "for an example of valid arguments."))
  }
  
  if(is.null(var.list$shape)) var.list$shape <- 1
  
  retVal <- lapply(var.list$proportion,function(x){
    CtrlSpecfromProportion(var.list$time,x,var.list$shape,eventtext)
  })
  
  names(retVal) <- if(n.arms==1) "ctrl" else c("ctrl","active")
  return(retVal)
  
}

# Create a \code{CtrlSpec} object giving the time at which a given 
# proportion of subjects have had an event as used in the CRGIStudy constructor
# @param time The time at which \code{ctrl.proportion} of the control group have had an event.
# Used to set the event rate 
# @param proportion.had.event The proportion of control arm subjects who have had an event by time \code{time} 
# @param shape The Weibull shape parameter for the control arm survival function
# @param eventtext The text to be output in the summary of the ctrlspec object
# for example either "had an event by" or "(in absence of events) would drop out by"
# @return A \code{CtrlSpec} object
CtrlSpecfromProportion <- function(time,proportion.had.event,shape,eventtext="had an event by"){
  
  lapply(list(shape=shape,time=time,proportion.had.event=proportion.had.event),
    function(x){
      if(!is.numeric(x) ||  length(x) != 1 || x <= 0){
       stop("Arguments to CtrlSpecfromProportion should be numeric, positive and of length 1 ") 
      }
    }       
  )
  
  if(proportion.had.event >= 1){
    stop("Invalid proportion.had.event argument")
  }
      
  text <- paste(proportion.had.event*100,"% of subjects ",eventtext," ",time,sep="")
  rate <- ((-log(1-proportion.had.event))^(1/shape))/time
  
  median <- log(2)^(1/shape)/rate
  
  f <- function(HR,shape){
    paste(round( (1-(1-proportion.had.event)^HR)*100, 2),"% of subjects ",eventtext," ",time,sep="")
  }
  
  new("CtrlSpec",median=median,text=text,experimentaltext=f)
  
}