224 lines
5.6 KiB
Plaintext
224 lines
5.6 KiB
Plaintext
|
|
||
|
|
R Under development (unstable) (2024-02-06 r85866) -- "Unsuffered Consequences"
|
||
|
|
Copyright (C) 2024 The R Foundation for Statistical Computing
|
||
|
|
Platform: aarch64-unknown-linux-gnu
|
||
|
|
|
||
|
|
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.
|
||
|
|
|
||
|
|
> ## check that the scale option to summary.survfit works
|
||
|
|
> ## Marc Schwartz reported this as a bug in 2.35-3.
|
||
|
|
> library(survival)
|
||
|
|
> fit <- survfit(Surv(futime, fustat) ~rx, data=ovarian)
|
||
|
|
> temp1 <- summary(fit)
|
||
|
|
> temp2 <- summary(fit, scale=365.25)
|
||
|
|
>
|
||
|
|
> all.equal(temp1$time/365.25, temp2$time)
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1$rmean.endtime/365.25, temp2$rmean.endtime)
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1$table[,5:6]/365.25, temp2$table[,5:6])
|
||
|
|
[1] TRUE
|
||
|
|
> temp <- names(fit)
|
||
|
|
> temp <- temp[!temp %in% c("time", "table", "rmean.endtime")]
|
||
|
|
> all.equal(temp1[temp], temp2[temp])
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> # Reprise, using the rmean option
|
||
|
|
> temp1 <- summary(fit, rmean=300)
|
||
|
|
> temp2 <- summary(fit, rmean=300, scale=365.25)
|
||
|
|
> all.equal(temp1$time/365.25, temp2$time)
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1$rmean.endtime/365.25, temp2$rmean.endtime)
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1$table[,5:6]/365.25, temp2$table[,5:6])
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1[temp], temp2[temp])
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> # Repeat using multi-state data. Time is in months for mgus2
|
||
|
|
> etime <- with(mgus2, ifelse(pstat==0, futime, ptime))
|
||
|
|
> event <- with(mgus2, ifelse(pstat==0, 2*death, 1))
|
||
|
|
> event <- factor(event, 0:2, labels=c("censor", "pcm", "death"))
|
||
|
|
> mfit <- survfit(Surv(etime, event) ~ sex, mgus2)
|
||
|
|
> temp1 <- summary(mfit)
|
||
|
|
> temp2 <- summary(mfit, scale=12)
|
||
|
|
>
|
||
|
|
> all.equal(temp1$time/12, temp2$time)
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1$rmean.endtime/12, temp2$rmean.endtime)
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1$table[,3]/12, temp2$table[,3])
|
||
|
|
[1] TRUE
|
||
|
|
> temp <- names(temp1)
|
||
|
|
> temp <- temp[!temp %in% c("time", "table", "rmean.endtime")]
|
||
|
|
> all.equal(temp1[temp], temp2[temp])
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> # Reprise, using the rmean option
|
||
|
|
> temp1 <- summary(mfit, rmean=240)
|
||
|
|
> temp2 <- summary(mfit, rmean=240, scale=12)
|
||
|
|
> all.equal(temp1$time/12, temp2$time)
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1$rmean.endtime/12, temp2$rmean.endtime)
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1$table[,3]/12, temp2$table[,3])
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(temp1[temp], temp2[temp])
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
>
|
||
|
|
> # The n.risk values from summary.survfit were off when there are multiple
|
||
|
|
> # curves (version 2.39-2)
|
||
|
|
> # Verify all components by subscripting
|
||
|
|
> m1 <- mfit[1,]
|
||
|
|
> m2 <- mfit[2,]
|
||
|
|
> s1 <- summary(m1, times=c(0,100, 200, 300))
|
||
|
|
> s2 <- summary(m2, times=c(0,100, 200, 300))
|
||
|
|
> s3 <- summary(mfit, times=c(0,100, 200, 300))
|
||
|
|
>
|
||
|
|
> tfun <- function(what) {
|
||
|
|
+ if (is.matrix(s3[[what]]))
|
||
|
|
+ all.equal(rbind(s1[[what]], s2[[what]]), s3[[what]])
|
||
|
|
+ else all.equal(c(s1[[what]], s2[[what]]), s3[[what]])
|
||
|
|
+ }
|
||
|
|
> tfun('n')
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("time")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.risk")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.event")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.censor")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("pstate")
|
||
|
|
[1] TRUE
|
||
|
|
> all.equal(rbind(s1$p0, s2$p0), s3$p0, check.attributes=FALSE)
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("std.err")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("lower")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("upper")
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> # Check the cumulative sums
|
||
|
|
> temp <- rbind(0, 0,
|
||
|
|
+ colSums(m1$n.event[m1$time <= 100,]),
|
||
|
|
+ colSums(m1$n.event[m1$time <= 200, ]),
|
||
|
|
+ colSums(m1$n.event[m1$time <= 300, ]))
|
||
|
|
> all.equal(s1$n.event, apply(temp,2, diff))
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> temp <- rbind(0, 0,
|
||
|
|
+ colSums(m2$n.event[m2$time <= 100,]),
|
||
|
|
+ colSums(m2$n.event[m2$time <= 200, ]),
|
||
|
|
+ colSums(m2$n.event[m2$time <= 300, ]))
|
||
|
|
> all.equal(s2$n.event, apply(temp,2, diff))
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> temp <- rbind(0, 0,
|
||
|
|
+ colSums(m1$n.censor[m1$time <= 100,]),
|
||
|
|
+ colSums(m1$n.censor[m1$time <= 200,]),
|
||
|
|
+ colSums(m1$n.censor[m1$time <= 300,]))
|
||
|
|
> all.equal(s1$n.censor, apply(temp, 2, diff))
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> # check the same with survfit objects
|
||
|
|
> s1 <- summary(fit[1], times=c(0, 200, 400, 600))
|
||
|
|
> s2 <- summary(fit[2], times=c(0, 200, 400, 600))
|
||
|
|
> s3 <- summary(fit, times=c(0, 200, 400, 600))
|
||
|
|
> tfun('n')
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("time")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.risk")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.event")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.censor")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("surv")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("std.err")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("lower")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("upper")
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> f2 <- fit[2]
|
||
|
|
> temp <- c(0, 0, sum(f2$n.event[f2$time <= 200]),
|
||
|
|
+ sum(f2$n.event[f2$time <= 400]),
|
||
|
|
+ sum(f2$n.event[f2$time <= 600]))
|
||
|
|
> all.equal(s2$n.event, diff(temp))
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> f1 <- fit[1]
|
||
|
|
> temp <- c(0, 0,sum(f1$n.censor[f1$time <= 200]),
|
||
|
|
+ sum(f1$n.censor[f1$time <= 400]),
|
||
|
|
+ sum(f1$n.censor[f1$time <= 600]))
|
||
|
|
> all.equal(s1$n.censor, diff(temp))
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> #
|
||
|
|
> # A check on the censor option
|
||
|
|
> #
|
||
|
|
> s1 <- summary(fit[1])
|
||
|
|
> s2 <- summary(fit[2])
|
||
|
|
> s3 <- summary(fit)
|
||
|
|
> tfun('n')
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("time")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.risk")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.event")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.censor")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("surv")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("std.err")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("lower")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("upper")
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> s1 <- summary(mfit[1,])
|
||
|
|
> s2 <- summary(mfit[2,])
|
||
|
|
> s3 <- summary(mfit)
|
||
|
|
> tfun('n')
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("time")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.risk")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.event")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("n.censor")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("surv")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("std.err")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("lower")
|
||
|
|
[1] TRUE
|
||
|
|
> tfun("upper")
|
||
|
|
[1] TRUE
|
||
|
|
>
|
||
|
|
> proc.time()
|
||
|
|
user system elapsed
|
||
|
|
0.413 0.039 0.450
|