R/longlagSettings.R

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

# This file contains the class and its constructor which
# determine how the simulation (from data) procedure deals with subjects
# who are censored a long time before the analysis date.

##' Class which determines how the simulation (from data) 
##' procedure deals with subjects
##' who are censored a long time before the analysis date.
##' @slot analysis.date The date the event prediction is performed on. If \code{as.Date(NA)}
##' then the latest censor/event date from the data set will be used as the analysis.date
##' @slot ndays All subjects who were censored more than \code{ndays} before
##' \code{analysis.date} will be changed
##' @slot toWithdraw Logical. If TRUE then the selected subjects will be withdrawn
##' rather than be censored. If FALSE, their censor date is replaced by \code{analysis.date}
##' @slot visitschedule number of days between visits for pfs data. If non-zero and 
##' \code{toWithdraw} is TRUE then the selectedsubjects are censored on the date their
##' latest visit would have been. See vignette for further details
##' @slot text The text to be disaplyed when printing the LongLagSettings 
##' @seealso \code{\link{show,LongLagSettings-method}}
##' @export
setClass("LongLagSettings", 
         slots= list(analysis.date="Date",
                     ndays="numeric",
                     toWithdraw="logical",
                     visitschedule="numeric",
                     text="character")
)



##' @name show
##' @rdname show-methods
##' @aliases show,LongLagSettings-method
##' @export
setMethod("show", signature(object="LongLagSettings"),
  function(object) {
    cat(object@text)
  }
)          


##' Constructor for \code{LongLagSettings} object
##' @param analysis.date The date the event prediction is performed on. If \code{as.Date(NA)}
##' then the latest censor/event date from the data set will be used as the analysis.date
##' @param ndays All subjects who were censored more than \code{ndays} before
##' \code{analysis.date} will be changed
##' @param toWithdraw Logical. If TRUE then the selected subjects will be withdrawn
##' rather than be censored. If FALSE, their censor date is replaced by \code{analysis.date}
##' @param visitschedule number of days between visits for pfs data. If non-zero and 
##' \code{toWithdraw} is TRUE then the selectedsubjects are censored on the date their
##' latest visit would have been. See vignette for further details
##' @return A \code{LongLagSettings} object
##' @export
LongLagSettings <- function(analysis.date=as.Date(NA),ndays,toWithdraw,visitschedule=0){
   
  if(visitschedule < 0 || length(visitschedule) > 1) stop("invalid visit schedule")
  if(ndays < 0 || length(ndays) > 1) stop("invalid ndays")
  
  analysis.date <- FixDates(analysis.date)
  
  
  text <- if(ndays!=0) paste("Subjects with censor date more than",ndays,"days before",analysis.date)
          else text <- paste("Subjects with censor date before",analysis.date)
  
  
  if(toWithdraw){
    text <- paste(text, "are withdrawn.")
  }
  else{
    if(visitschedule==0){
      text <- paste(text," are now censored on ",analysis.date,".",sep="")
    }
    else{
      text <- paste(text," are now censored at the last expected visit date before ",analysis.date,
                    ", with a visit schedule of ",visitschedule," days." ,sep="")
    }
  }
  
  new("LongLagSettings",analysis.date=analysis.date,
      ndays=ndays,toWithdraw=toWithdraw,visitschedule=visitschedule,
      text=text)
  
}


# Function to handle subjects who are
# censored a long time before the analysis date.
# 
# @param indat A data frame e.g. EventData@@subject.data
# @param longlagsettings A \code{longlagsettings} object which controls 
# how subjects who are censored a long time before the analysis date
# are handled. 
# @return The data frame with the \code{longlagsettings} applied 
DealWithReportingLag <- function(indat,longlagsettings){
  
  if(is.null(longlagsettings)){
    return(indat)
  }
  
  
  last.date <- LastDate(indat)
  analysis.date  <- if(is.na(longlagsettings@analysis.date)) as.Date(max(last.date),origin="1970-01-01",na.rm=TRUE) 
                    else longlagsettings@analysis.date 
    
  idx.to.cons <- indat$censored.at.follow.up==0  & indat$withdrawn==0  &  indat$has.event == 0 & 
                (last.date < (analysis.date - longlagsettings@ndays))
    
  if(longlagsettings@toWithdraw){
    indat$withdrawn[idx.to.cons] <- 1 #time of withdrawal is unchanged
    return(indat)
  }
  
  indat$time[idx.to.cons] <- as.numeric(analysis.date - indat$rand.date[idx.to.cons]+1)
  if(longlagsettings@visitschedule != 0){
    indat$time[idx.to.cons] <- 
      1+floor((indat$time[idx.to.cons]-1)/longlagsettings@visitschedule) * longlagsettings@visitschedule    
  }
  indat
  
}