[f2e496]: / R / longlagSettings.R

Download this file

119 lines (96 with data), 4.8 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
# 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
}