Diff of /R/ctrlSpec.R [000000] .. [f2e496]

Switch to side-by-side view

--- a
+++ b/R/ctrlSpec.R
@@ -0,0 +1,125 @@
+#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)
+  
+}
\ No newline at end of file