Fans in the background hope that I will introduce the ipwtm function that can perform time-point weighting of survival data. I will share it briefly today. The ipwtm function belongs to the ipw package, we first import the package and data.
library(ipw)
data(haartdat)
head(haartdat,6)
## patient tstart fuptime haartind event sex age cd4.sqrt endtime dropout
## 1 1 -100 0 0 0 1 22 23.83275 2900 0
## 2 1 0 100 0 0 1 22 25.59297 2900 0
## 3 1 100 200 0 0 1 22 23.47339 2900 0
## 4 1 200 300 0 0 1 22 24.16609 2900 0
## 5 1 300 400 0 0 1 22 23.23790 2900 0
## 6 1 400 500 0 0 1 22 24.85961 2900 0
This is an HIV patient survival data, comparing the impact of a HAART treatment on patient survival. The ID of the patient, the start time of tstart follow-up, the end time of fuptime follow-up, whether haartind is treated with HAART, event outcome indicators, and death. sex, age, age at follow-up, cd4.sqrt: the square root of CD4 cells. The ipwtm function is very simple to weight the survival data. In fact, it is a one-sentence code. Exposure is to put your research variables. Fill in the weight numerator here in the numerator. If you fill in 1 here according to Robins’ algorithm, it is an unstable weight, and the denominator is a weight here. Denominator, fill in our covariates. Its calculation of weight is somewhat similar to the ipwpoint function, but it is more complicated, but the general principle is that the variable in the numerator generates a model, the variable in the denominator generates a model, and then predicts the value Of course, there are complex processing in the process. tstart start time, timevar end time, data is your data. The types of type are "first", "cens" and "all". "first" means that the weight is converted from the lowest value.
temp <- ipwtm(
exposure = haartind,
family = "survival",
numerator = ~ sex + age,
denominator = ~ sex + age + cd4.sqrt,
id = patient,
tstart = tstart,
timevar = fuptime,
type = "first",
data = haartdat)
After running the results, the weights are in temp,
we can extract the weights for drawing
ipwplot(weights = temp$ipw.weights, timevar = haartdat$fuptime,
binwidth = 100, ylim = c(-1.5, 1.5), main = "Stabilized inverse probability weights")
This drawing method is actually very simple. X is our follow-up time, and the Y axis is the logarithm of the weight. Set the width of a section and draw a boxplot every other section. If the ype is set to "cens", the inverse probability pruning weight (IPCW) is performed, and I don't know much about it.
temp2 <- ipwtm(
exposure = dropout,
family = "survival",
numerator = ~ sex + age,
denominator = ~ sex + age + cd4.sqrt,
id = patient,
tstart = tstart,
timevar = fuptime,
type = "cens",
data = haartdat)
ipwplot(weights = temp2$ipw.weights, timevar = haartdat$fuptime,
binwidth = 100, ylim = c(-1.5, 1.5), main = "Stabilized inverse probability of censoring weights")
Here is the effect of weighted and unweighted on the result
Weighted
require(survival)
## 载入需要的程辑包：survival
summary(coxph(Surv(tstart, fuptime, event) ~ haartind + cluster(patient),
data = haartdat, weights = temp$ipw.weights*temp2$ipw.weights))
## Call:
## coxph(formula = Surv(tstart, fuptime, event) ~ haartind, data = haartdat,
## weights = temp$ipw.weights * temp2$ipw.weights, cluster = patient)
##
## n= 19175, number of events= 31
##
## coef exp(coef) se(coef) robust se z Pr(>|z|)
## haartind -0.9363 0.3921 0.4299 0.4527 -2.068 0.0386 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## exp(coef) exp(-coef) lower .95 upper .95
## haartind 0.3921 2.551 0.1614 0.9521
##
## Concordance= 0.597 (se = 0.029 )
## Likelihood ratio test= 5.57 on 1 df, p=0.02
## Wald test = 4.28 on 1 df, p=0.04
## Score (logrank) test = 5.07 on 1 df, p=0.02, Robust = 4.83 p=0.03
##
## (Note: the likelihood ratio and score tests assume independence of
## observations within a cluster, the Wald and robust score tests do not).
unweighted
summary(coxph(Surv(tstart, fuptime, event) ~ haartind, data = haartdat))
## Call:
## coxph(formula = Surv(tstart, fuptime, event) ~ haartind, data = haartdat)
##
## n= 19175, number of events= 31
##
## coef exp(coef) se(coef) z Pr(>|z|)
## haartind -0.5862 0.5565 0.4368 -1.342 0.18
##
## exp(coef) exp(-coef) lower .95 upper .95
## haartind 0.5565 1.797 0.2364 1.31
##
## Concordance= 0.569 (se = 0.032 )
## Likelihood ratio test= 1.97 on 1 df, p=0.2
## Wald test = 1.8 on 1 df, p=0.2
## Score (logrank) test = 1.85 on 1 df, p=0.2
The weighted haartind is 0.3921, the unweighted haartind is 0.5565, and the weighted effect becomes smaller.
Plot the weighted survival function curve
f1<-survfit(Surv(tstart, fuptime, event) ~ haartind + cluster(patient),
data = haartdat, weights = temp$ipw.weights*temp2$ipw.weights)
ggsurvplot(f1, data = haartdat)
