####################################################
## PROJECT: LOSS OF A CHILD AND PARENTAL MORTALITY##
####################################################

## Created by Donghao Lu, 12/12/2018, donghao.lu@ki.se

library(survival)
library(Epi)
library(plyr)
library(epitools)
library(fmsb)
setwd ("C:/Donghao/output")
options(stringsAsFactors = F)

# load data
datsib <- read.table("../data/baseClean.txt",header=T)



##
## TABLE 1 - DESCRIPTIVE CHARACTERISTICS OF PARENTS W/ AND W/O LOSS
##


#regroup birth cohorts
datsib$byearCat2 <- datsib$byearCat
levels(datsib$byearCat2 )<-  c('1800-1880','1800-1880','1800-1880','1800-1880','1800-1880','1800-1880','1800-1880',
                               '1800-1880','1881-1930','1881-1930','1881-1930','1881-1930','1881-1930','1931-1996',
                               '1931-1996','1931-1996','1931-1996','1931-1996','1931-1996')
datsib$byearCat2 <- factor(datsib$byearCat2)

#regroup number of children
datsib$totChildCat <- cut(datsib$totChildCnt, c(0,1,4,9,31))
levels(datsib$totChildCat) <- c('1','2-4','5-9','10+')

#recode covars
datsib$ageCat <- cut(datsib$matchAge,c(13,30,50,75,120))
datsib$dage[datsib$dead==1] <- datsib$dyear[datsib$dead==1] - datsib$byear[datsib$dead==1]
datsib$dageCat <- cut(datsib$dage,c(13,30,50,75,120))
datsib$dur <- datsib$t1 - datsib$t0
datsib$kage <- ifelse(datsib$firstChildAgeAtDeath==-1,NA,datsib$firstChildAgeAtDeath)
datsib$kageCat <- cut(datsib$firstChildAgeAtDeath,c(0,1,6,18,120),include.lowest = T)


##overall

#total number
N <- t(table(datsib$exposure))
P <- t(table(datsib$exposure))
tab <- cbind(N,P,"N")
table1 <- tab

#number of children
N<- t(tapply(datsib$totChildCnt, datsib$exposure,sum))
P<- t(tapply(datsib$totChildCnt, datsib$exposure,sum))
tab <- cbind(N,P,"knum_total")
table1 <- rbind(table1, tab)


#parental sex
N <- table(datsib$sex,datsib$exposure)
P <- prop.table(N,2)
tab <- cbind(N,P,paste("psex",rownames(N),sep=""))
table1 <- rbind(table1, tab)

#number of children category
N <- table(datsib$totChildCat,datsib$exposure)
P <- prop.table(N,2)
tab <- cbind(N,P,paste("knum",rownames(N),sep=""))
table1 <- rbind(table1, tab)

#age at loss - category
N <- table(datsib$ageCat,datsib$exposure)
P <- prop.table(N,2)
tab <- cbind(N,P,paste("ageatmatch",rownames(N),sep=""))
table1 <- rbind(table1, tab)

#parental age at death - category
N <- table(datsib$dageCat,datsib$exposure,useNA="ifany")
P <- prop.table(N,2)
tab <- cbind(N,P,paste("pageatdeath",rownames(N),sep=""))
table1 <- rbind(table1, tab)

#kid age at death - category
N <- table(datsib$kageCat,datsib$exposure,useNA="ifany")
P <- prop.table(N,2)
tab <- cbind(N,P,paste("kageatdeath",rownames(N),sep=""))
table1 <- rbind(table1, tab)

#age at child birth
N <- t(tapply(datsib$firstChildBYear-datsib$byear, datsib$exposure,mean))
P <- t(tapply(datsib$firstChildBYear-datsib$byear, datsib$exposure,sd))
tab <- cbind(N,P,"agefirstchildbirth")
table1 <- rbind(table1, tab)

#mean and SD of number of children
N <- t(tapply(datsib$totChildCnt, datsib$exposure,mean))
P <- t(tapply(datsib$totChildCnt, datsib$exposure,sd))
tab <- cbind(N,P,"knum_mean")
table1 <- rbind(table1, tab)

#age at loss/match
N <- t(tapply(datsib$matchAge, datsib$exposure,mean))
P <- t(tapply(datsib$matchAge, datsib$exposure,sd))
tab <- cbind(N,P,"ageatmatch")
table1 <- rbind(table1, tab)

#parental age at death
N <- t(tapply(datsib$dage, datsib$exposure,mean, na.rm=T))
P <- t(tapply(datsib$dage, datsib$exposure,sd, na.rm=T))
tab <- cbind(N,P,"pageatdeath")
table1 <- rbind(table1, tab)

#kid age at death
N <- t(tapply(datsib$kage, datsib$exposure,mean, na.rm=T))
P <- t(tapply(datsib$kage, datsib$exposure,sd, na.rm=T))
tab <- cbind(N,P,"kageatdeath")
table1 <- rbind(table1, tab)

#follow-up
N <- t(tapply(datsib$dur, datsib$exposure,mean))
P <- t(tapply(datsib$dur, datsib$exposure,sd))
tab <- cbind(N,P,"dur")
table1 <- rbind(table1, tab)

#combine
table1 <- cbind(table1, rep("1800-1996",nrow(table1)))
Table1 <- table1
rm(table1,tab)
gc()

#output
Table1 <- cbind(Table1,rep("sibling",nrow(Table1)))
colnames(Table1) <- c("N0","N1","P0","P1","strata","bc","design")
Table1 <- Table1[,c("design","bc","strata","N0","P0","N1","P1")]
write.table(Table1, "C:/Donghao/output/table1.csv", sep="/", col.names = F, row.names = F, quote = F, append=T) 




##
## FIGURE 1 - PARENTAL MORTALITY RISK BY BIRTH COHORTS
##


#regroup birth cohorts
datsib$byearCat2 <- datsib$byearCat
levels(datsib$byearCat2 )<- c('1800-1820','1800-1820','1821-1840','1821-1840','1841-1860','1841-1860','1861-1880',
                              '1861-1880','1881-1900','1881-1900','1901-1930','1901-1930','1901-1930','1931-1996',
                              '1931-1996','1931-1996','1931-1996','1931-1996','1931-1996')
datsib$byearCat2 <- factor(datsib$byearCat2)


#both parental sex
ins <- levels(datsib$byearCat2)
nr  <- length(ins)
for(i in 1:nr) {
  #fit model
  subdat <- subset(datsib, byearCat2==ins[i])
  surv.hlutur <- Surv(subdat$age0,subdat$age1, subdat$dead==1)
  
  #extract results
  #N, PYs, crude IRs
  N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
  PY <- aggregate(subdat$age1-subdat$age0, by=list(exposed=subdat$exposure), FUN=sum)
  tab<- merge(N,PY,by.x="exposed",by.y="exposed")
  names(tab) <- c("exposed","N","PY")
  tab$IR <- tab$N / tab$PY * 1000
  
  #conditional on siblings
  mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear, data=subdat)
  tab$HR <- c(1.0, exp(coef(mod)[1]))
  tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
  tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
  tab$bc <- paste("bc",ins[i],sep="")
  tab$design<- "sibling"
  tab$sex <- paste("sex",0,sep="")
  
  #output
  write.table(tab, "figure1.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
  rm(subdat,mod,surv.hlutur,N,PY,tab)
  gc()
  
  #print process
  print(paste(ins[i]," has done", sep=""))
}


#by parental sex
ins <- levels(datsib$byearCat2)
nr  <- length(ins)
for(j in 1:nr) {
  
  #loop ever parental sex
  for(k in 1:2) {
    
    #subset data
    subdat <- subset(datsib, byearCat2==ins[j])
    #available index person
    sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & sex==k)$PNcase)
    subdat <- subset(subdat, sel)
    #remove index person without controls
    sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
    subdat <- subdat[sel,]
    rm(sel)
    
    #extract results
    #N, PYs, crude IRs
    N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
    PY <- aggregate(subdat$age1-subdat$age0, by=list(exposed=subdat$exposure), FUN=sum)
    tab<- merge(N,PY,by.x="exposed",by.y="exposed")
    names(tab) <- c("exposed","N","PY")
    tab$IR <- tab$N / tab$PY * 1000
    
    #conditional on siblings
    surv.hlutur <- Surv(subdat$age0,subdat$age1, subdat$dead==1)
    mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear, data=subdat)
    tab$HR <- c(1.0, exp(coef(mod)[1]))
    tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
    tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
    tab$bc <- paste("bc",ins[j],sep="")
    tab$design<- "sibling"
    tab$sex <- paste("sex",k,sep="")
    
    #output
    write.table(tab, "figure1.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
    rm(subdat,mod,surv.hlutur,N,PY,tab)
    gc()
    
  }

  #print process
  print(paste(ins[j], " has done", sep=""))
}





##
## FIGURE 2 - MORTALITY RISK AT AGE<50 AND 50+
##


#regroup birth cohorts 
datsib$byearCat2 <- datsib$byearCat
levels(datsib$byearCat2 )<-  c('1800-1820','1800-1820','1821-1840','1821-1840','1841-1860','1841-1860','1861-1880',
                               '1861-1880','1881-1900','1881-1900','1901-1930','1901-1930','1901-1930','1931-1996',
                               '1931-1996','1931-1996','1931-1996','1931-1996','1931-1996')
datsib$byearCat2 <- factor(datsib$byearCat2)


#split by attained age
datSplit <- datsib[c("PNcase","PN","exposure","age0","age1","dead","byear","sex","byearCat2","matchAge")]
datSplit <- Lexis(entry=list(per=age0), exit=list(per=age1), exit.status=dead, data=datSplit)
datSplit <- splitLexis(datSplit, breaks=c(13,50,120), time.scale="per")
datSplit$t0 <- datSplit$per - datSplit$matchAge
datSplit$t1 <- datSplit$t0 + datSplit$lex.dur


##By birth cohorts
#both parental sex
input <- levels(datSplit$byearCat2)
nr2  <- length(input)
for(j in 1:nr2) {
  
  #loop attained age groups
  ins <- c(13,50)
  out <- c(50,120)
  nr  <- length(ins)
  for(i in 1:nr) {
    
    #subset data
    subdat <- subset(datSplit, byearCat2==input[j])
    #available index person
    sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & per>=ins[i] & per<out[i])$PNcase)
    subdat <- subset(subdat, sel & per>=ins[i] & per<out[i])
    #remove index person without controls
    sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
    subdat <- subdat[sel,]
    rm(sel)
    
    #extract results
    #N, PYs, crude IRs
    N  <- aggregate(subdat$lex.Xst, by=list(exposed=subdat$exposure), FUN=sum)
    PY <- aggregate(subdat$lex.dur, by=list(exposed=subdat$exposure), FUN=sum)
    tab<- merge(N,PY,by.x="exposed",by.y="exposed")
    names(tab) <- c("exposed","N","PY")
    tab$IR <- tab$N / tab$PY * 1000
    
    #conditional
    surv.hlutur <- Surv(subdat$age0,subdat$age1, subdat$lex.Xst==1)
    mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear, data=subdat)
    tab$HR <- c(1.0, exp(coef(mod)[1]))
    tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
    tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
    tab$strata<- paste("age",ins[i]+1,"-",out[i], sep="")
    tab$bc <- paste("bc",input[j],sep="")
    tab$sex <- paste("sex",0,sep="")
    tab$design<- "sibling"
    
    #output
    write.table(tab, "figure2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
    rm(subdat,mod,surv.hlutur,N,PY,tab)
    gc()
    
    #print process
    print(paste(ins[i]," has done", sep=""))
    
  }
  
  #print process
  print(paste(input[j], " has done", sep=""))
}



#by parental sex
input <- levels(datSplit$byearCat2)
nr2  <- length(input)
for(j in 1:nr2) {
  
  #loop attained age groups
  ins <- c(13,50)
  out <- c(50,120)
  nr  <- length(ins)
  for(i in 1:nr) {
    
    #loop ever parental sex
    for(k in 1:2) {
      
      #subset data
      subdat <- subset(datSplit, byearCat2==input[j])
      #available index person
      sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & per>=ins[i] & per<out[i] & sex==k)$PNcase)
      subdat <- subset(subdat, sel & per>=ins[i] & per<out[i])
      #remove index person without controls
      sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
      subdat <- subdat[sel,]
      rm(sel)
      
      #extract results
      #N, PYs, crude IRs
      N  <- aggregate(subdat$lex.Xst, by=list(exposed=subdat$exposure), FUN=sum)
      PY <- aggregate(subdat$lex.dur, by=list(exposed=subdat$exposure), FUN=sum)
      tab<- merge(N,PY,by.x="exposed",by.y="exposed")
      names(tab) <- c("exposed","N","PY")
      tab$IR <- tab$N / tab$PY * 1000
      
      #conditional
      surv.hlutur <- Surv(subdat$age0,subdat$age1, subdat$lex.Xst==1)
      mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear, data=subdat)
      tab$HR <- c(1.0, exp(coef(mod)[1]))
      tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
      tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
      tab$strata<- paste("age",ins[i]+1,"-",out[i], sep="")
      tab$bc <- paste("bc",input[j],sep="")
      tab$sex <- paste("sex",k,sep="")
      tab$design<- "sibling"
      
      #output
      write.table(tab, "figure2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
      rm(subdat,mod,surv.hlutur,N,PY,tab)
      gc()
      
      #print process
      print(paste(ins[i]," sex-",k," has done", sep=""))
    }
    
    
  }
  
  #print process
  print(paste(input[j], " has done", sep=""))
}





##
## TABLE 2 - PREMATURE MORTALITY STRATIFIED BY TIME SINCE LOSS AND DEMOGRAPHIC CHARACTERISTICS
##

#regroup birth cohorts (40-yrs)
datsib$byearCat2 <- datsib$byearCat
levels(datsib$byearCat2 )<-  c('1800-1880','1800-1880','1800-1880','1800-1880','1800-1880','1800-1880','1800-1880',
                               '1800-1880','1881-1930','1881-1930','1881-1930','1881-1930','1881-1930','1931-1996',
                               '1931-1996','1931-1996','1931-1996','1931-1996','1931-1996')
datsib$byearCat2 <- factor(datsib$byearCat2)

#regroup number of children
datsib$totChildCat2 <- datsib$totChildCat
levels(datsib$totChildCat2) <- c('1','2-4','5+','5+','5+')
datsib$totChildCat2<- factor(datsib$totChildCat2)

#group number of children lost
datsib$childDeathCat <- cut(datsib$childDeathCnt,c(0,1,2,20))
levels(datsib$childDeathCat) <- c('1','2','3+')


#censor at age 50
datnew <- datsib
datnew$age1 <- datnew$exit - datnew$byear
datnew$age1 <- pmin(datnew$age1, 50.99)
datnew <- subset(datnew, age0<=age1)
#141346 obs
datnew$dead <- ifelse(datnew$age1==(datnew$dyear-datnew$byear),1,0)
datnew$age1 <- ifelse(datnew$age1==datnew$age0, datnew$age1+0.5, datnew$age1)
datnew$t1 <- datnew$age1 - datnew$matchAge


##stratified by total number of children
#both parental sex
#loop over number of children  
ins <- c('1','2-4','5+')
nr  <- length(ins)
for(i in 1:nr) {
  
  #subset data
  subdat <- datnew
  #available index person
  sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & totChildCat2==ins[i])$PNcase)
  subdat <- subset(subdat, sel)
  #remove index person without any sibling
  sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
  subdat <- subdat[sel,]
  rm(sel)
  
  #extract results
  #N, PYs, crude IRs
  N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
  PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
  tab<- merge(N,PY,by.x="exposed",by.y="exposed")
  names(tab) <- c("exposed","N","PY")
  tab$IR <- tab$N / tab$PY * 1000
  
  #conditional
  surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
  mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
  tab$HR <- c(1.0, exp(coef(mod)[1]))
  tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
  tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
  tab$strata <- paste("knum",ins[i], sep="")
  tab$bc <- paste("bc","1800-1996",sep="")
  tab$design <- "sibling"
  tab$sex <- paste("sex",0,sep="")
  
  #output
  write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
  rm(subdat,mod,surv.hlutur,N,PY,tab)
  gc()
  
}


#loop parental sex
for(k in 1:2) {
  
  #loop over number of children  
  ins <- c('1','2-4','5+')
  nr  <- length(ins)
  for(i in 1:nr) {
    
    #subset data
    subdat <- datnew
    #available index person
    sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & totChildCat2==ins[i] & sex==k)$PNcase)
    subdat <- subset(subdat, sel)
    #remove index person without any sibling
    sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
    subdat <- subdat[sel,]
    rm(sel)
    
    #extract results
    #N, PYs, crude IRs
    N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
    PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
    tab<- merge(N,PY,by.x="exposed",by.y="exposed")
    names(tab) <- c("exposed","N","PY")
    tab$IR <- tab$N / tab$PY * 1000
    
    #conditional
    surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
    mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
    tab$HR <- c(1.0, exp(coef(mod)[1]))
    tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
    tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
    tab$strata <- paste("knum",ins[i], sep="")
    tab$bc <- paste("bc","1800-1996",sep="")
    tab$design <- "sibling"
    tab$sex <- paste("sex",k,sep="")
    
    #output
    write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
    rm(subdat,mod,surv.hlutur,N,PY,tab)
    gc()
    
  }
}




##stratified by children's gender
#both parental sex
#loop over kid sex
ins <- c(1,2)
nr  <- length(ins)
for(i in 1:nr) {
  
  #subset data
  subdat <- datnew
  #available index person
  sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & firstChildDeathSex==ins[i])$PNcase)
  subdat <- subset(subdat, sel)
  #remove index person without any sibling
  sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
  subdat <- subdat[sel,]
  rm(sel)
  
  #extract results
  #N, PYs, crude IRs
  N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
  PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
  tab<- merge(N,PY,by.x="exposed",by.y="exposed")
  names(tab) <- c("exposed","N","PY")
  tab$IR <- tab$N / tab$PY * 1000
  
  #conditional
  surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
  mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
  tab$HR <- c(1.0, exp(coef(mod)[1]))
  tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
  tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
  tab$strata <- paste("ksex",ins[i], sep="")
  tab$bc <- paste("bc","1800-1996",sep="")
  tab$design <- "sibling"
  tab$sex <- paste("sex",0,sep="")
  
  #output
  write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
  rm(subdat,mod,surv.hlutur,N,PY,tab)
  gc()
}


#loop arental sex
for(k in 1:2) {
  
  #loop over kid sex
  ins <- c(1,2)
  nr  <- length(ins)
  for(i in 1:nr) {
    
    #subset data
    subdat <- datnew
    #available index person
    sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & firstChildDeathSex==ins[i] & sex==k)$PNcase)
    subdat <- subset(subdat, sel)
    #remove index person without any sibling
    sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
    subdat <- subdat[sel,]
    rm(sel)
    
    #extract results
    #N, PYs, crude IRs
    N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
    PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
    tab<- merge(N,PY,by.x="exposed",by.y="exposed")
    names(tab) <- c("exposed","N","PY")
    tab$IR <- tab$N / tab$PY * 1000
    
    #conditional
    surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
    mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
    tab$HR <- c(1.0, exp(coef(mod)[1]))
    tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
    tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
    tab$strata <- paste("ksex",ins[i], sep="")
    tab$bc <- paste("bc","1800-1996",sep="")
    tab$design <- "sibling"
    tab$sex <- paste("sex",k,sep="")
    
    #output
    write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
    rm(subdat,mod,surv.hlutur,N,PY,tab)
    gc()
  }
}


##age at loss/reference date
#both parental sex
#loop over age groups
ins <- c(13,31,41,51)
nr  <- length(ins)-1
for(i in 1:nr) {
  
  #subset data
  subdat <- datnew
  #available index person
  sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & matchAge>=ins[i] & matchAge<ins[i+1])$PNcase)
  subdat <- subset(subdat, sel)
  #remove index person without any sibling
  sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
  subdat <- subdat[sel,]
  rm(sel)
  
  
  #extract results
  #N, PYs, crude IRs
  N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
  PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
  tab<- merge(N,PY,by.x="exposed",by.y="exposed")
  names(tab) <- c("exposed","N","PY")
  tab$IR <- tab$N / tab$PY * 1000
  
  #conditional
  surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
  mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
  tab$HR <- c(1.0, exp(coef(mod)[1]))
  tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
  tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
  tab$strata <- paste("lage",ins[i],"-",ins[i+1]-1, sep="")
  tab$bc <- paste("bc","1800-1996",sep="")
  tab$design <- "sibling"
  tab$sex <- paste("sex",0,sep="")
  
  #output
  write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
  rm(subdat,mod,surv.hlutur,N,PY,tab)
  gc()
  
}

#loop parental sex
for(k in 1:2) {
  
  #loop over age groups
  ins <- c(13,31,41,51)
  nr  <- length(ins)-1
  for(i in 1:nr) {
    
    #subset data
    subdat <- datnew
    #available index person
    sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & matchAge>=ins[i] & matchAge<ins[i+1] & sex==k)$PNcase)
    subdat <- subset(subdat, sel)
    #remove index person without any sibling
    sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
    subdat <- subdat[sel,]
    rm(sel)
    
    
    #extract results
    #N, PYs, crude IRs
    N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
    PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
    tab<- merge(N,PY,by.x="exposed",by.y="exposed")
    names(tab) <- c("exposed","N","PY")
    tab$IR <- tab$N / tab$PY * 1000
    
    #conditional
    surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
    mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
    tab$HR <- c(1.0, exp(coef(mod)[1]))
    tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
    tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
    tab$strata <- paste("lage",ins[i],"-",ins[i+1]-1, sep="")
    tab$bc <- paste("bc","1800-1996",sep="")
    tab$design <- "sibling"
    tab$sex <- paste("sex",k,sep="")
    
    #output
    write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
    rm(subdat,mod,surv.hlutur,N,PY,tab)
    gc()
    
  }
  
}



##childrens' age at loss/reference date
#both parental sex
#loop over age groups
ins <- c(0,1,6,18,37)
nr  <- length(ins)-1
for(i in 1:nr) {
  
  #subset data
  subdat <- datnew
  #available index person
  sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & firstChildAgeAtDeath>=ins[i] & firstChildAgeAtDeath<ins[i+1])$PNcase)
  subdat <- subset(subdat, sel)
  #remove index person without any sibling
  sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
  subdat <- subdat[sel,]
  rm(sel)
  
  #extract results
  #N, PYs, crude IRs
  N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
  PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
  tab<- merge(N,PY,by.x="exposed",by.y="exposed")
  names(tab) <- c("exposed","N","PY")
  tab$IR <- tab$N / tab$PY * 1000
  
  #conditional
  surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
  mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
  tab$HR <- c(1.0, exp(coef(mod)[1]))
  tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
  tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
  tab$strata <- paste("kage",ins[i],"-",ins[i+1]-1, sep="")
  tab$bc <- paste("bc","1800-1996",sep="")
  tab$design <- "sibling"
  tab$sex <- paste("sex",0,sep="")
  
  #output
  write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
  rm(subdat,mod,surv.hlutur,N,PY,tab)
  gc()
  
}



#loop parental sex
for(k in 1:2) {
  
  #loop over age groups
  ins <- c(0,1,6,18,37)
  nr  <- length(ins)-1
  for(i in 1:nr) {
    
    #subset data
    subdat <- datnew
    #available index person
    sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & firstChildAgeAtDeath>=ins[i] & firstChildAgeAtDeath<ins[i+1] & sex==k)$PNcase)
    subdat <- subset(subdat, sel)
    #remove index person without any sibling
    sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
    subdat <- subdat[sel,]
    rm(sel)
    
    #extract results
    #N, PYs, crude IRs
    N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
    PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
    tab<- merge(N,PY,by.x="exposed",by.y="exposed")
    names(tab) <- c("exposed","N","PY")
    tab$IR <- tab$N / tab$PY * 1000
    
    #conditional
    surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
    mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
    tab$HR <- c(1.0, exp(coef(mod)[1]))
    tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
    tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
    tab$strata <- paste("kage",ins[i],"-",ins[i+1]-1, sep="")
    tab$bc <- paste("bc","1800-1996",sep="")
    tab$design <- "sibling"
    tab$sex <- paste("sex",k,sep="")
    
    #output
    write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
    rm(subdat,mod,surv.hlutur,N,PY,tab)
    gc()
    
  }
}




## reverse causality for knum=1 by excluding those died within 1 year
#both parental sex

#exclude 1 year of folow-up
subdat <- datnew
subdat$age0 <- subdat$age0+1
subdat$age1 <- subdat$exit - subdat$byear
subdat$age1 <- pmin(subdat$age1, 50.99)
subdat <- subset(subdat, age0<=age1)
#134995 obs
subdat$age1 <- ifelse(subdat$age1==subdat$age0, subdat$age1+0.5, subdat$age1)
subdat$t1 <- subdat$age1 - subdat$matchAge
subdat$t0 <- subdat$age0 - subdat$matchAge

#available index person
sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & totChildCat2=="1")$PNcase)
subdat <- subset(subdat, sel)
#remove index person without any sibling
sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
subdat <- subdat[sel,]
rm(sel)

#extract results
#N, PYs, crude IRs
N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
tab<- merge(N,PY,by.x="exposed",by.y="exposed")
names(tab) <- c("exposed","N","PY")
tab$IR <- tab$N / tab$PY * 1000

#conditional
surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
tab$HR <- c(1.0, exp(coef(mod)[1]))
tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
tab$strata <- paste("knum",1, sep="*")
tab$bc <- paste("bc","1800-1996",sep="")
tab$design <- "sibling"
tab$sex <- paste("sex",0,sep="")

#output
write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
rm(subdat,mod,surv.hlutur,N,PY,tab)
gc()



#loop parental sex
for(k in 1:2) {
  
  #exclude 1 year of folow-up
  subdat <- datnew
  subdat$age0 <- subdat$age0+1
  subdat$age1 <- subdat$exit - subdat$byear
  subdat$age1 <- pmin(subdat$age1, 50.99)
  subdat <- subset(subdat, age0<=age1)
  #134995 obs
  subdat$age1 <- ifelse(subdat$age1==subdat$age0, subdat$age1+0.5, subdat$age1)
  subdat$t1 <- subdat$age1 - subdat$matchAge
  subdat$t0 <- subdat$age0 - subdat$matchAge
  
  #available index person
  sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & totChildCat2=="1" & sex==k)$PNcase)
  subdat <- subset(subdat, sel)
  #remove index person without any sibling
  sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
  subdat <- subdat[sel,]
  rm(sel)
  
  #extract results
  #N, PYs, crude IRs
  N  <- aggregate(subdat$dead, by=list(exposed=subdat$exposure), FUN=sum)
  PY <- aggregate(subdat$t1-subdat$t0, by=list(exposed=subdat$exposure), FUN=sum)
  tab<- merge(N,PY,by.x="exposed",by.y="exposed")
  names(tab) <- c("exposed","N","PY")
  tab$IR <- tab$N / tab$PY * 1000
  
  #conditional
  surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$dead==1)
  mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
  tab$HR <- c(1.0, exp(coef(mod)[1]))
  tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
  tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
  tab$strata <- paste("knum",1, sep="*")
  tab$bc <- paste("bc","1800-1996",sep="")
  tab$design <- "sibling"
  tab$sex <- paste("sex",k,sep="")
  
  #output
  write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
  rm(subdat,mod,surv.hlutur,N,PY,tab)
  gc()
  
}  




## by time since loss
##birth cohorts

#regroup birth cohorts
datsib$byearCat2 <- datsib$byearCat
levels(datsib$byearCat2 )<-  c('1800-1880','1800-1880','1800-1880','1800-1880','1800-1880','1800-1880','1800-1880',
                               '1800-1880','1881-1930','1881-1930','1881-1930','1881-1930','1881-1930','1931-1996',
                               '1931-1996','1931-1996','1931-1996','1931-1996','1931-1996')
datsib$byearCat2 <- factor(datsib$byearCat2)

#censor at age 50
datnew <- datsib
datnew$age1 <- datnew$exit - datnew$byear
datnew$age1 <- pmin(datnew$age1, 50.99)
datnew <- subset(datnew, age0<=age1)
#141346 obs
datnew$dead <- ifelse(datnew$age1==(datnew$dyear-datnew$byear),1,0)
datnew$age1 <- ifelse(datnew$age1==datnew$age0, datnew$age1+0.5, datnew$age1)
datnew$t1 <- datnew$age1 - datnew$matchAge

#split by attained age
datSplit <- datnew[c("PNcase","PN","exposure","t0","t1","dead","byear","sex","byearCat2")]
datSplit <- Lexis(entry=list(per=t0), exit=list(per=t1), exit.status=dead, data=datSplit)
datSplit <- splitLexis(datSplit, breaks=c(0,5,10,20,40), time.scale="per")
datSplit$t0 <- datSplit$per 
datSplit$t1 <- datSplit$t0 + datSplit$lex.dur


#entire cohort
#loop over time since loss  
ins <- c(0,5,10,20,40)
for(i in 1:4) {
  
  #subset data
  subdat <- datSplit
  #available index person
  sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & per>=ins[i] & per<ins[i+1])$PNcase)
  subdat <- subset(subdat, sel & per>=ins[i] & per<ins[i+1])
  #remove index person without any sibling
  sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
  subdat <- subdat[sel,]
  rm(sel)
  
  #extract results
  #N, PYs, crude IRs
  N  <- aggregate(subdat$lex.Xst, by=list(exposed=subdat$exposure), FUN=sum)
  PY <- aggregate(subdat$lex.dur, by=list(exposed=subdat$exposure), FUN=sum)
  tab<- merge(N,PY,by.x="exposed",by.y="exposed")
  names(tab) <- c("exposed","N","PY")
  tab$IR <- tab$N / tab$PY * 1000
  
  #conditional
  surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$lex.Xst==1)
  mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
  tab$HR <- c(1.0, exp(coef(mod)[1]))
  tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
  tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
  tab$strata<- paste("tsl",ins[i],"-",ins[i+1]-1, sep="")
  tab$bc <- paste("bc","1800-1996",sep="")
  tab$design<- "sibling"
  tab$sex <- paste("sex",0,sep="")
  
  #output
  write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
  rm(subdat,mod,surv.hlutur,N,PY,tab)
  gc()
  
  #print process
  print(paste(ins[i]," has done", sep=""))
}


#loop over parental sex
for(k in 1:2) {
  
  #loop over time since loss  
  ins <- c(0,5,10,20,40)
  for(i in 1:4) {
    
    #subset data
    subdat <- datSplit
    #available index person
    sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & per>=ins[i] & per<ins[i+1] & sex==k)$PNcase)
    subdat <- subset(subdat, sel & per>=ins[i] & per<ins[i+1])
    #remove index person without any sibling
    sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
    subdat <- subdat[sel,]
    rm(sel)
    
    #extract results
    #N, PYs, crude IRs
    N  <- aggregate(subdat$lex.Xst, by=list(exposed=subdat$exposure), FUN=sum)
    PY <- aggregate(subdat$lex.dur, by=list(exposed=subdat$exposure), FUN=sum)
    tab<- merge(N,PY,by.x="exposed",by.y="exposed")
    names(tab) <- c("exposed","N","PY")
    tab$IR <- tab$N / tab$PY * 1000
    
    #conditional
    surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$lex.Xst==1)
    mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
    tab$HR <- c(1.0, exp(coef(mod)[1]))
    tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
    tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
    tab$strata<- paste("tsl",ins[i],"-",ins[i+1]-1, sep="")
    tab$bc <- paste("bc","1800-1996",sep="")
    tab$design<- "sibling"
    tab$sex <- paste("sex",k,sep="")
    
    #output
    write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
    rm(subdat,mod,surv.hlutur,N,PY,tab)
    gc()
    
    #print process
    print(paste(ins[i]," has done", sep=""))
  }
  
}



##excluding parents died on the same day of their children
#list to exclude from exposed group
dat2 <- read.table('W:/Donghao/loss_mortality/data/VulnerabilityList_byearGE1800_99999999999days_LLI_pSurvival_all_11_11_2016.txt',header=TRUE)
dat2$exclude <- dat2$daysFromFirstChildDeath==0 
table(dat2$exclude)
#192 obs
exPN <- as.character(dat2$PN[dat2$exclude])

#remove the pairs
sel <- datsib$PNcase %in% exPN
#ex <- datsib[sel,]
#length(unique(ex$PNcase))
#480 obs,136 pairs

datnew <- datsib[!sel,c("PNcase","PN","exposure","age0","exit","dead","byear","dyear","sex","byearCat2","matchAge","t0")]
#173573 obs

#censor at age 50
datnew$age1 <- datnew$exit - datnew$byear
datnew$age1 <- pmin(datnew$age1, 50.99)
datnew <- subset(datnew, age0<=age1)
#141346 obs
datnew$dead <- ifelse(datnew$age1==(datnew$dyear-datnew$byear),1,0)
datnew$age1 <- ifelse(datnew$age1==datnew$age0, datnew$age1+0.5, datnew$age1)
datnew$t1 <- datnew$age1 - datnew$matchAge

#split by attained age
datSplit <- datnew[c("PNcase","PN","exposure","t0","t1","dead","byear","sex","byearCat2")]
datSplit <- Lexis(entry=list(per=t0), exit=list(per=t1), exit.status=dead, data=datSplit)
datSplit <- splitLexis(datSplit, breaks=c(0,5,10,20,40), time.scale="per")
datSplit$t0 <- datSplit$per 
datSplit$t1 <- datSplit$t0 + datSplit$lex.dur

rm(sel, exPN, datnew, dat2)
gc()


#entire cohort
#loop over time since loss  
ins <- c(0,5,10,20,40)
for(i in 1:1) {
  
  #subset data
  subdat <- datSplit
  #available index person
  sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & per>=ins[i] & per<ins[i+1])$PNcase)
  subdat <- subset(subdat, sel & per>=ins[i] & per<ins[i+1])
  #remove index person without any sibling
  sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
  subdat <- subdat[sel,]
  rm(sel)
  
  #extract results
  #N, PYs, crude IRs
  N  <- aggregate(subdat$lex.Xst, by=list(exposed=subdat$exposure), FUN=sum)
  PY <- aggregate(subdat$lex.dur, by=list(exposed=subdat$exposure), FUN=sum)
  tab<- merge(N,PY,by.x="exposed",by.y="exposed")
  names(tab) <- c("exposed","N","PY")
  tab$IR <- tab$N / tab$PY * 1000
  
  #conditional
  surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$lex.Xst==1)
  mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
  tab$HR <- c(1.0, exp(coef(mod)[1]))
  tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
  tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
  tab$strata<- paste("tsl",ins[i],"-",ins[i+1]-1, "*",sep="")
  tab$bc <- paste("bc","1800-1996",sep="")
  tab$design<- "sibling"
  tab$sex <- paste("sex",0,sep="")
  
  #output
  write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
  rm(subdat,mod,surv.hlutur,N,PY,tab)
  gc()
  
  #print process
  print(paste(ins[i]," has done", sep=""))
}



#loop over parental sex
for(k in 1:2) {
  
  #loop over time since loss  
  ins <- c(0,5,10,20,40)
  for(i in 1:1) {
    
    #subset data
    subdat <- datSplit
    #available index person
    sel <- subdat$PNcase %in% unique(subset(subdat,exposure==T & per>=ins[i] & per<ins[i+1] & sex==k)$PNcase)
    subdat <- subset(subdat, sel & per>=ins[i] & per<ins[i+1])
    #remove index person without any sibling
    sel <- subdat$PNcase %in% subset(subdat, exposure==F)$PNcase
    subdat <- subdat[sel,]
    rm(sel)
    
    #extract results
    #N, PYs, crude IRs
    N  <- aggregate(subdat$lex.Xst, by=list(exposed=subdat$exposure), FUN=sum)
    PY <- aggregate(subdat$lex.dur, by=list(exposed=subdat$exposure), FUN=sum)
    tab<- merge(N,PY,by.x="exposed",by.y="exposed")
    names(tab) <- c("exposed","N","PY")
    tab$IR <- tab$N / tab$PY * 1000
    
    #conditional
    surv.hlutur <- Surv(subdat$t0, subdat$t1, subdat$lex.Xst==1)
    mod <- coxph(surv.hlutur ~ exposure +strata(PNcase) + as.factor(sex) + byear , data=subdat)
    tab$HR <- c(1.0, exp(coef(mod)[1]))
    tab$LB <- c(NA, exp(coef(mod)[1]-1.96*sqrt(diag(mod$var))[1]))
    tab$UB <- c(NA, exp(coef(mod)[1]+1.96*sqrt(diag(mod$var))[1]))
    tab$strata<- paste("tsl",ins[i],"-",ins[i+1]-1, "*",sep="")
    tab$bc <- paste("bc","1800-1996",sep="")
    tab$design<- "sibling"
    tab$sex <- paste("sex",k,sep="")
    
    #output
    write.table(tab, "table2.csv", append=T, sep="/", col.names = F, row.names = F, quote = F)
    rm(subdat,mod,surv.hlutur,N,PY,tab)
    gc()
    
    #print process
    print(paste(ins[i]," has done", sep=""))
  }
  
  
}


######################################################
####################### END OF FILE################### 
######################################################