115 lines
4.3 KiB
Plaintext
115 lines
4.3 KiB
Plaintext
|
|
||
|
|
R Under development (unstable) (2022-08-09 r82699) -- "Unsuffered Consequences"
|
||
|
|
Copyright (C) 2022 The R Foundation for Statistical Computing
|
||
|
|
Platform: x86_64-pc-linux-gnu (64-bit)
|
||
|
|
|
||
|
|
R is free software and comes with ABSOLUTELY NO WARRANTY.
|
||
|
|
You are welcome to redistribute it under certain conditions.
|
||
|
|
Type 'license()' or 'licence()' for distribution details.
|
||
|
|
|
||
|
|
R is a collaborative project with many contributors.
|
||
|
|
Type 'contributors()' for more information and
|
||
|
|
'citation()' on how to cite R or R packages in publications.
|
||
|
|
|
||
|
|
Type 'demo()' for some demos, 'help()' for on-line help, or
|
||
|
|
'help.start()' for an HTML browser interface to help.
|
||
|
|
Type 'q()' to quit R.
|
||
|
|
|
||
|
|
> # Understanding edge cases
|
||
|
|
> library(survival)
|
||
|
|
>
|
||
|
|
> #
|
||
|
|
> # this is from a user report of a problem with cumevents. When there is
|
||
|
|
> # a row merged in that is a censor, don't mark it as a cumevent.
|
||
|
|
> #
|
||
|
|
> base <- data.frame(
|
||
|
|
+ id = 1:2, tstart = c(0, 0), tstop = c(10, 10), got_flu = c(0, 0),
|
||
|
|
+ has_flu = factor(c("no", "no"), levels = c("no", "yes")))
|
||
|
|
> base <- tmerge(base, base, id = id, got_flu = event(tstop, got_flu))
|
||
|
|
>
|
||
|
|
> # add time-varying covariates
|
||
|
|
> vars <- data.frame(id = c(1, rep(2, 5)), time = c(0, (0:4) * 2), x = rnorm(6))
|
||
|
|
> base <- tmerge(base, vars, id = id, x = tdc(time, x))
|
||
|
|
>
|
||
|
|
> # add cumevents, using a covariate
|
||
|
|
> events <- data.frame(
|
||
|
|
+ id = c(2, 2, 2),
|
||
|
|
+ # notice the zero -- the second row should not add an event
|
||
|
|
+ got_flu = c(1,0,2),
|
||
|
|
+ has_flu = c("yes", "no", "yes"),
|
||
|
|
+ time = c(3, 5, 8))
|
||
|
|
> b2 <- tmerge(base, events, id = id, got_flu = cumevent(time, got_flu),
|
||
|
|
+ has_flu = tdc(time, has_flu))
|
||
|
|
Warning message:
|
||
|
|
In tmerge(base, events, id = id, got_flu = cumevent(time, got_flu), :
|
||
|
|
replacement of variable 'has_flu'
|
||
|
|
>
|
||
|
|
> all.equal(b2$got_flu, c(0,0,1,0,0,0,3,0))
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
>
|
||
|
|
> # Tied times in the merger data set
|
||
|
|
> # for all of them missings are essentially ignored
|
||
|
|
> # last obs wins for tdc and event
|
||
|
|
> tiedat <- data.frame(id=c(1, 1, 1, 2,2,2), time=c(3,4, 4, 3, 5, 5),
|
||
|
|
+ x=c(1, NA,0, 2,3,4))
|
||
|
|
> b3 <- tmerge(base, tiedat, id=id, x1= tdc(time, x), x2=cumtdc(time, x),
|
||
|
|
+ x3= event(time, x), x4 = cumevent(time, x))
|
||
|
|
> all.equal(b3$x1, c(NA, 1, 0, NA, NA, 2,2, 4,4,4))
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(b3$x2, c(NA, 1, 1, NA, NA, 2,2, 9,9,9))
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(b3$x3, c(1,0,0,0,2,0,4,0,0,0))
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(b3$x4, c(1,0,0,0,2,0,9,0,0,0))
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> # Multiple overlapping time windows in the first step.
|
||
|
|
> # Should generate an error message
|
||
|
|
> test <- tryCatch(
|
||
|
|
+ {tmerge(pbcseq[, c("id", "trt", "age", "sex")], pbcseq, id,
|
||
|
|
+ death = event(futime, status==2))},
|
||
|
|
+ error= function(cond) {
|
||
|
|
+ if (grepl("duplicate identifiers", cond))
|
||
|
|
+ cat("successful tmerge error test\n")
|
||
|
|
+ }
|
||
|
|
+ )
|
||
|
|
successful tmerge error test
|
||
|
|
>
|
||
|
|
> # Using a tdc that depends on more than one variable. If they are not
|
||
|
|
> # exactly the same class, tmerge should fail.
|
||
|
|
> # Happens with wide data sets
|
||
|
|
>
|
||
|
|
> tdata <- data.frame(id= 1:3, age=c(40,44,38), dtime=c(700, 600, 500),
|
||
|
|
+ t1 = c(111, 211, 311), x1= as.integer(c(4, 5, 6)),
|
||
|
|
+ t2 = c(120, 240, 400.3), x2=c( 9, 8, 7),
|
||
|
|
+ t3 = c(400, 500, 450), x3=c(12,2, 0))
|
||
|
|
> # This works
|
||
|
|
> wide1 <- tmerge(tdata[,1:2], tdata, id=id, death= event(dtime),
|
||
|
|
+ x = tdc(t1, x1), x= tdc(t2, x2), x= tdc(t3, x3))
|
||
|
|
>
|
||
|
|
> r1 <- data.frame(id=rep(1:3, each=4),
|
||
|
|
+ age= tdata$age[rep(1:3, each=4)],
|
||
|
|
+ tstart=c(0,111, 120, 400, 0, 211, 240, 500, 0, 311,400.3, 450),
|
||
|
|
+ tstop =c(111, 120, 400, 700, 211, 240, 500, 600,
|
||
|
|
+ 311, 400.3, 450, 500),
|
||
|
|
+ death= rep(c(0,0,0,1), 3),
|
||
|
|
+ x= c(NA,4, 9,12, NA, 5, 8, 2, NA, 6,7, 0))
|
||
|
|
> all.equal(r1, wide1, check.attributes=FALSE)
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> tdata$x2[2] <- 'c' # different data type
|
||
|
|
> test <- tryCatch(
|
||
|
|
+ {tmerge(tdata[,1:2], tdata, id=id, death= event(dtime),
|
||
|
|
+ x = tdc(t1, x1), x= tdc(t2, x2), x= tdc(t3, x3))},
|
||
|
|
+ error= function(cond) {
|
||
|
|
+ if (grepl("tdc update does not match prior variable type: x", cond))
|
||
|
|
+ cat("successful tmerge error test\n")
|
||
|
|
+ }
|
||
|
|
+ )
|
||
|
|
successful tmerge error test
|
||
|
|
>
|
||
|
|
> proc.time()
|
||
|
|
user system elapsed
|
||
|
|
1.142 0.080 1.219
|