#### main analysis ####
rm(list=ls())
library(BB)
library(Bhat)
library(MASS)
serial_data <- read.csv("kyoto_serial_interval_1.csv", header=T)
offspring_data <- read.csv("kyoto_offspring_1.csv", header=T)

## setting ##
serial_data <- na.omit(serial_data)
t <- serial_data[,1] # serial interval
r <- offspring_data[,1] # offspring
sym <- offspring_data[,2] # symptomatic status(0:asymptomatic, 1:symptomatic)

## discretization ##
dlnormd <- function(x,alpha,beta){
	y=(plnorm(x+1,alpha,beta)-plnorm(x,alpha,beta))
	return(y)
}
dexpd <- function(x,alpha){
	y=(pexp(x+1,alpha)-pexp(x,alpha))
	return(y)
}
dgammad <- function(x,alpha,beta){
	y=(pgamma(x+1,alpha,beta)-pgamma(x,alpha,beta))
	return(y)
}
dweibulld <- function(x,alpha,beta){
	y=(pweibull(x+1,alpha,beta)-pweibull(x,alpha,beta))
	return(y)
}

f <- dlnormd(1:200,1.43,0.66) # incubation period
m <- 6

## estimation of parameters of pdf of infectiousness ##
nlogl <-function(x){
  z=0
  ## parameters for estimation
  alpha1=x[1] # parameters for h (h is the distribution of infectiousness relative to disease-age)
  alpha2=x[2] # parameters for h
  h <- dgammad(1:200,alpha1,alpha2) #the distribution of infectiousness relative to disease-age
  #h <- dweibulld(1:200,alpha1,alpha2)
  
  ## serial interval ##
  for(i in 1:nrow(serial_data)){
    s <- numeric(100)
    for(j in 1:100){
      tau=1
      while(tau<j){
        s[j]=s[j]+h[tau]*f[j-tau]
        tau=tau+1
      }
    }
    s=s/sum(s) # normalization
    z=z-log(s[t[i]+m])
  }
  
  print(z)
  return(z)
}

param <-list(label=c("alpha1","alpha2"),est=c(5.9097840, 0.9811242),low=c(0.01,0.01),upp=c(200,10))
fit <- dfp(param, nlogl)
AIC <- 2*fit$fmin+2*2

## estimation of relative infection (negative-binomial and constant model) ##
nlogl <-function(x){

	z=0
	## parameters for estimation
	R0=x[1]
	v=x[2] # parameter for relative effect of asymptomatic on R0
	beta=x[3]
	#delta=x[4] # the exponential rate of reproduction number
	
	## offspring ##
	for(i in 1:nrow(offspring_data)){
	  if(sym[i]==1){
	    R=R0
	    #R=R0*exp(-(delta*d1[i]))
	  }else 
	  {
	    R=v*R0}
	  #R=v*(R0*exp(-(delta*d1[i])))}
	  
	  z=z-log(dnbinom(r[i],beta,beta/(beta+R)))
	}
	print(z)
	return(z)
}

param <-list(label=c("R", "v", "beta"),est=c(1.6869878, 0.4350158, 0.2521904),low=c(0.01,0.01,0.01),upp=c(20,0.999,10))
fit <- dfp(param, nlogl)
AIC <- 2*fit$fmin+2*3

## estimation of relative infection (negative-binomial and time-dependent model) ##
offspring_data <- na.omit(offspring_data)
d1 <- offspring_data[,4] # transmission day as a calendar date
nlogl <-function(x){

  z=0
  ## parameters for estimation
  R0=x[1]
  v=x[2] # parameter for relative effect of asymptomatic on R0
  beta=x[3]
  delta=x[4] # the exponential rate of reproduction number
  
  ## offspring ##
  for(i in 1:nrow(offspring_data)){
    if(sym[i]==1){
      #R=R0
      R=R0*exp(-(delta*d1[i]))
    }else 
    {
      #R=v*R0}
    R=v*(R0*exp(-(delta*d1[i])))}
    
    z=z-log(dnbinom(r[i],beta,beta/(beta+R)))
  }
  print(z)
  return(z)
}

param <-list(label=c("R", "v", "beta", "delta"),est=c(1.6869878, 0.4350158, 0.2521904, 0.05),low=c(0.01,0.01,0.01,0.01),upp=c(40,0.999,10,0.99))
fit <- dfp(param, nlogl)
AIC <- 2*fit$fmin+2*4

#sensitivity analysis of k on R0 and v
nlogl <-function(x){
  
  z=0
  ## parameters for estimation
  R0=x[1]
  v=x[2] # parameter for relative effect of asymptomatic on R0
  beta= 10
  
  ## offspring ##
  for(i in 1:nrow(offspring_data)){
    if(sym[i]==1){
      R=R0
    }else 
    {
      R=v*R0}
    
    z=z-log(dnbinom(r[i],beta,beta/(beta+R)))
  }
  print(z)
  return(z)
}

param <-list(label=c("R", "v"),est=c(1.6869878, 0.4350158),low=c(0.01,0.01),upp=c(20,0.999))
fit <- dfp(param, nlogl)
AIC <- 2*fit$fmin+2*2

### estimation of proportion of symptomatic cases depending on primary symptomatic status ###
rm(list=ls())
library(Bhat)
offspring_data <- read.csv("kyoto_secondary.csv", header=T)

## setting ##
sym <- offspring_data[,3] # symptomatic status(0:asymptomatic, 1:symptomatic)
rs <- offspring_data[,4] # number of symptomatic secondary cases
ra <- offspring_data[,5] # number of asymptomatic secondary cases

## likelihood function for offspring (negative binomial model) ##
nlogl <-function(x){
  
  z=0
  ## parameters for estimation
  R1=x[1] #reproductive number of secondary cases by primary symptomatic case
  v=0.2 #reduction of secondary cases by primary asymptomatic case
  p=x[2] # proportion of symptomatic cases among secondary cases due to primary symptomatic case
  q=x[3] # proportion of symptomatic cases among secondary cases due to primary asymptomatic case
  k=x[4] # dispersion parameter
  
  ## offspring ##
  for(i in 1:nrow(offspring_data)){
    if(sym[i]==1){
      R0=R1
      sp=p
    }else 
    {
      R0=v*R1
      sp=q
    }
    
    z=z-log(dnbinom(rs[i]+ra[i],k,prob=k/(k+R0)))-log(dbinom(rs[i], rs[i]+ra[i], sp))
  }
  print(z)
  return(z)}

param <-list(label=c("R1", "p", "q", "k"),est=c(1.6869878, 0.2, 0.3, 0.2521904),low=c(0.01,0.01, 0.01,0.01),upp=c(20,0.999,0.999,10))
fit <- dfp(param, nlogl)
AIC <- 2*fit$fmin+2*4


#### supplemental analysis ####
rm(list=ls())
library(BB)
library(Bhat)
library(MASS)
serial_data <- read.csv("kyoto_serial_interval_1.csv", header=T)
offspring_data <- read.csv("kyoto_offspring_1.csv", header=T)

## setting ##
serial_data <- na.omit(serial_data)
offspring_data <- na.omit(offspring_data)
t <- serial_data[,1] # serial interval
k <- serial_data[,2] # isolation day of primary case relative to illness onset
r <- offspring_data[,1] # offspring
sym <- offspring_data[,2] # symptomatic status(0:asymptomatic, 1:symptomatic)
k1 <- offspring_data[,3] # isolation day relative to illness onset
d1 <- offspring_data[,4] # onset of infectiousness as a calendar date
m <-6 # a known disease-age (usually before onset of disease) when infected individual acquires infectiousness.
# the value should be chosen so that (m + the smallest serial interval) will be more than 1; otherwise log will be infinite

## discretization ##
dlnormd <- function(x,alpha,beta){
  y=(plnorm(x+1,alpha,beta)-plnorm(x,alpha,beta))
  return(y)
}
dexpd <- function(x,alpha){
  y=(pexp(x+1,alpha)-pexp(x,alpha))
  return(y)
}
dgammad <- function(x,alpha,beta){
  y=(pgamma(x+1,alpha,beta)-pgamma(x,alpha,beta))
  return(y)
}
dweibulld <- function(x,alpha,beta){
  y=(pweibull(x+1,alpha,beta)-pweibull(x,alpha,beta))
  return(y)
}

# log-normal distribution for incubation period
# from Li et al NEJM 2020
# lognormal mean = 5.2; 95% CI = c(4.1, 7.0)
# logmean = 1.434065
# logsd = 0.6612
f <- dlnormd(1:200,1.43,0.66) 

## likelihood function ##
nlogl <-function(x){
  
  z=0
  ## parameters for estimation
  R0=x[1]
  epsilon=x[2]
  v=x[3] # parameter for relative effect of asymptomatic on R0
  alpha1=x[4] # parameters for h (h is the distribution of infectiousness relative to disease-age)
  alpha2=x[5] # parameters for h
  beta=x[6]
  delta=x[7] # the exponential rate of reproduction number
  h <- dgammad(1:200,alpha1,alpha2) #the distribution of infectiousness relative to disease-age
  #h <- dweibulld(1:200,alpha1,alpha2)
  
  ## serial interval ##
  for(i in 1:nrow(serial_data)){
    ## distribution of g (g is the distribution of infectiousness accounting for isolation)##
    g <- NULL
    if(k[i]==999){
      g=h
    }else{
      for(j in 1:100){
        if(j<(k[i]+m)){
          g[j]=h[j]/(pgamma(k[i]+m,alpha1,alpha2)+(1-epsilon)*(1-pgamma(k[i]+m,alpha1,alpha2)))
        }else{
          g[j]=(1-epsilon)*h[j]/(pgamma(k[i]+m,alpha1,alpha2)+(1-epsilon)*(1-pgamma(k[i]+m,alpha1,alpha2)))
        }
      }
    }
    g=g/sum(g) # normalization
    ## distribution of biased s (s is the serial interval) ##
    s <- numeric(100)
    for(j in 1:100){
      tau=1
      while(tau<j){
        s[j]=s[j]+g[tau]*f[j-tau]
        tau=tau+1
      }
    }
    s=s/sum(s) # normalization
    z=z-log(s[t[i]+m])
  }
  
  ## generation interval##
  l <- numeric(100)
  for (j in 1:100) {
    tau=1
    while (tau<j) {
      l[j]=l[j]+h[j-tau]*f[tau]
      tau=tau+1
    }
  }
  l=l/sum(l) # normalization
  
  
  ## offspring ##
  for(i in 1:nrow(offspring_data)){
    if(k1[i]==999){
      R=R0
      #R=R0*exp(-(delta*d1[i]))
    }else 
    {
      R=R0*(pgamma(k1[i]+m,alpha1,alpha2)+(1-epsilon)*(1-pgamma(k1[i]+m,alpha1,alpha2)))
      #R=R0*exp(-(delta*d1[i]))*(pgamma(k1[i]+m,alpha1,alpha2)+(1-epsilon)*(1-pgamma(k1[i]+m,alpha1,alpha2)))
    } 
    if(sym[i]==0) { # asymptomatic
      R=v*R0*(sum(l[1:k1[i]])+(1-epsilon)*(1-sum(l[1:k1[i]])))}
    #R=v*(R0*exp(-(delta*d1[i])))*(sum(l[1:k1[i]])+(1-epsilon)*(1-sum(l[1:k1[i]])))}
    
    z=z-log(dnbinom(r[i],beta,beta/(beta+R)))
  }
  print(z)
  return(z)
}

## statistical estimation ##
## for negative binomial model
param <-list(label=c("R","epsilon", "v","alpha1","alpha2", "beta"),est=c(1.6869878, 0.78985, 0.4350158, 5.9097840, 0.9811242, 0.2521904),low=c(0.01,0.001,0.01,0.01,0.01,0.01),upp=c(20,0.999,0.999, 10,10,10))
fit <- dfp(param, nlogl)
AIC <- 2*fit$fmin+2*6

## for negative binomial and time-dependent reproductive number model
param <-list(label=c("R","epsilon", "v","alpha1","alpha2", "beta", "delta"),est=c(1.6869878, 0.6478985, 0.4350158, 5.9097840, 0.9811242, 0.2521904, 0.1),low=c(0.01,0.001,0.01,0.01,0.01,0.01,0.01),upp=c(20,0.999,0.999, 100,10,10,0.99))
fit <- dfp(param, nlogl)
AIC <- 2*fit$fmin+2*7