我进行了一项队列研究,其中参与者的出生日期和进入和退出研究的日期。
我正在尝试按年龄,性别和年份来计算风险时间(即研究的持续时间)。
例如,如果某位参与者于2005年6月进入研究,年龄为40.8岁(十进制),并且在研究中停留了一年,则其在2005年40岁时贡献0.2岁,在2005年41岁中贡献0.3岁,在2006年贡献0.5岁。 41岁。数据如下:
Qt::StrongFocus
我正在尝试创建一个跟踪持续时间的摘要表,如下所示:
N <- 1000
set.seed(50)
d <- data.frame(
sex = sample(c('m', 'f'), N, replace = T, prob = c(0.7, 0.3)),
dob = sample(seq(as.Date('1960/01/01'), as.Date('1985/01/01'), by="day"), N, replace = T),
study_entry = sample(seq(as.Date('2000/01/01'), as.Date('2010/01/01'), by="day"), N, replace = T)
)
d$study_exit <- d$study_entry + runif(N, 10, 2000)
d$age_entry <- as.numeric(d$study_entry - d$dob) / 365.25
您将如何处理?
答案 0 :(得分:3)
这里是一种使用data.table
和lubridate
的方法。
如果要在研究期间每天存在的查询表上对数据进行重叠联接,这基本上是做什么的事情。
然后,对于每个“匹配项”,使用lubridate::as.period()
根据出生日期计算出参与者当天的实际年龄。
知道了所有这些信息后,进行汇总就很容易了(尽管我不知道您确切想进行什么汇总,因此我只是汇总了该组在这一年中处于危险之中的总天数)。
library(data.table)
library(lubridate)
#set d as data.table
setDT(d)
#over which years spans the study
ymin <- min( lubridate::year( d$study_entry ) )
ymax <- max( lubridate::year( d$study_exit ) )
#create lookup table of all days in study
dt.lookup <- data.table( from = seq( as.Date( paste0( ymin, "-01-01" ) ),
as.Date( paste0( ymax, "-12-31" ) ),
by = "day") )
dt.lookup[, to := from ]
#set keys
setkey( dt.lookup, from, to )
setkey( d, study_entry, study_exit )
#use foverlaps to join both data-sets
dt <- foverlaps( d, dt.lookup )
#now, we can calculate the age based on `from` and dob.
# for other options, see: https://stackoverflow.com/questions/27096485/change-a-column-from-birth-date-to-age-in-r
dt[,
actual_age := floor(
as.numeric(
lubridate::as.period( interval( dob, from ), unit = "years" ),
"years" ) ) ]
#since each row is the duration of 1 day (from-to),
# we can summarise using that knowledge
dt[, .( days_at_risk = .N ),
by = .( year = lubridate::year( from),
sex = sex,
age = actual_age ) ]
输出
# year sex age days_at_risk
# 1: 2000 m 26 1459
# 2: 2000 m 27 848
# 3: 2001 m 27 2678
# 4: 2001 m 28 1752
# 5: 2000 f 24 248
# ---
# 723: 2013 m 44 242
# 724: 2013 m 40 146
# 725: 2014 m 41 82
# 726: 2015 m 42 8
# 727: 2015 m 43 58
答案 1 :(得分:2)
另一个通用框架是使用Epi软件包中的Lexis工具根据日历时间和年龄时间尺度将每个观测值拆分:
library(tidyverse)
# Define time scales
lex <- Epi::Lexis(
entry = list(year = study_entry),
exit = list(year = study_exit, age = study_exit - dob),
data = mutate_if(d, lubridate::is.Date, Epi::cal.yr)
)
# Split observations into follow-up periods
lex_split <- lex %>%
Epi::splitLexis(time.scale = "age", breaks = 15:50) %>%
Epi::splitLexis(time.scale = "year", breaks = 2000 + 0:10)
lex_split %>%
mutate(
age = Epi::timeBand(., "age", type = "left"),
year = Epi::timeBand(., "year", type = "left")
) %>%
group_by(year, sex, age) %>%
summarise(years_at_risk = sum(lex.dur))
#> # A tibble: 558 x 4
#> # Groups: year, sex [22]
#> year sex age years_at_risk
#> <dbl> <fct> <dbl> <dbl>
#> 1 2000 f 15 0.523
#> 2 2000 f 16 0.947
#> 3 2000 f 17 0.152
#> 4 2000 f 18 0.286
#> 5 2000 f 19 1.10
#> 6 2000 f 20 0.521
#> 7 2000 f 21 1.01
#> 8 2000 f 22 0.396
#> 9 2000 f 23 0.344
#> 10 2000 f 24 0.677
#> # ... with 548 more rows
由reprex package(v0.3.0)于2019-10-29创建
答案 2 :(得分:0)
我一直在使用@Wimpel的解决方案,该解决方案非常出色-然后还意识到可以通过直接在研究队列中建立一个工作日表来对其进行稍微简化:
library(data.table)
library(lubridate)
setDT(d)
d[, id := .I] # patient ID
dt <- d[, .(day = seq(from = study_entry, to = study_exit, by = 'day')), id]
dt <- d[, c('id', 'dob', 'sex')][dt, on = 'id']
dt[, actual_age := floor(as.numeric(day - dob) / 365.25)]
dt[, year := lubridate::year(day)]
dt[, .(days_at_risk = .N), c('actual_age', 'sex', 'year')]