Merge branch 'cr'

NEWS.md

@@ -1,3 +1,6 @@
+# pammtools 0.5.92
++ Fixed competing risks data trafo in case of more than 2 causes
+
 # pammtools 0.5.9
 + Fixes issue 154: direction argument to `geom_stepribbon`
 

vignettes/competing-risks.Rmd

@@ -156,79 +156,3 @@ ggplot(ndf, aes(x = tend, y = cif)) +
     alpha = .3) +
   facet_wrap(~cause, labeller = label_both)
 ```
-
-
-# `mgus2` Data
-
-```{r}
-library(survival)
-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"))
-mfit2 <- survfit(Surv(etime, event) ~ sex, data=mgus2)
-plot(mfit2, col=c(1,2,1,2), lty=c(2,2,1,1), mark.time=FALSE, lwd=2, xscale=12,
-  xlab="Years post diagnosis", ylab="Probability in State")
-legend(240, .6, c("death:female", "death:male", "pcm:female", "pcm:male"),
-  col=c(1,2,1,2), lty=c(1,1,2,2), lwd=2, bty='n')
-
-dat <- mgus2
-dat$event <- as.numeric(event) - 1
-dat$time <- etime
-dat$sex <- as.factor(sex)
-ped <- dat %>%
-  as_ped(Surv(time, event)~. - ptime - pstat - futime - death) %>%
-  mutate(cause = as.factor(cause))
-pam <- pamm(ped_status ~ cause + s(tend, by = cause) + sex, data = ped, family = poisson(), offset = offset, discrete = TRUE, method = "fREML", engine = "bam")
-summary(pam)
-ndf <- ped %>%
-  make_newdata(tend = unique(tend), sex = unique(sex), cause = unique(cause)) %>%
-  group_by(cause, sex) %>%
-  add_cif(pam)
-df_cox <- as.data.frame(mfit2$pstate)
-colnames(df_cox) <- c("0", "1", "2")
-df_cox$sex <- as.factor(rep(c("F", "M"), each = nrow(df_cox)/2))
-df_cox$tend <- mfit2$time
-df_cox <- df_cox %>%
-  select(-0) %>%
-  tidyr::pivot_longer(cols = c("1", "2"), names_to="cause", values_to = "cif") %>%
-  mutate(cause = as.factor(cause))
-ggplot(ndf, aes(x = tend, y = cif, col = sex)) +
-  geom_line() +
-  # geom_ribbon(
-  #   aes(ymin = cif_lower, ymax = cif_upper, fill = sex),
-  #   alpha = .3) +
-  facet_wrap(~cause, labeller = label_both) +
-  geom_step(data = df_cox, lty = 2, ) +
-  scale_y_continuous(breaks = seq(0, .8, by = .2))
-
-# multi-state formulation
-ptemp <- with(mgus2, ifelse(ptime==futime & pstat==1, ptime-.1, ptime))
-data3 <- tmerge(mgus2, mgus2, id=id, death=event(futime, death),pcm = event(ptemp, pstat))
-data3 <- tmerge(data3, data3, id, enum=cumtdc(tstart))
-temp <- with(data3, ifelse(death==1, 2, pcm))
-data3$event <- temp
-data3$event2 <- factor(temp, 0:2, labels=c("censor", "pcm", "death"))
-mfit3 <- survfit(Surv(tstart, tstop, event2) ~ sex, data=data3, id=id)
-
-datt <- data3 %>%
-  mutate(from = ifelse(enum == 1, 0, 1)) %>%
-  mutate(
-    to = event,
-    status = 1L * (event != 0),
-    to = ifelse(to == 0, 2, to),
-    transition = paste0(from, "->", to)
-  )
-table(datt$transition)
-
-dat_ped <- add_counterfactual_transitions(datt)
-ped <- as_ped(dat_ped, Surv(tstart, tstop, status)~., transition = "transition",
-  timescale = "calendar")
-pam <- pamm(ped_status ~ transition + s(tend, by = transition) + sex,
-  data = ped, engine = "bam", method = "fREML", discrete = TRUE)
-summary(pam)
-
-ndf <- ped %>%
-  make_newdata(tend = unique(tend), transition = unique(transition), sex = unique(sex)) %>%
-  group_by(transition, sex) %>%
-  add_cif(pam)
-```