Существует ли эквивалент выживания :: Survised, но с вектором разреза, который варьируется в зависимости от субъекта? - PullRequest
0 голосов
/ 21 октября 2019

Я хочу разделить продольный набор данных, где интервалы кодируются календарными датами (численно) по возрастным группам, а также календарным периодом, но я не нашел простого способа сделать это.

Если я использую SurvSplit, тоработает нормально, но только со статическим вектором точек среза - поэтому в этом примере будет работать для календарного времени (например, на основе числового эквивалента 31 декабря 2010, 2011, 2012, 2013 ...), но не для возраста, так как мои интервалызакодированы по дате.

Если я перекодирую свои данные для интервалов, закодированных по возрасту в днях, это будет работать для точек отсечения, основанных на возрасте (например, 35, 40, 45, 50 лет ...), но неperiod.

Я решил эту проблему путем «перебазирования» набора данных о выживании из возраста в календарное время и обратно, но я воображаю, что есть какой-то изобретательный способ сделать это без переписывания SurvSplit, чтобы принять векторобрезает ту же длину, что и входной набор данных?

Пример следует.

library(survival)
library(dplyr)
library(asaur)    # for example dataset

ORIGIN <- "1970-01-01"

chan <- ChanningHouse

chan$sage <- round(chan$entry * 30.5,0)  # start age (days)
chan$xage <- round(chan$exit * 30.5,0)   # end age (days) 

# simulate an enrolment date - any day from 2010-2019
set.seed(1234)
chan$sdate <- as.Date("2010-01-01", origin = ORIGIN) + floor(runif(dim(chan)[1], min = 0, max = 365 * 10 - 1))
chan$xdate <- chan$sdate + (chan$xage - chan$sage)
chan$dob <- chan$sdate - chan$sage

# Split by age - easy in this format if we use the age as the entry / exit

age.brks <- c(65,70,75,80,85,90,95,999)
age.labs <- paste0("(", age.brks[-length(age.brks)],",", age.brks[-1], "]")
age.brks <- age.brks*365.25

chan.a <- survSplit(chan, 
                    cut=age.brks,          # age breaks in days
                    event="cens",          # outcome var - will only be set for the final event
                    end="xage",            # this var will be updated for each episode
                    start="sage",          # this will be updated - for age-based dataset (left-trunc) needs to match actual start var
                    id="id", 
                    episode="agegrp")      # where to store the codes for the created groups

# but we'd really like to use date as the entry / exit, how will that work?

period.brks <- c(2010:2019,2050)
period.labs <- paste0("(", period.brks[-length(period.brks)],",", period.brks[-1], "]")
period.brks <- as.numeric(as.Date(paste0(period.brks, "-12-31"), origin = ORIGIN)) # end of respective year
chan$sdate <- as.numeric(chan$sdate)
chan$xdate <- as.numeric(chan$xdate)
chan$edate <- chan$sdate                      # create a new var to preserve original enrolment date across episodes

chan.p <- survSplit(chan, 
                    cut=period.brks,          # period breaks at end date
                    event="cens",             # outcome var - will only be set for the final event
                    end="xdate",              # this var will be updated for each episode
                    start="sdate",            # this will be updated - for age-based dataset (left-trunc) needs to match actual start var
                    id="id", 
                    episode="period")         # where to store the codes for the created groups

# reformat numeric to age/dates for display

beautify <- function(df) {
  df %>% 
    mutate_at(vars(ends_with("date"), starts_with("ts")), function(d) as.Date(d, origin=ORIGIN)) %>%
    mutate_at(vars(ends_with("age")), function(a) round(a/365.25,1)) %>%
    mutate_at(vars(matches("agegrp")), function(a) factor(a, levels=seq_along(age.labs)+1, labels=age.labs)) %>%
    mutate_at(vars(matches("period")), function(p) factor(p, levels=seq_along(period.labs)+1, labels=period.labs))
}

# looks right...

beautify(chan[1,])
beautify(chan.p[chan.p$id==1,])

# Split by age when data are encoded by date - not possible using survSplit because it requires a static list 
# of breaks. One way to do this with survSplit is to re-encode the time intervals in terms of age, then do
# the split (then re-convert to dates, if desired)

# swap from date-based to age-based encoding of follow-up

chan.p$eage <- chan.p$sage

# function to change basis of survival dataset person-time from date to age or vice versa
rebase <- function(df, oldbasis, oldstart, oldend, newbasis, newstart, newend) {
  df[, newstart] <- df[, newbasis] + df[, oldstart] - df[, oldbasis]
  df[, newend] <- df[, newstart] + df[, oldend] - df[, oldstart]
  df
}

chan.p <- rebase(chan.p, "edate", "sdate", "xdate", "eage", "sage", "xage")

chan.b <- survSplit(chan.p, 
                    cut=age.brks,            # period breaks at end date
                    event="cens",            # outcome var - will only be set for the final event
                    end="xage",              # this var will be updated for each episode
                    start="sage",            # this will be updated - for age-based dataset (left-trunc) needs to match actual start var
                    episode="agegrp")        # where to store the codes for the created groups

# now convert back to date-based follow-up time

chan.b <- rebase(chan.b, "eage", "sage", "xage", "edate", "sdate", "xdate")

# compare before and after...

beautify(chan[1,])
beautify(chan.b[chan.b$id==1,])

Я нашел другой способ сделать это с помощью tmerge, но он более громоздкий, чем был hрешив, что есть более простой способ сделать это с SurvSplit.

...