orig.build.df6 <- function(k,orig.tot.compare.cd4, orig.sub.x, orig.pre.d2, l2fu, no.inform.censor, ltk.vec, sustiva, no.ac.cens.vec, no.sus.cens.vec, orig.time.df,save.orig.x,orig.compare.cd4){ orig.tot.compare.cd4 <- orig.tot.compare.cd4[order(orig.tot.compare.cd4$pid),] #------------------------------# # Building data frame # #------------------------------# # First decrementing those who started HAART from u.limit - 1 to # min.3mth when their min.3mth was less than their min.gt3mth CD4 # value. ## Ignore this comment...used to decrement... orig.regimens <- orig.pids <- vector("list", length=dim(orig.tot.compare.cd4)[1]) for(i in 1:length(unique(orig.tot.compare.cd4$pid))){ if(orig.tot.compare.cd4$pid[i] %in% orig.compare.cd4$pid & orig.tot.compare.cd4$reg.diff[i] > 0){ orig.regimens[[i]] <- seq(from=(orig.tot.compare.cd4$reg.high[i]), # deleted reg.high - 1 length.out=(orig.tot.compare.cd4$reg.diff[i]+1), # changed to reg.diff + 1 by=-1) orig.pids[[i]] <- rep(orig.tot.compare.cd4$pid[i], times=length(orig.regimens[[i]])) } else if(orig.tot.compare.cd4$pid[i] %in% orig.compare.cd4$pid & orig.tot.compare.cd4$reg.diff[i] == 0) { orig.regimens[[i]] <- orig.tot.compare.cd4$reg.high[i] # deleted reg.high - 1 orig.pids[[i]] <- rep(orig.tot.compare.cd4$pid[i], times=length(regimens[[i]])) } else { orig.regimens[[i]] <- NA orig.pids[[i]] <- orig.tot.compare.cd4$pid[i] } } # Number censored for failing to follow regimens no.inform.censor <- c(no.inform.censor, length(orig.regimens[is.na(orig.regimens)])) orig.pid.reg.censored <- unlist(orig.pids[which(is.na(orig.regimens))]) orig.sex <- as.vector(unlist(tapply(orig.sub.x$sex,INDEX=orig.sub.x$pid,FUN=head,n=1))) - 1 orig.race <- as.vector(unlist(tapply(orig.sub.x$black,INDEX=orig.sub.x$pid,FUN=head,n=1))) orig.ivdu <- as.vector(unlist(tapply(orig.sub.x$idu,INDEX=orig.sub.x$pid,FUN=head,n=1))) orig.male <- orig.black <- orig.idu <- vector("list", length=dim(orig.tot.compare.cd4)[1]) for(i in 1:length(unique(orig.tot.compare.cd4$pid))){ orig.male[[i]] <- rep(orig.sex[i], times=length(orig.regimens[[i]])) orig.black[[i]] <- rep(orig.race[i], times=length(orig.regimens[[i]])) orig.idu[[i]] <- rep(orig.ivdu[i], times=length(orig.regimens[[i]])) } orig.in.k.months <- ifelse(orig.sub.x$age <= (orig.sub.x$age.less.ulimit + k/12),1,0) orig.max.reg.change <- unlist(tapply(orig.sub.x$reg.changes[orig.in.k.months==1], INDEX=orig.sub.x$pid[orig.in.k.months==1], FUN=max)) orig.max.reg.change2 <- unlist(tapply(orig.sub.x$reg.changes2[orig.in.k.months==1], INDEX=orig.sub.x$pid[orig.in.k.months==1], FUN=max)) orig.max.reg.change.df <- data.frame("pid"=names(orig.max.reg.change), "max.reg.change"=orig.max.reg.change, "max.reg.change2"=orig.max.reg.change2) orig.max.reg.change.df$pid <- as.character(orig.max.reg.change.df$pid) orig.tmp.b <- unique(subset(orig.sub.x,select=c(pid,age.less.ulimit,age_at_death,age.oi, oi.1.class, oi.2.class,oi.3.class, oi.4.class,age.non.ade))) orig.tmp.b <- orig.tmp.b[order(orig.tmp.b$pid,orig.tmp.b$oi.1.class,decreasing=TRUE),] orig.tmp.b <- subset(orig.tmp.b, !duplicated(pid)) orig.tmp <- data.frame(cbind(orig.tmp.b, as.numeric(orig.max.reg.change.df$max.reg.change), as.numeric(orig.max.reg.change.df$max.reg.change2)), row.names=NULL) names(orig.tmp) <- c("pid","baseline.age","age.at.death","age.at.oi", "oi.1.class","oi.2.class","oi.3.class", "oi.4.class","age.non.ade", "max.reg.change","max.reg.change2") orig.non.ade.evt <- data.frame("pid"=orig.sub.x$pid[!is.na(orig.sub.x$non_ade_diagnosis.1) & orig.sub.x$age == orig.sub.x$age.non.ade], "non_ade_diagnosis.1"=orig.sub.x[!is.na(orig.sub.x$non_ade_diagnosis.1)& orig.sub.x$age == orig.sub.x$age.non.ade, "non_ade_diagnosis.1"]) orig.tmp <- merge(orig.tmp, orig.non.ade.evt, all=TRUE) orig.tmp <- orig.tmp[order(orig.tmp$pid),] orig.tmp.id <- unique(orig.tmp$pid) orig.last.cd4 <- NULL for(i in 1:length(orig.tmp.id)){ orig.last.cd4[i] <- max(which(orig.sub.x$pid == orig.tmp.id[i] & !is.na(orig.sub.x$cd4) & round(orig.sub.x$age,5) <= round(orig.sub.x$last.k.age,5))) } orig.pid.cd4 <- orig.sub.x$pid[orig.last.cd4] orig.cd4.cd4 <- orig.sub.x$cd4[orig.last.cd4] orig.tmp.cd4 <- data.frame("pid"=orig.pid.cd4, "last.cd4"=orig.cd4.cd4) orig.tmp <- merge(orig.tmp, orig.tmp.cd4, all=TRUE) orig.junk <- unique(subset(orig.sub.x, select=c(pid,age.less.ulimit))) orig.tmp <- merge(orig.tmp, orig.junk, all=TRUE) orig.tmp <- orig.tmp[order(orig.tmp$pid),] # Have to add type info to df orig.df <- data.frame("pid"=unique(orig.tmp$pid)) orig.oi <- unlist(tapply(orig.time.df$oi, INDEX=orig.time.df$pid, FUN=max)) orig.oi.df <- data.frame("pid"=names(orig.oi), "oi.ind"=as.numeric(orig.oi)) orig.tmp <- merge(orig.tmp, orig.oi.df, all=TRUE) orig.tmp <- orig.tmp[order(orig.tmp$pid),] orig.dth <- unlist(tapply(orig.time.df$dth, INDEX=orig.time.df$pid, FUN=max)) orig.dth.df <- data.frame("pid"=names(orig.dth), "dth.ind"=as.numeric(orig.dth)) orig.tmp <- merge(orig.tmp, orig.dth.df, all=TRUE) orig.tmp <- orig.tmp[order(orig.tmp$pid),] orig.nae <- unlist(tapply(orig.time.df$non.ade, INDEX=orig.time.df$pid, FUN=max)) orig.nae.df <- data.frame("pid"=names(orig.nae), "non.ade.ind"=as.numeric(orig.nae)) orig.tmp <- merge(orig.tmp, orig.nae.df, all=TRUE) orig.tmp <- orig.tmp[order(orig.tmp$pid),] orig.df$type <- ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$non.ade.ind == 0, 0, ifelse(orig.tmp$non.ade.ind == 1 & orig.tmp$oi.ind == 0 & orig.tmp$dth.ind == 0,3, ifelse(orig.tmp$oi.ind == 1 & orig.tmp$dth.ind == 0,1, ifelse(orig.tmp$dth.ind == 1,2,NA)))) # CD4-dependent utility orig.y.cd4 <- ifelse(orig.tmp$dth.ind == 1, 12*(orig.tmp$age.at.death - orig.tmp$age.less.ulimit), ifelse(orig.tmp$oi.ind == 1 & orig.tmp$dth.ind != 1, 30+k, ifelse(orig.tmp$oi.ind == 0 & orig.tmp$dth.ind == 0, 12 + k + 18*(orig.tmp$last.cd4/100), NA))) # CD4-dependent utility incorporating non-ADEs orig.y.cd4.ade <- ifelse(orig.tmp$dth.ind == 1, 12*(orig.tmp$age.at.death - orig.tmp$age.less.ulimit), ifelse(orig.tmp$oi.ind == 1 & orig.tmp$dth.ind != 1, 30+k, ifelse(orig.tmp$non.ade.ind == 1 & orig.tmp$oi.ind == 0 & orig.tmp$dth.ind == 0, 30+k, ifelse(orig.tmp$oi.ind == 0 & orig.tmp$dth.ind == 0 & orig.tmp$non.ade.ind == 0, 12 + k + 18*(orig.tmp$last.cd4/100), NA)))) # CD4-dependent utiliting incorporating non-ADEs and reg.changes orig.y.cd4.ade.regchg <- orig.y.cd4.ade* (0.9)^(as.numeric(orig.tmp$dth.ind !=1)*orig.tmp$max.reg.change) # Death utility orig.y.death <- ifelse(orig.tmp$dth.ind == 1, 0,1) # Death and OI utility orig.y.dthoi <- ifelse(orig.tmp$dth.ind == 1 | orig.tmp$oi.ind == 1, 0, 1) # Death, ADE, nADE utility orig.y.dthoi.nade <- ifelse(orig.tmp$dth.ind == 1 | orig.tmp$oi.ind == 1 | orig.tmp$non.ade.ind == 1,0,1) # QOL utility orig.y.complete <- vector(mode="numeric", length=length(orig.y.cd4)) orig.y.complete[1:length(orig.y.complete)] <- NA orig.y.complete <- ifelse(orig.tmp$dth.ind == 1, 0, orig.y.complete) orig.y.complete <- ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 1 & orig.tmp$oi.1.class %in% c("mycobacterium avium complex", "toxoplasmosis","other"), 0.56, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 1 & orig.tmp$oi.1.class == "pneumocystis carinii pneumonia",0.61, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 1 & orig.tmp$oi.1.class %in% c("cmv","fungal"), 0.65, orig.y.complete))) orig.y.complete <- ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$last.cd4 < 75, 0.78 + 0.0004*orig.tmp$last.cd4, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$last.cd4 >= 75 & orig.tmp$last.cd4 < 150, 0.75 + 0.0008*orig.tmp$last.cd4, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$last.cd4 >= 150 & orig.tmp$last.cd4 < 250, 0.765 + 0.0007*orig.tmp$last.cd4, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$last.cd4 >= 250 & orig.tmp$last.cd4 < 500, 0.93 + 0.00004*orig.tmp$last.cd4, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$last.cd4 >= 500, 0.95, orig.y.complete))))) # QOL utility incorporating non-ADEs orig.y.complete.ade <- vector(mode="numeric", length=length(orig.y.cd4)) orig.y.complete.ade[1:length(orig.y.complete.ade)] <- NA orig.y.complete.ade <- ifelse(orig.tmp$dth.ind == 1, 0, orig.y.complete.ade) orig.y.complete.ade <- ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 1 & orig.tmp$oi.1.class %in% c("mycobacterium avium complex", "toxoplasmosis","other"), 0.56, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 1 & orig.tmp$oi.1.class == "pneumocystis carinii pneumonia",0.61, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 1 & orig.tmp$oi.1.class %in% c("cmv","fungal"), 0.65, orig.y.complete.ade))) orig.y.complete.ade <- ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$non.ade.ind == 1, 0.56, orig.y.complete.ade) orig.y.complete.ade <- ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$non.ade.ind == 0 & orig.tmp$last.cd4 < 75, 0.78 + 0.0004*orig.tmp$last.cd4, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$non.ade.ind == 0 & orig.tmp$last.cd4 >= 75 & orig.tmp$last.cd4 < 150, 0.75 + 0.0008*orig.tmp$last.cd4, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$non.ade.ind == 0 & orig.tmp$last.cd4 >= 150 & orig.tmp$last.cd4 < 250, 0.765 + 0.0007*orig.tmp$last.cd4, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$non.ade.ind == 0 & orig.tmp$last.cd4 >= 250 & orig.tmp$last.cd4 < 500, 0.93 + 0.00004*orig.tmp$last.cd4, ifelse(orig.tmp$dth.ind == 0 & orig.tmp$oi.ind == 0 & orig.tmp$non.ade.ind == 0 & orig.tmp$last.cd4 >= 500, 0.95, orig.y.complete.ade))))) # QOL utility incorporating non-ADEs and reg changes orig.y.complete.ade.regchg <- orig.y.complete.ade* (0.9)^(as.numeric(orig.tmp$dth.ind !=1)*orig.tmp$max.reg.change) orig.df <- cbind(orig.df, orig.y.cd4, orig.y.cd4.ade,orig.y.death,orig.y.dthoi,orig.y.complete,orig.y.complete.ade, orig.y.cd4.ade.regchg,orig.y.complete.ade.regchg,orig.y.dthoi.nade) orig.df.y.cd4 <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.cd4 <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.cd4"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.df.y.cd4.ade <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.cd4.ade <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.cd4.ade"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.df.y.cd4.ade.regchg <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.cd4.ade.regchg <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.cd4.ade.regchg"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.df.y.death <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.death <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.death"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.df.y.dthoi <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.dthoi <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.dthoi"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.df.y.dthoi.nade <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.dthoi.nade <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.dthoi.nade"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.df.y.complete <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.complete <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.complete"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.df.y.complete.ade <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.complete.ade <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.complete.ade"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.df.y.complete.ade.regchg <- vector("list", length=dim(orig.tot.compare.cd4)[1]) orig.df.y.complete.ade.regchg <- apply(orig.df, 1, FUN=function(x){ rep(x["orig.y.complete.ade.regchg"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid == x[1])]]))}) orig.reg.sub <- data.frame("pid"=orig.time.df$pid[!duplicated(orig.time.df$pid)], "baseline.cd4"=orig.time.df$baseline.cd4[!duplicated(orig.time.df$pid)], "baseline.age"=orig.time.df$baseline.age[!duplicated(orig.time.df$pid)], "c1.cd4"=orig.time.df$c1.cd4[!duplicated(orig.time.df$pid)], "age.c1"=orig.time.df$age.c1[!duplicated(orig.time.df$pid)], "c2.cd4"=orig.time.df$c2.cd4[!duplicated(orig.time.df$pid)], "age.c2"=orig.time.df$age.c2[!duplicated(orig.time.df$pid)], "c3.cd4"=orig.time.df$c3.cd4[!duplicated(orig.time.df$pid)], "age.c3"=orig.time.df$age.c3[!duplicated(orig.time.df$pid)], "reg.high"=orig.time.df$reg.high[!duplicated(orig.time.df$pid)], "reg.low"=orig.time.df$reg.low[!duplicated(orig.time.df$pid)], "b"=orig.time.df$min.gt3mth[!duplicated(orig.time.df$pid)], "age.b"=orig.time.df$age.max.cd4[!duplicated(orig.time.df$pid)], "a"=orig.time.df$min.3mth[!duplicated(orig.time.df$pid)], "age.a"=orig.time.df$age.min.cd4[!duplicated(orig.time.df$pid)]) orig.type <- apply(orig.df, 1, FUN=function(x){ rep(x["type"], times=length(orig.regimens[[which(orig.tot.compare.cd4$pid==x[1])]]))}) orig.df <- data.frame(pid=unlist(orig.pids), y.cd4=unlist(orig.df.y.cd4), y.cd4.ade=unlist(orig.df.y.cd4.ade), y.cd4.ade.regchg=unlist(orig.df.y.cd4.ade.regchg), y.death=unlist(orig.df.y.death), y.dthoi=unlist(orig.df.y.dthoi), y.dthoi.nade=unlist(orig.df.y.dthoi.nade), y.complete=unlist(orig.df.y.complete), y.complete.ade=unlist(orig.df.y.complete.ade), y.complete.ade.regchg=unlist(orig.df.y.complete.ade.regchg), x=unlist(orig.regimens), male=unlist(orig.male), black=unlist(orig.black), idu=unlist(orig.idu), type=unlist(orig.type)) orig.df$y.cd4 <- as.numeric(as.character(orig.df$y.cd4)) orig.df$y.cd4.ade <- as.numeric(as.character(orig.df$y.cd4.ade)) orig.df$y.cd4.ade.regchg <- as.numeric(as.character(orig.df$y.cd4.ade.regchg)) orig.df$y.death <- as.numeric(as.character(orig.df$y.death)) orig.df$y.dthoi <- as.numeric(as.character(orig.df$y.dthoi)) orig.df$y.dthoi.nade <- as.numeric(as.character(orig.df$y.dthoi.nade)) orig.df$y.complete <- as.numeric(as.character(orig.df$y.complete)) orig.df$y.complete.ade <- as.numeric(as.character(orig.df$y.complete.ade)) orig.df$y.complete.ade.regchg <- as.numeric(as.character(orig.df$y.complete.ade.regchg)) orig.df <- merge(orig.df, orig.reg.sub, all=TRUE) orig.df <- orig.df[order(orig.df$pid,-orig.df$x),] orig.df$b <- ifelse(orig.df$b == Inf, NA, orig.df$b) orig.df$a <- ifelse(orig.df$a == Inf, NA, orig.df$a) # Now need to figure out what the max time of follow-up for each person # is (ie., were they followed less than K months). If so, then their # y value has to be changed to NA. orig.max.follow <- unlist(tapply(orig.time.df$month, INDEX=as.character(orig.time.df$pid), FUN=max)) orig.pid.lt.k <- names(orig.max.follow)[which(orig.max.follow < k)] orig.df$y.death[orig.df$pid %in% orig.pid.lt.k & orig.df$type %in% c(0,1,3)] <- NA orig.df$y.cd4[orig.df$pid %in% orig.pid.lt.k & orig.df$type == 0] <- NA orig.df$y.cd4.ade[orig.df$pid %in% orig.pid.lt.k & orig.df$type == 0] <- NA orig.df$y.cd4.ade.regchg[orig.df$pid %in% orig.pid.lt.k & orig.df$type == 0] <- NA orig.df$y.dthoi[orig.df$pid %in% orig.pid.lt.k & orig.df$type == 0] <- NA orig.df$y.dthoi.nade[orig.df$pid %in% orig.pid.lt.k & orig.df$type == 0] <- NA orig.df$y.complete[orig.df$pid %in% orig.pid.lt.k & orig.df$type == 0] <- NA orig.df$y.complete.ade[orig.df$pid %in% orig.pid.lt.k & orig.df$type == 0] <- NA orig.df$y.complete.ade.regchg[orig.df$pid %in% orig.pid.lt.k & orig.df$type == 0] <- NA # Those with missing X should have missing Y orig.df$y.cd4 <- ifelse(is.na(orig.df$x), NA, orig.df$y.cd4) orig.df$y.cd4.ade <- ifelse(is.na(orig.df$x), NA, orig.df$y.cd4.ade) orig.df$y.cd4.ade.regchg <- ifelse(is.na(orig.df$x), NA, orig.df$y.cd4.ade.regchg) orig.df$y.death <- ifelse(is.na(orig.df$x), NA, orig.df$y.death) orig.df$y.dthoi <- ifelse(is.na(orig.df$x), NA, orig.df$y.dthoi) orig.df$y.dthoi.nade <- ifelse(is.na(orig.df$x), NA, orig.df$y.dthoi.nade) orig.df$y.complete <- ifelse(is.na(orig.df$x), NA, orig.df$y.complete) orig.df$y.complete.ade <- ifelse(is.na(orig.df$x), NA, orig.df$y.complete.ade) orig.df$y.complete.ade.regchg <- ifelse(is.na(orig.df$x), NA, orig.df$y.complete.ade.regchg) ## HERE # Per Barcelona, adding timevar to df # First considering those with missing B values... orig.df.no.b <- subset(orig.df, is.na(b)) orig.timevar <- lapply(split(orig.df.no.b, orig.df.no.b$pid), FUN=function(y){ z <- c(unique(y$baseline.cd4), unique(y$c1.cd4),unique(y$c2.cd4), unique(y$c3.cd4), unique(y$a)) z <- z[!is.na(z)] z.age <- c(unique(y$baseline.age), unique(y$age.c1), unique(y$age.c2), unique(y$age.c3), unique(y$age.a)) z.age <- z.age[!is.na(z.age)] z.time <- 12*(z.age - unique(y$baseline.age)) timevar <- ifelse(y$x >= max(z), z.time[1], ifelse(y$x >= max(z[-1]) & length(z[-1]) > 0,z.time[2], ifelse(y$x >= max(z[-c(1,2)]) & length(z[-c(1,2)]) > 0, z.time[3], ifelse(y$x >= max(z[-c(1:3)]) & length(z[-c(1:3)]) > 0, z.time[4], ifelse(y$x >= max(z[-c(1:4)]) & length(z[-c(1:4)]) > 0, z.time[5],k))))) return(timevar)}) orig.df.no.b$timevar <- unlist(orig.timevar) # df <- merge(df, df.no.b, all=TRUE) # df <- df[order(df$pid, -df$x),] # Then considering those with B values ... orig.df.b <- subset(orig.df, !is.na(b)) orig.timevar <- lapply(split(orig.df.b, orig.df.b$pid), FUN=function(y){ z <- c(unique(y$baseline.cd4), unique(y$b), unique(y$c1.cd4), unique(y$c2.cd4), unique(y$c3.cd4), unique(y$a)) z <- z[!is.na(z)] z.age <- c(unique(y$baseline.age), unique(y$age.b), unique(y$age.c1), unique(y$age.c2), unique(y$age.c3), unique(y$age.a)) z.age <- z.age[!is.na(z.age)] z.time <- 12*(z.age - unique(y$baseline.age)) timevar <- ifelse(y$x > max(z), z.time[1], ifelse(y$x > max(z[-1]) & length(z[-1]) > 0,z.time[2], ifelse(y$x > max(z[-c(1,2)]) & length(z[-c(1,2)]) > 0, z.time[3], ifelse(y$x > max(z[-c(1:3)]) & length(z[-c(1:3)]) > 0, z.time[4], ifelse(y$x > max(z[-c(1:4)]) & length(z[-c(1:4)]) > 0, z.time[5], ifelse(y$x > max(z[-c(1:5)]) & length(z[-c(1:5)]) > 0, z.time[6],k)))))) return(timevar)}) orig.df.b$timevar <- unlist(orig.timevar) orig.mw <- merge(orig.df.no.b,orig.df.b,all=TRUE) orig.mw <- orig.mw[order(orig.mw$pid,-orig.mw$x),] orig.df <- merge(orig.df, orig.mw, all=TRUE) orig.df <- orig.df[order(orig.df$pid, -orig.df$x),] orig.ltk <- length(unique(orig.df$pid[is.na(orig.df$y.cd4) & orig.df$type %nin% c(1,2)])) orig.pid.sus.censored <- unique(orig.time.df$pid[orig.time.df$sus.cens == 1]) orig.ltk <- orig.ltk - length(unique(orig.time.df$pid[orig.time.df$l2fu == 1 & orig.time.df$max.mth < k])) - length(orig.pid.reg.censored) - length(orig.pid.sus.censored) ltk.vec <- c(ltk.vec, orig.ltk) # Number censored for failing to follow regimens no.ac.cens.vec <- c(no.ac.cens.vec, length(orig.pid.reg.censored)) # Number censored for starting a non-EFV based regimen no.sus.cens.vec <- c(no.sus.cens.vec, length(orig.pid.sus.censored)) # Adjusting knots for restricted cubic splines in models if(k == 6){ knots <- 3 } else if(k <= 12){ knots <- 4 } else { knots <- 5 } # Propensity score models for starting treatment orig.ps.mod.1 <- glm(start.trt ~ rcs(month,knots)+black+idu+male+baseline.age+ rcs(sqrt(cd4),3)+cd4.pct+ sqrt(time.to.cd4)+logvl+sqrt(time.to.vl)+ sqrt(time.in.care), family="binomial", subset=lag.trt == 0, data=orig.time.df) orig.p.mod.1 <- exp(predict(orig.ps.mod.1))/(1+exp(predict(orig.ps.mod.1))) # Making sure "B" that has Inf is reset to NA orig.time.df$min.gt3mth <- ifelse(orig.time.df$min.gt3mth == Inf, NA, orig.time.df$min.gt3mth) orig.time.df$min.3mth <- ifelse(orig.time.df$min.3mth == Inf, NA, orig.time.df$min.3mth) orig.time.df$p.mod <- 0 orig.time.df$p.mod[orig.time.df$lag.trt == 0] <- orig.p.mod.1 orig.time.df$w <- 1/(1-orig.time.df$p.mod) # Reshaping p.mod.1 to wide to add to regimen-dependent data frame orig.w.wide <- lapply(split(subset(orig.time.df,select=c(pid,w)),orig.time.df$pid), FUN=function(y){ w.t <- t(y$w) bs <- cbind(data.frame(unique(as.character(y$pid))),w.t) names(bs) <- c("pid",paste("w",0:(ncol(w.t)-1),sep="")) if(dim(bs)[2] < (k+2)){ bs2 <- matrix(rep(NA,times=((k+2)-length(bs))),byrow=FALSE, ncol=((k+2)-length(bs))) colnames(bs2) <- paste("w",(length(bs)-1):k,sep="") bs <- cbind(bs,bs2) } # bs$w0 <- 1 return(bs)}) orig.w.wide2 <- do.call("rbind",orig.w.wide) # Adding to df orig.df <- merge(orig.df, orig.w.wide2,all=TRUE) orig.df <- orig.df[order(orig.df$pid,-orig.df$x),] orig.df$w0[is.na(orig.df$b)] <- 1 # For those with no "B"... orig.bs <- lapply(split(subset(orig.df, pid %in% orig.df.no.b$pid,select=c("pid","timevar",paste("w",0:k,sep=""))), orig.df$pid[orig.df$pid %in% orig.df.no.b$pid]), FUN=function(y){ for(j in 1:k){ y[,(j+3)] <- as.numeric(as.character(y[,(j+3)])) y[,(j+3)] <- ifelse(y[,"timevar"] < j,1,y[,(j+3)]) } return(y) }) orig.bs2 <- do.call("rbind",orig.bs) # And those with "B"... orig.bs <- lapply(split(subset(orig.df, pid %in% orig.df.b$pid, select=c("pid","timevar",paste("w",0:k,sep=""))), orig.df$pid[orig.df$pid %in% orig.df.b$pid]), FUN=function(y){ for(j in 1:k){ y[,(j+3)] <- as.numeric(as.character(y[,(j+3)])) y[,(j+3)] <- ifelse(y[,"timevar"] < j,1,y[,(j+3)]) } return(y) }) orig.bs3 <- do.call("rbind",orig.bs) orig.mw <- merge(orig.bs2,orig.bs3,all=TRUE) orig.df <- upData(orig.df, drop=c(paste("w",0:k,sep=""))) orig.df <- cbind(orig.df,orig.mw[,-1]) orig.w <- apply(subset(orig.df, select=c(paste("w",0:k,sep=""))),1,FUN=prod,na.rm=TRUE) orig.df$w <- orig.w # Changing this to reflect information from Barcelona conference # ps.mod.2 <- glm(start.trt ~ rcs(month,knots)+black+idu+male+baseline.age, # subset=lag.trt == 0, # family="binomial", # data=orig.time.df) # # p.mod.2 <- exp(predict(ps.mod.2))/(1+exp(predict(ps.mod.2))) # w.star is (1-p.mod.2)/(1-p.mod.1) if start.trt == 0. For the first # record where start.trt == 1, w.star is b/a. After that, it is 1. # Will first calculate w.star as d/c for all since only have p.mod.1, etc # for those with a lag.trt of 0. This could include some whose lag.trt == 0 # but their start.trt == 1. # a: p.mod.1 # b: p.mod.2 # c: 1-p.mod.1 # d: 1-p.mod.2 # w.star <- (1-p.mod.2)/(1-p.mod.1) # Per Barcelona...changing how weights computed # int1 = interval 1 = [750,...,CD40+1) # int2 = [CD40,...,B+1) # int3 = [B,...,C1+1) # int4 = [C1,...,C2+1) # int5 = [C2,...,C3+1) # int6 = [C3,...,A+1) # int7 = [A,...,reg.low) # Not every person will have all these intervals. When they don't, just put in a 1 # w.star <- 1/(1-p.mod.1) # orig.time.df.0 <- subset(orig.time.df, lag.trt == 0) # which.0.0 <- which(orig.time.df.0$start.trt == 1 & orig.time.df.0$lag.trt == 0) # # w.star[which.0.0] <- p.mod.2[which.0.0]/p.mod.1[which.0.0] # w.star[which.0.0] <- 1/p.mod.1[which.0.0] # orig.time.df$w.star <- 1 # which.0.0 <- which((orig.time.df$start.trt == 0 | orig.time.df$start.trt == 1) & # orig.time.df$lag.trt == 0) # orig.time.df$w.star[which.0.0] <- w.star # w <- tapply(orig.time.df$w.star, INDEX=orig.time.df$pid, FUN=cumprod) # orig.time.df$w <- unlist(w) # # # Need to add last w for a person to df # max.w <- unlist(tapply(orig.time.df$w, INDEX=orig.time.df$pid, FUN=tail,n=1)) # max.w.df <- data.frame("pid"=names(max.w), # "w"=max.w) # df <- merge(df, max.w.df, all=TRUE) # # Propensity score model for those not being followed k months orig.ps.ltk.1 <- glm(ltk.b ~ black+idu+male+baseline.age+ rcs(sqrt(cd4),3)+cd4.pct+ #sqrt(time.to.cd4)+ logvl+ #sqrt(time.to.vl)+ sqrt(time.in.care), #reg.changes, family="binomial", data=orig.time.df,subset=!duplicated(pid)) orig.p.ltk.1 <- exp(predict(orig.ps.ltk.1))/(1+exp(predict(orig.ps.ltk.1))) orig.vstar.df <- data.frame("pid"=unique(orig.time.df$pid), "v1"= 1/(1-orig.p.ltk.1)) orig.df <- merge(orig.df,orig.vstar.df,all=TRUE) orig.df <- orig.df[order(orig.df$pid, -orig.df$x),] # Need to compute probability of lost to follow-up. Need lost_to_fu # variable to be 1 at last record and not 1 for all records of that subject # To do this, need to find last.age in orig.time.df (current last.age is last age # of true.last.age for those pids in orig.time.df). Will then compare last.age # in orig.time.df and true.last.age to see where/if to put 1. # Propensity score models for loss to follow-up orig.ps.l2fu.1 <- glm(l2fu.b ~ rcs(month,knots)+black+idu+male+baseline.age+ rcs(sqrt(cd4),3)+cd4.pct+ logvl+ sqrt(time.in.care) + time.on.haart, family="binomial", data=orig.time.df) orig.p.l2fu.1 <- exp(predict(orig.ps.l2fu.1))/(1+exp(predict(orig.ps.l2fu.1))) orig.ps.l2fu.2 <- glm(l2fu.b ~ rcs(month,knots)+black+idu+male+baseline.age, family="binomial", data=orig.time.df) orig.p.l2fu.2 <- exp(predict(orig.ps.l2fu.2))/(1+exp(predict(orig.ps.l2fu.2))) # v.star is (1-p.do.2)/(1-p.do.1) if drop.out == 0 and # v.star is p.do.2/p.do.1 if drop.out == 1 orig.v2.star <- (1-orig.p.l2fu.2)/(1-orig.p.l2fu.1) orig.time.df$v2.star <- orig.v2.star orig.time.df <- orig.time.df[order(orig.time.df$pid,orig.time.df$age),] orig.v2 <- tapply(orig.time.df$v2.star, INDEX=orig.time.df$pid, FUN=cumprod) orig.time.df$v2 <- unlist(orig.v2) # Need to add last v for a person to df orig.max.v2 <- unlist(tapply(orig.time.df$v2, INDEX=orig.time.df$pid, FUN=tail,n=1)) orig.max.v2.df <- data.frame("pid"=names(orig.max.v2), "v2"=orig.max.v2) orig.df <- merge(orig.df, orig.max.v2.df, all=TRUE) orig.df <- orig.df[order(orig.df$pid, -orig.df$x),] # Propensity score for being artificially censored (aka informatively # censored) # Based on Barcelona conference, this should be eliminated. Will # just set weight to 1. orig.ps.ac.1 <- glm(art.cens ~ rcs(month,knots)+black+idu+male+baseline.age+ rcs(sqrt(cd4),3)+cd4.pct+ logvl+ sqrt(time.in.care), family="binomial", data=orig.time.df) orig.p.ac.1 <- exp(predict(orig.ps.ac.1))/(1+exp(predict(orig.ps.ac.1))) orig.ps.ac.2 <- glm(art.cens ~ rcs(month,knots)+black+idu+male+baseline.age, family="binomial", data=orig.time.df) orig.p.ac.2 <- exp(predict(orig.ps.ac.2))/(1+exp(predict(orig.ps.ac.2))) # x.star is (1-p.do.2)/(1-p.do.1) orig.z.star <- (1-orig.p.ac.2)/(1-orig.p.ac.1) orig.time.df$z.star <- orig.z.star orig.z <- tapply(orig.time.df$z.star, INDEX=orig.time.df$pid, FUN=cumprod) orig.time.df$z <- unlist(orig.z) # Per Barcelona conference, do not need to calculate this weight so # just setting to 1 orig.time.df$z <- 1 # Need to add last v for a person to df orig.max.z <- unlist(tapply(orig.time.df$z, INDEX=orig.time.df$pid, FUN=tail,n=1)) orig.max.z.df <- data.frame("pid"=names(orig.max.z), "z"=orig.max.z) orig.df <- merge(orig.df, orig.max.z.df, all=TRUE) # If incorporating non-EFV censoring into analysis... if(sustiva){ # Propensity score for being censored for non-Sustiva-based regimen orig.ps.sus.1 <- glm(nonsus.ind ~ rcs(month,knots)+black+idu+male+baseline.age+ rcs(sqrt(cd4),3)+cd4.pct+ sqrt(time.to.cd4)+logvl+sqrt(time.to.vl)+ sqrt(time.in.care), family="binomial", subset=lag.trt == 0, data=orig.time.df) orig.p.sus.1 <- exp(predict(orig.ps.sus.1))/(1+exp(predict(orig.ps.sus.1))) orig.time.df$p.sus <- 0 orig.time.df$p.sus[orig.time.df$lag.trt == 0] <- orig.p.sus.1 orig.time.df$a2 <- 1/(1-orig.time.df$p.sus) # Reshaping p.sus.1 to wide to add to regimen-dependent data frame orig.w.wide <- lapply(split(subset(orig.time.df,select=c(pid,a2)),orig.time.df$pid), FUN=function(y){ w.t <- t(y$a2) bs <- cbind(data.frame(unique(as.character(y$pid))),w.t) names(bs) <- c("pid",paste("a2",0:(ncol(w.t)-1),sep="")) if(dim(bs)[2] < (k+2)){ bs2 <- matrix(rep(NA,times=((k+2)-length(bs))),byrow=FALSE, ncol=((k+2)-length(bs))) colnames(bs2) <- paste("a2",(length(bs)-1):k,sep="") bs <- cbind(bs,bs2) } # bs$a20 <- 1 return(bs)}) orig.w.wide2 <- do.call("rbind",orig.w.wide) # Adding to df orig.df <- merge(orig.df, orig.w.wide2,all=TRUE) orig.df <- orig.df[order(orig.df$pid,-orig.df$x),] # If wi = 1, then a2i, else wi... for(l in 0:k){ assign(paste("a2",l,sep=""), apply(subset(orig.df,select=c(paste("a2",l,sep=""), paste("w",l,sep=""))), 1,FUN=function(y){ ifelse(as.numeric(y[2]) == 1,as.numeric(y[1]),as.numeric(y[2]))})) orig.df <- cbind(orig.df,eval(parse(text=paste("a2",l,sep="")))) names(orig.df)[length(names(orig.df))] <- paste("a2",l,".b",sep="") } orig.a2 <- apply(subset(orig.df, select=c(paste("a2",0:k,".b",sep=""))),1,FUN=prod,na.rm=TRUE) orig.df$a2 <- orig.a2 # ps.sus.1 <- glm(nonsus.ind ~ rcs(month,knots)+black+idu+male+baseline.age+ # rcs(sqrt(cd4),3)+cd4.pct+ # logvl+ # sqrt(time.in.care), # family="binomial", # data=orig.time.df) # # p.sus.1 <- exp(predict(ps.sus.1))/(1+exp(predict(ps.sus.1))) # ps.sus.2 <- glm(sus.cens ~ rcs(month,knots)+black+idu+male+baseline.age, # family="binomial", # data=orig.time.df) # p.sus.2 <- exp(predict(ps.sus.2))/(1+exp(predict(ps.sus.2))) # a.star is (1-p.sus.2)/(1-p.sus.1) # a2.star <- (1-p.sus.2)/(1-p.sus.1) # a2.star <- 1/(1-p.sus.1) # a2.star <- ifelse(w == 1,1/(1-p.sus.1),w) # orig.time.df$a2.star <- a2.star # orig.time.df <- orig.time.df[order(orig.time.df$pid, orig.time.df$age),] # orig.time.df$a2.star[!duplicated(orig.time.df$pid)] <- 1 # a2 <- tapply(orig.time.df$a2.star, INDEX=orig.time.df$pid, FUN=cumprod) # orig.time.df$a2 <- unlist(a2) # # # Need to add last v for a person to df # max.a2 <- unlist(tapply(orig.time.df$a2, INDEX=orig.time.df$pid, FUN=tail,n=1)) # max.a2.df <- data.frame("pid"=names(max.a), # "a2"=max.a2) } else { # max.a2.df <- data.frame("pid"=unique(orig.time.df$pid), # "a2"=1) orig.df$a2 <- 1 } # df <- merge(df, max.a2.df, all=TRUE) # df <- df[order(df$pid, -df$x),] save(orig.df, file=paste("orig.df.",k,".nonsus750ADE.rda",sep="")) orig.df2 <- orig.df orig.y.cd4 <- orig.df2$y.cd4 orig.y.cd4.ade <- orig.df2$y.cd4.ade orig.y.cd4.ade.regchg <- orig.df2$y.cd4.ade.regchg orig.y.death <- orig.df2$y.death orig.y.dthoi <- orig.df2$y.dthoi orig.y.dthoi.nade <- orig.df2$y.dthoi.nade orig.y.complete <- orig.df2$y.complete orig.y.complete.ade <- orig.df2$y.complete.ade orig.y.complete.ade.regchg <- orig.df2$y.complete.ade.regchg orig.x <- orig.df2$x orig.w <- as.vector(orig.df2$w) orig.v1 <- as.vector(orig.df2$v1) orig.v2 <- as.vector(orig.df2$v2) orig.z <- as.vector(orig.df2$z) orig.a2 <- as.vector(orig.df2$a2) orig.mult <- orig.w*orig.v1*orig.v2*orig.z*orig.a2 # mult.1 <- w[!duplicated(df2$pid)& !is.na(df2$y.cd4)]* # v1[!duplicated(df2$pid)& !is.na(df2$y.cd4)]* # v2[!duplicated(df2$pid)& !is.na(df2$y.cd4)]* # z[!duplicated(df2$pid)& !is.na(df2$y.cd4)]* # a2[!duplicated(df2$pid)& !is.na(df2$y.cd4)] # quant.mult <- quantile(mult.1, probs=c(0.05, 0.95)) orig.quant.mult <- quantile(orig.mult, probs=c(0.025, 0.975)) orig.mult <- ifelse(orig.mult < orig.quant.mult[1], orig.quant.mult[1],orig.mult) orig.mult <- ifelse(orig.mult > orig.quant.mult[2], orig.quant.mult[2],orig.mult) orig.ddist <<- datadist(orig.y.cd4,orig.y.cd4.ade,orig.y.cd4.ade.regchg,orig.y.death,orig.y.dthoi, orig.y.complete,orig.y.complete.ade,orig.y.complete.ade.regchg, orig.x,orig.w,orig.v1,orig.v2,orig.z,orig.a2,orig.mult,orig.y.dthoi.nade) options(datadist='orig.ddist') orig.mod.cd4 <- ols(orig.y.cd4 ~ rcs(orig.x,6),weights=orig.mult) orig.mod.cd4.ade <- ols(orig.y.cd4.ade ~ rcs(orig.x,6),weights=orig.mult) orig.mod.cd4.ade.regchg <- ols(orig.y.cd4.ade.regchg ~ rcs(orig.x,6),weights=orig.mult) orig.mod.death <- ols(orig.y.death ~ rcs(orig.x,3),weights=orig.mult) orig.mod.dthoi <- ols(orig.y.dthoi ~ rcs(orig.x,3),weights=orig.mult) orig.mod.dthoi.nade <- ols(orig.y.dthoi.nade ~ rcs(orig.x,3),weights=orig.mult) orig.mod.complete <- ols(orig.y.complete ~ rcs(orig.x,6), weights=orig.mult) orig.mod.complete.ade <- ols(orig.y.complete.ade ~ rcs(orig.x,6), weights=orig.mult) orig.mod.complete.ade.regchg <- ols(orig.y.complete.ade.regchg ~ rcs(orig.x,6), weights=orig.mult) if(k %in% c(24,36,48)){ orig.newmod.dthoi <- ols(orig.y.dthoi ~ rcs(orig.x,4),weights=orig.mult) } else { orig.newmod.dthoi <- NA } # Table for various k's (6,12,24,36) with # people followed for k months, # observed deaths found from type, # oi's, max(X) orig.junk <- unique(subset(orig.df2, select=c(pid,type))) nodthoi <- table(orig.junk$type) # Informatively censored orig.noNA <- length(unique(orig.df2$pid[is.na(orig.df2$y.cd4) & orig.df2$type %nin% c(1,2)])) orig.noNA.death <- length(unique(orig.df2$pid[is.na(orig.df2$y.death)& orig.df2$type %nin% c(1,2)])) # Max CD4 test <- predict(orig.mod.cd4) orig.test.max.cd4 <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.cd4,name='x')$x.xbeta[,"y.cd4"]) # plot(mod.cd4,name='x')$x.xbeta[which(round(plot( # mod.cd4,name='x')$x.xbeta[,"y.cd4"],7) == # round(test,7)),"x"] test <- predict(orig.mod.cd4.ade) orig.test.max.cd4.ade <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.cd4.ade,name='x')$x.xbeta[,"y.cd4.ade"]) # plot(mod.cd4.ade,name='x')$x.xbeta[which(round(plot( # mod.cd4.ade,name='x')$x.xbeta[,"y.cd4.ade"],7) == # round(test,7)),"x"] test <- predict(orig.mod.cd4.ade.regchg) orig.test.max.cd4.ade.regchg <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.cd4.ade.regchg,name='x')$x.xbeta[,"y.cd4.ade.regchg"]) # plot(mod.cd4.ade.regchg,name='x')$x.xbeta[which(round(plot( # mod.cd4.ade.regchg,name='x')$x.xbeta[,"y.cd4.ade.regchg"],7) == # round(test,7)),"x"] test <- predict(orig.mod.death) orig.test.max.death <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.death,name='x')$x.xbeta[,"y.death"]) # plot(mod.death,name='x')$x.xbeta[which(round(plot( # mod.death,name='x')$x.xbeta[,"y.death"],7) == # round(test,7)),"x"] test <- predict(orig.mod.dthoi) orig.test.max.dthoi <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.dthoi,name='x')$x.xbeta[,"y.dthoi"]) # plot(mod.dthoi,name='x')$x.xbeta[which(round(plot( # mod.dthoi,name='x')$x.xbeta[,"y.dthoi"],7) == # round(test,7)),"x"] test <- predict(orig.mod.dthoi.nade) orig.test.max.dthoi.nade <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.dthoi.nade,name='x')$x.xbeta[,"y.dthoi.nade"]) # plot(mod.dthoi.nade,name='x')$x.xbeta[which(round(plot( # mod.dthoi.nade,name='x')$x.xbeta[,"y.dthoi.nade"],7) == # round(test,7)),"x"] test <- predict(orig.mod.complete) orig.test.max.complete <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.complete,name='x')$x.xbeta[,"y.complete"]) # plot(mod.complete,name='x')$x.xbeta[which(round(plot( # mod.complete,name='x')$x.xbeta[,"y.complete"],7) == # round(test,7)),"x"] test <- predict(orig.mod.complete.ade) orig.test.max.complete.ade <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.complete.ade,name='x')$x.xbeta[,"y.complete.ade"]) # plot(mod.complete.ade,name='x')$x.xbeta[which(round(plot( # mod.complete.ade,name='x')$x.xbeta[,"y.complete.ade"],7) == # round(test,7)),"x"] test <- predict(orig.mod.complete.ade.regchg) orig.test.max.complete.ade.regchg <- orig.x[test==max(test,na.rm=TRUE) & !is.na(test)][1] # max(plot(mod.complete.ade.regchg,name='x')$x.xbeta[,"y.complete.ade.regchg"]) # plot(mod.complete.ade.regchg,name='x')$x.xbeta[which(round(plot( # mod.complete.ade.regchg,name='x')$x.xbeta[,"y.complete.ade.regchg"],7) == # round(test,7)),"x"] if(k %in% c(24,36)){ test2 <- predict(orig.newmod.dthoi) orig.test2.max <- orig.x[test2==max(test2,na.rm=TRUE) & !is.na(test2)][1] # max(plot(newmod.dthoi, name="x")$x.xbeta[,"y.dthoi"]) # plot(newmod.dthoi, # name="x")$x.xbeta[which(round(plot(newmod.dthoi, # name="x")$x.xbeta[,"y.dthoi"],5) # == round(test2,5)),"x"] } else { test2 <- NA orig.test2.max <- NA } return(list(orig.df2=orig.df2, orig.noNA=orig.noNA, orig.noNA.death=orig.noNA.death, no.inform.censor=no.inform.censor, ltk.vec=ltk.vec, no.ac.cens.vec=no.ac.cens.vec, no.sus.cens.vec=no.sus.cens.vec, nodthoi=nodthoi, orig.test.max.cd4=round(orig.test.max.cd4), orig.test.max.cd4.ade=round(orig.test.max.cd4.ade), orig.test.max.cd4.ade.regchg=round(orig.test.max.cd4.ade.regchg), orig.test.max.death=round(orig.test.max.death), orig.test.max.dthoi=round(orig.test.max.dthoi), orig.test.max.dthoi.nade=round(orig.test.max.dthoi.nade), orig.test.max.complete=round(orig.test.max.complete), orig.test.max.complete.ade=round(orig.test.max.complete.ade), orig.test.max.complete.ade.regchg=round(orig.test.max.complete.ade.regchg), orig.test2.max=round(orig.test2.max), orig.mod.cd4=orig.mod.cd4, orig.mod.cd4.ade=orig.mod.cd4.ade, orig.mod.cd4.ade.regchg=orig.mod.cd4.ade.regchg, orig.mod.death=orig.mod.death, orig.mod.dthoi=orig.mod.dthoi, orig.mod.dthoi.nade=orig.mod.dthoi.nade, orig.mod.complete=orig.mod.complete, orig.mod.complete.ade=orig.mod.complete.ade, orig.mod.complete.ade.regchg=orig.mod.complete.ade.regchg, orig.newmod.dthoi=orig.newmod.dthoi)) }