[f2e496]: / R / singleSimDetails.R

Download this file

65 lines (55 with data), 2.4 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
#Contains the functions for SingleSimDetails class
#part of the predict from data part of the package
#see class definition below
##' Class containing the subject level event data
##' for each simulation
##'
##' A class which contains the recruitment times
##' event times and event types of all subjects and all
##' simulations for a predict from data simulation.
##' This class is created when performing simulation and does not
##' need to be constructed manually
##'
##' @slot event.type A matrix (1 row per subject, 1 column per simulation) of
##' the reason subjects leave trial. 0 is have event, 1 is drop out and 2 is drop out due to follow up
##' @slot event.times A matrix (1 row per subject, 1 column per simulation) of
##' dates (as numeric) subjects leave the trial
##' @slot rec.times A matrix (1 row per subject, 1 column per simulation) of
##' recruitment dates (as numeric).
##' Therefore event.times[i,j] - rec.times[i,j] + 1 is the time on study for
##' subject i in simulation j
##' @export
setClass("SingleSimDetails",
slots=list(
event.type="matrix",
event.times="matrix",
rec.times="matrix"
)
)
# Constructor of SingleSimDetails object
# @param event.type A matrix (1 row per subject, 1 column per simulation) of
# the reason subjects leave trial. 0 is have event, 1 is drop out and 2 is censored due to
# completing follow up period
# @param event.times A matrix (1 row per subject, 1 column per simulation) of
# dates (as numeric) subjects leave the trial
# @param rec.times A matrix (1 row per subject, 1 column per simulation) of
# recruitment dates (as numeric).
# Therefore event.times[i,j] - rec.times[i,j] + 1 is the time on study for
# subject i in simulation j
SingleSimDetails <- function(event.type,event.times,rec.times){
new("SingleSimDetails",event.type=event.type,
event.times=event.times,rec.times=rec.times)
}
##' @name CalculateDaysAtRisk
##' @rdname CalculateDaysAtRisk-methods
##' @aliases CalculateDaysAtRisk,SingleSimDetails-method
##' @export
setMethod("CalculateDaysAtRisk","SingleSimDetails",
function(object,times){
unlist(lapply(times,function(x){
cutoff <- as.numeric(x,origin="1970-01-01")
time.at.risk <- matrix(pmax(0, pmin(cutoff,object@event.times) - object@rec.times + 1),
ncol=ncol(object@event.times))
median(apply(time.at.risk,2,sum))
}))
})