Extract event history data and design matrix including specials from call
Usage
EventHistory.frame(
formula,
data,
unspecialsDesign = TRUE,
specials,
specialsFactor = TRUE,
specialsDesign = FALSE,
stripSpecials = NULL,
stripArguments = NULL,
stripAlias = NULL,
stripUnspecials = NULL,
dropIntercept = TRUE,
check.formula = TRUE,
response = TRUE,
na.action = options()$na.action
)Arguments
- formula
Formula whose left hand side specifies the event history, i.e., either via Surv() or Hist().
- data
Data frame in which the formula is interpreted
- unspecialsDesign
Passed as is to
model.design.- specials
Character vector of special function names. Usually the body of the special functions is function(x)x but e.g.,
stratafrom the survival package does treat the values- specialsFactor
Passed as is to
model.design.- specialsDesign
Passed as is to
model.design- stripSpecials
Passed as
specialstostrip.terms- stripArguments
Passed as
argumentstostrip.terms- stripAlias
Passed as
alias.namestostrip.terms- stripUnspecials
Passed as
unspecialstostrip.terms- dropIntercept
Passed as is to
model.design- check.formula
If TRUE check if formula is a Surv or Hist thing.
- response
If FALSE do not evaluate the left hand side of the formula and to not return the response (event.history).
- na.action
Decide what to do with missing values.
Value
A list which contains
- the event.history (see Hist)
- the design matrix (see model.design)
- one entry for each special (see model.design)
Details
Obtain a list with the data used for event history regression analysis. This function cannot be used directly on the user level but inside a function to prepare data for survival analysis.
Author
Thomas A. Gerds <[email protected]>
Examples
## Here are some data with an event time and no competing risks
## and two covariates X1 and X2.
## Suppose we want to declare that variable X1 is treated differently
## than variable X2. For example, X1 could be a cluster variable, or
## X1 should have a proportional effect on the outcome.
dsurv <- data.frame(time=1:7,
status=c(0,1,1,0,0,0,1),
X2=c(2.24,3.22,9.59,4.4,3.54,6.81,5.05),
X3=c(1,1,1,1,0,0,1),
X4=c(44.69,37.41,68.54,38.85,35.9,27.02,41.84),
X1=factor(c("a","b","a","c","c","a","b"),
levels=c("c","a","b")))
## We pass a formula and the data
e <- EventHistory.frame(Hist(time,status)~prop(X1)+X2+cluster(X3)+X4,
data=dsurv,
specials=c("prop","cluster"),
stripSpecials=c("prop","cluster"))
names(e)
#> [1] "event.history" "design" "prop" "cluster"
## The first element is the event.history which is result of the left hand
## side of the formula:
e$event.history
#>
#> Right-censored response of a survival model
#>
#> No.Observations: 7
#>
#> Pattern:
#> Freq
#> event 3
#> right.censored 4
## same as
with(dsurv,Hist(time,status))
#>
#> Right-censored response of a survival model
#>
#> No.Observations: 7
#>
#> Pattern:
#> Freq
#> event 3
#> right.censored 4
## to see the structure do
colnames(e$event.history)
#> [1] "time" "status"
unclass(e$event.history)
#> time status
#> 1 1 0
#> 2 2 1
#> 3 3 1
#> 4 4 0
#> 5 5 0
#> 6 6 0
#> 7 7 1
#> attr(,"states")
#> [1] "1"
#> attr(,"cens.type")
#> [1] "rightCensored"
#> attr(,"cens.code")
#> [1] "0"
#> attr(,"model")
#> [1] "survival"
#> attr(,"entry.type")
#> [1] ""
## in case of competing risks there will be an additional column called event,
## see help(Hist) for more details
## The other elements are the design, i.e., model.matrix for the non-special covariates
e$design
#> X2 X4
#> 1 2.24 44.69
#> 2 3.22 37.41
#> 3 9.59 68.54
#> 4 4.40 38.85
#> 5 3.54 35.90
#> 6 6.81 27.02
#> 7 5.05 41.84
#> attr(,"levels")
#> named list()
## and a data.frame for the special covariates
e$prop
#> X1
#> 1 a
#> 2 b
#> 3 a
#> 4 c
#> 5 c
#> 6 a
#> 7 b
## The special covariates can be returned as a model.matrix
e2 <- EventHistory.frame(Hist(time,status)~prop(X1)+X2+cluster(X3)+X4,
data=dsurv,
specials=c("prop","cluster"),
stripSpecials=c("prop","cluster"),
specialsDesign=TRUE)
e2$prop
#> X1a X1b
#> 1 1 0
#> 2 0 1
#> 3 1 0
#> 4 0 0
#> 5 0 0
#> 6 1 0
#> 7 0 1
#> attr(,"levels")
#> attr(,"levels")$X1
#> [1] "c" "a" "b"
#>
#> attr(,"arguments")
#> attr(,"arguments")$X1
#> NULL
#>
#> attr(,"arguments.terms")
#> list()
#> attr(,"matrix.terms")
#> attr(,"matrix.terms")$X1
#> [1] "X1c" "X1a" "X1b"
#>
## and the non-special covariates can be returned as a data.frame
e3 <- EventHistory.frame(Hist(time,status)~prop(X1)+X2+cluster(X3)+X4,
data=dsurv,
specials=c("prop","cluster"),
stripSpecials=c("prop","cluster"),
specialsDesign=TRUE,
unspecialsDesign=FALSE)
e3$design
#> X2 X4
#> 1 2.24 44.69
#> 2 3.22 37.41
#> 3 9.59 68.54
#> 4 4.40 38.85
#> 5 3.54 35.90
#> 6 6.81 27.02
#> 7 5.05 41.84
## the general idea is that the function is used to parse the combination of
## formula and data inside another function. Here is an example with
## competing risks
SampleRegression <- function(formula,data=parent.frame()){
thecall <- match.call()
ehf <- EventHistory.frame(formula=formula,
data=data,
stripSpecials=c("prop","cluster","timevar"),
specials=c("prop","timevar","cluster"))
time <- ehf$event.history[,"time"]
status <- ehf$event.history[,"status"]
## event as a factor
if (attr(ehf$event.history,"model")=="competing.risks"){
event <- ehf$event.history[,"event"]
Event <- getEvent(ehf$event.history)
list(response=data.frame(time,status,event,Event),X=ehf[-1])
}
else{ # no competing risks
list(response=data.frame(time,status),X=ehf[-1])
}
}
dsurv$outcome <- c("cause1","0","cause2","cause1","cause2","cause2","0")
SampleRegression(Hist(time,outcome)~prop(X1)+X2+cluster(X3)+X4,dsurv)
#> $response
#> time status event Event
#> 1 1 1 1 cause1
#> 2 2 0 3 unknown
#> 3 3 1 2 cause2
#> 4 4 1 1 cause1
#> 5 5 1 2 cause2
#> 6 6 1 2 cause2
#> 7 7 0 3 unknown
#>
#> $X
#> $X$design
#> X2 X4
#> 1 2.24 44.69
#> 2 3.22 37.41
#> 3 9.59 68.54
#> 4 4.40 38.85
#> 5 3.54 35.90
#> 6 6.81 27.02
#> 7 5.05 41.84
#> attr(,"levels")
#> named list()
#>
#> $X$prop
#> X1
#> 1 a
#> 2 b
#> 3 a
#> 4 c
#> 5 c
#> 6 a
#> 7 b
#>
#> $X$cluster
#> X3
#> 1 1
#> 2 1
#> 3 1
#> 4 1
#> 5 0
#> 6 0
#> 7 1
#>
#>
ehf <- EventHistory.frame(formula=Hist(time,outcome)~prop(X1)+X2+cluster(X3)+X4,
data=dsurv,
stripSpecials=c("prop","cluster","timevar"),
specials=c("prop","timevar","cluster"))
## let's test if the parsing works
form1 <- Hist(time,outcome!="0")~prop(X1)+X2+cluster(X3)+X4
form2 <- Hist(time,outcome)~prop(X1)+cluster(X3)+X4
ff <- list(form1,form2)
lapply(ff,function(f){SampleRegression(f,dsurv)})
#> [[1]]
#> [[1]]$response
#> time status
#> 1 1 1
#> 2 2 0
#> 3 3 1
#> 4 4 1
#> 5 5 1
#> 6 6 1
#> 7 7 0
#>
#> [[1]]$X
#> [[1]]$X$design
#> X2 X4
#> 1 2.24 44.69
#> 2 3.22 37.41
#> 3 9.59 68.54
#> 4 4.40 38.85
#> 5 3.54 35.90
#> 6 6.81 27.02
#> 7 5.05 41.84
#> attr(,"levels")
#> named list()
#>
#> [[1]]$X$prop
#> X1
#> 1 a
#> 2 b
#> 3 a
#> 4 c
#> 5 c
#> 6 a
#> 7 b
#>
#> [[1]]$X$cluster
#> X3
#> 1 1
#> 2 1
#> 3 1
#> 4 1
#> 5 0
#> 6 0
#> 7 1
#>
#>
#>
#> [[2]]
#> [[2]]$response
#> time status event Event
#> 1 1 1 1 cause1
#> 2 2 0 3 unknown
#> 3 3 1 2 cause2
#> 4 4 1 1 cause1
#> 5 5 1 2 cause2
#> 6 6 1 2 cause2
#> 7 7 0 3 unknown
#>
#> [[2]]$X
#> [[2]]$X$design
#> X4
#> 1 44.69
#> 2 37.41
#> 3 68.54
#> 4 38.85
#> 5 35.90
#> 6 27.02
#> 7 41.84
#> attr(,"levels")
#> named list()
#>
#> [[2]]$X$prop
#> X1
#> 1 a
#> 2 b
#> 3 a
#> 4 c
#> 5 c
#> 6 a
#> 7 b
#>
#> [[2]]$X$cluster
#> X3
#> 1 1
#> 2 1
#> 3 1
#> 4 1
#> 5 0
#> 6 0
#> 7 1
#>
#>
#>
## here is what the riskRegression package uses to
## distinguish between covariates with
## time-proportional effects and covariates with
## time-varying effects:
if (FALSE) { # \dontrun{
library(riskRegression)
data(Melanoma)
f <- Hist(time,status)~prop(thick)+strata(sex)+age+prop(ulcer,power=1)+timevar(invasion,test=1)
## here the unspecial terms, i.e., the term age is treated as prop
## also, strata is an alias for timvar
EHF <- prodlim::EventHistory.frame(formula,
Melanoma[1:10],
specials=c("timevar","strata","prop","const","tp"),
stripSpecials=c("timevar","prop"),
stripArguments=list("prop"=list("power"=0),
"timevar"=list("test"=0)),
stripAlias=list("timevar"=c("strata"),
"prop"=c("tp","const")),
stripUnspecials="prop",
specialsDesign=TRUE,
dropIntercept=TRUE)
EHF$prop
EHF$timevar
} # }