R 生存时间相关协变量是周末:如何分割

R 生存时间相关协变量是周末:如何分割,r,survival-analysis,weekend,R,Survival Analysis,Weekend,我正在研究周末可能对个体生存的影响,因此我试图将我的数据转换为一个时间相关的结构,每个间隔一行。它可能是一个以DschDT(出院日期)作为审查日期的Cox-PH模型。患者要么活着出院(右删失),要么在医院内死亡 数据如下所示,其中DIH是我的审查变量(0,1) 例如,我可能有一个病人在星期三住院,然后在下一个星期四活着出院。在本例中,此患者事件将有三行。一个星期三-星期五,一个星期六-星期日,一个星期一-星期四,包括在内 我已经使用此功能成功地识别了一段时间内的周末 getDuration

我正在研究周末可能对个体生存的影响,因此我试图将我的数据转换为一个时间相关的结构,每个间隔一行。它可能是一个以DschDT(出院日期)作为审查日期的Cox-PH模型。患者要么活着出院(右删失),要么在医院内死亡

数据如下所示,其中DIH是我的审查变量(0,1)

例如,我可能有一个病人在星期三住院,然后在下一个星期四活着出院。在本例中,此患者事件将有三行。一个星期三-星期五,一个星期六-星期日,一个星期一-星期四,包括在内

我已经使用此功能成功地识别了一段时间内的周末

  getDuration <- function(d1, d2,fmt="%Y-%m-%d %H%M") {  
                 myDays <- seq.Date(to   = as.Date(d2, format=fmt), 
                 from = as.Date(d1, format =fmt), 
                 by   = 1)
             myDays[which(is.weekend(myDays))]
             }

  dat<-mapply(getDuration,AdmDT,DschgDT)
这是上面的一个更简单的版本,用于获取时间间隔

用于识别从周六开始到周日结束的周末数的基本功能。d1和d2分别为入院和出院日期/时间

getDuration <- function(d1, d2) {  
  myDays <- seq(d1,d2,by="hour")
  myDays[which(is.weekend(myDays))]
}

getDuration您能再多谈一点“分割时间间隔”的含义吗?输入数据是什么,机制是什么,预期结果是什么?考虑把这个信息添加到你的问题中。如果你在举一个例子时遇到问题,那就有一个适合你的例子。谢谢Roman,我编辑了我的问题来反映这一点。我认为用这个例子提供一个可复制的例子会很好。谢谢Theodor。我已经加了一个例子。我经过一番周折后终于做到了。对于其他任何人来说,都要有可变的时间间隔。”代码'getDuration.dh您能再多谈一点“分割时间间隔”的含义吗?输入数据是什么,机制是什么,预期结果是什么?考虑把这个信息添加到你的问题中。如果你在举一个例子时遇到问题,那就有一个适合你的例子。谢谢Roman,我编辑了我的问题来反映这一点。我认为用这个例子提供一个可复制的例子会很好。谢谢Theodor。我已经加了一个例子。我经过一番周折后终于做到了。对于其他任何人来说,都要有可变的时间间隔。”代码'getDuration.dh
    is.weekend<-function (x) 
    {
     library(chron)
      if (!inherits(x, "dates")) 
    x<-as.chron(as.character(x))
    v <- month.day.year(x)
    h<-hours(x)
    out <- day.of.week(v$month, v$day, v$year) + 1
    # 1 is Sunday and 7 is Saturday, h is hours
  x<-((out == 6 & h >= 18) | out==7|out==1|(out == 2 & h < 6))
  return(x)
}
getDuration <- function(d1, d2) {  
  myDays <- seq(d1,d2,by="hour")
  myDays[which(is.weekend(myDays))]
}
survSeq.dh<-function(a,w){
  aa<-sort(c(a,as.POSIXct(w)))
  aa<-diff(aa)
  units(aa)<-"hours"
  aa<-as.numeric(aa)
  aa<-cumsum(aa)
  #Identify the start and end of weekends
  aa1<-which(diff(aa)!=1)
  aa1<-sort(c(aa1,aa1+1))
  aa1<-c(aa[1],aa[aa1],aa[length(aa)])/24
}
#Make a survSplit object 
#Create a start and stop time
dat$start<-0
dat$time<-as.numeric(dat$separation_datetime-dat$admission_datetime)/(60*24)
Event variable
dat$DIH<-dat$mode_of_separation=="Died in hospital"
survSplit2<-function (data, cut, end, event, start, id = NULL, zero = 0, 
                      episode = NULL) 
{
  cut <- sort(cut)
  ntimes <- length(cut)
  n <- nrow(data)
  newdata <- lapply(data, rep, ntimes + 1)
  endtime <- rep(c(cut, Inf), each = n)
  eventtime <- newdata[[end]]
  if (start %in% names(data)) 
    starttime <- data[[start]]
  else starttime <- rep(zero, length.out = n)
  starttime <- c(starttime, pmax(starttime, rep(cut, each = n)))
  epi <- rep(0:ntimes, each = n)
  status <- ifelse(eventtime <= endtime & eventtime > starttime, 
                   newdata[[event]], 0)
  endtime <- pmin(endtime, eventtime)
  drop <- starttime >= endtime
  newdata <- do.call("data.frame", newdata)
  newdata[, start] <- starttime
  newdata[, end] <- endtime
  newdata[, event] <- status
  if (!is.null(id)) 
    newdata[, id] <- rep(rownames(data), ntimes + 1)
  if (!is.null(episode)) 
    newdata[, episode] <- epi
  newdata <- newdata[!drop, ]
  newdata
}
xx.s<-mapply(getDuration,dat$admission_datetime,dat$separation_datetime))
xx.surv<-mapply(survSeq,dat$admission_datetime,xx.s)
    lengthx<-dim(dat)[1]
    dat.l<-list()
   for(i in 1:lengthx){
      print(i)
    dat.l[[i]]<-survSplit2(dat[i,],cut=xx.surv[[i]],end="time",start="start",event="DIH")
    }
    library(data.table)
    dat.l<-data.frame(rbindlist(dat.l))