R/lag.R

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

#In predict from parameters it is possible to include a 
#lag in the study definition when calculating event times
#the code associated with this lag is contained here.


#' @include ctrlSpec.R
NULL

##' Parameter settings for when including a lagged effect. 
##' 
##' Note the lambda and HR in the \code{Study} class will be used
##' for time > T
##' @slot Lag.T Lagtime (T)
##' @slot ctrlSpec Control median specification for time period [0,T]
##' @slot L.HazardRatio Hazard for time period [0,T]
##' @seealso \code{\link{show,LagEffect-method}}
##' @export
setClass( "LagEffect", 
          slots=c( 
            Lag.T = "numeric",
            ctrlSpec = "CtrlSpec",
            L.HazardRatio = "numeric"
                     
          ), prototype = prototype( 
            Lag.T = 0,
            ctrlSpec = CtrlSpecfromMedian(as.numeric(NA)),
            L.HazardRatio = as.numeric(NA)
          ),
          validity = function(object){
            ans <- ""
            if(object@Lag.T < 0) ans <- paste(ans,"Invalid Lag.T")
            if(!is.na(object@L.HazardRatio) && (object@L.HazardRatio < 0 || object@L.HazardRatio > 1))
              ans <- paste(ans,"Hazard Ratio must be in [0,1]")
            
            if(object@Lag.T!=0){
              if(is.na(object@ctrlSpec@median)){
                ans <- paste(ans,"Invalid LagEffect") 
              } 
            }
            else{
              if(!is.na(object@ctrlSpec@median) || !is.na(object@L.HazardRatio)){
                ans <- paste(ans,"Invalid nullLagEffect") 
              } 
            }
            
            if(ans=="") return(TRUE)
            ans
            
          }
)



##' @name show
##' @rdname show-methods
##' @aliases show,LagEffect-method
##' @export
setMethod("show", signature(object="LagEffect"), 
  function(object) {
    if(isNullLag(object)){
      cat("No Lag\n")
    }
    else{
      cat(paste(object@Lag.T,"months of lag during which\n"))
      cat(paste("control group survival",object@ctrlSpec@text,"months\n"))
      if(!is.na(object@L.HazardRatio)){
        cat(paste("and the hazard ratio is",object@L.HazardRatio,"\n"))
      }
          
    }
  }
)
          

##' LagEffect constructor
##'
##' Note the lambda and HR in the study class will be used
##' for time > T
##' @param Lag.T Lagtime (T)
##' @param L.Ctr.median Control median for time period [0,T]
##' @param L.HazardRatio Hazard for time period [0,T]
##' @return A LagEffect object
##' @export
LagEffect <- function(Lag.T,L.Ctr.median=as.numeric(NA),L.HazardRatio=as.numeric(NA)){
  ctrlSpec <- CtrlSpecfromMedian(L.Ctr.median)
  new("LagEffect",Lag.T=Lag.T,ctrlSpec=ctrlSpec,L.HazardRatio=L.HazardRatio)
}

##' Create a LagEffect object with no lag
##' @return A LagEffect object for which \code{isNullLag()} is TRUE
##' @export
NullLag <- function(){
  NAnumeric <- as.numeric(NA)
  LagEffect(Lag.T=0,L.Ctr.median=NAnumeric,L.HazardRatio=NAnumeric)
}

##' Function to check whether Lag is a null lag
##' 
##' This checks whether the Lag.T slot is 0 
##'    
##' @name isNullLag
##' @docType methods
##' @rdname isNullLag-methods
##' @param Lag A LagEffect object
##' @return TRUE if null lag, FALSE otherwise
##' @export
setGeneric( "isNullLag",
            def=function( Lag )
              standardGeneric( "isNullLag" ) )


##' @rdname isNullLag-methods
##' @aliases isNullLag,LagEffect-method
##' @name isNullLag
##' @export
setMethod( "isNullLag",signature=(Lag="LagEffect"), 
  function( Lag ) {
    Lag@Lag.T==0
})