#To replicate the analysis, place the Prov_pop.RData file in the same folder as the script.
#The RData file may be renamed in submission process; in case rename it Prov_pop.RData.

#sessionInfo output for reproducibility:

#R version 4.0.2 (2020-06-22)
#Platform: x86_64-w64-mingw32/x64 (64-bit)
#Running under: Windows 10 x64 (build 18362)

#Matrix products: default

#locale:
#  [1] LC_COLLATE=Italian_Italy.1252  LC_CTYPE=Italian_Italy.1252   
#[3] LC_MONETARY=Italian_Italy.1252 LC_NUMERIC=C                  
#[5] LC_TIME=Italian_Italy.1252    

#attached base packages:
# [1] stats     graphics  grDevices utils     datasets  methods   base     

#other attached packages:
#  [1] dplyr_1.0.1  xtable_1.8-4 SimInf_7.0.1

#loaded via a namespace (and not attached):
# [1] lattice_0.20-41  crayon_1.3.4     digest_0.6.25    grid_4.0.2      
#[5] R6_2.4.1         lifecycle_0.2.0  magrittr_1.5     pillar_1.4.6    
#[9] rlang_0.4.7      rstudioapi_0.11  Matrix_1.2-18    ellipsis_0.3.1  
#[13] vctrs_0.3.2      generics_0.0.2   tools_4.0.2      glue_1.4.1      
#[17] purrr_0.3.4      compiler_4.0.2   pkgconfig_2.0.3  tidyselect_1.1.0
#[21] tibble_3.0.3



library(SimInf)
library(dplyr)
library(xtable)

setwd(dirname(rstudioapi::getActiveDocumentContext()$path))#this line sets working directory on rstudio; can be replaced if needed so that working directory contains the data file.

load("Prov_pop.RData")

Tot_Dens=(sum(Prov_pop$Residents)/sum(Prov_pop$Hectares))

# These lines produce table 2

Prov_pop_=Prov_pop[order(-Prov_pop$Density),]

tb=cbind(Prov_pop_[,c(2:3,ncol(Prov_pop_), 6,4)])
tb2=rbind(tb[1:5,], c(" ", rep(NA,4)) ,tb[105:110,])

write.csv(tb2, file="Table 2.csv", row.names = F)
tab2  = readLines("Table 2.csv")
tab2b=gsub(pattern = "NA", replace = "...", x = tab2)
writeLines(tab2b, con="Table 2.csv")

#####################################################################
##########################   ANALYSIS   ##############################
#####################################################################


nsim=50 #number of simulations per scenario
Ds=c(0,1)
Cs=rbind(c(1.5, 2.5, 5.2), c(7.5, 10, 14.8)) #velocities and densities
par(mfrow=c(1,ncol(Cs)))

vect=c(0,0.25,0.5,0.75) # fractions of app users tested


#Parameters
t_to_death=8  #time from symptom onset to death
i_prop=0.6 #symptomatic proportion
pa=1-i_prop #asymptomatic proportion
f=0.1 # asymptomatic infectiousness relative to symptomatics
EFF=1 #convenience switch
TEST=1 #convenience switch
R=1 #distance for contact
Ptrasm=0.10 #attack rate (prob. infection per contact)
switch=1 #convenience switch
td=2 #infectiousenss rises 2 days before symptom onset
ti=5.1-td #incubation time minus td
J_=0.75 #proportion contact infectious traced
q_=0.1 #contact reduction in subjects isolated by app tracing
q_0=0 #contact reduction in identified symptomatic subjecst (assumed perfect for this model)


span = c(seq(1,50, by=2), seq(51,100, by=5), seq(101,600, by=20))

# Results are saved here

modellist=vector(mode = "list", length = (length(Ds)*length(vect)))
raw=array(NA, dim=c(length(Ds), ncol(Cs), length(vect),  
                    length(span)*nrow(Prov_pop)*nsim, 19))
outputs_mn=array(NA, dim=c(length(Ds), ncol(Cs), length(vect),  
                           length(span), 16))
outputs_std=array(NA, dim=c(length(Ds), ncol(Cs), length(vect), 
                            length(span), 16))

# Model specification

# COMPARTMENTS:

# S: Susceptible; I: infectious; R: recovered; P: pre-symptomatic; A: asymptomatic;
# Q*: quarantined (A, or S, or P, or I); D: dead; *cum, T: counters

transitions = 
  c("S -> (PI*(1-pa)*      c0*Density*S*(I)*(1-J*j*j)+
            PI*(1-pa)*f*   c0*Density*S*(A)+
            PI*(1-pa)*f*   c0*Density*S*(P)*(1-J*j*j)+
              PI*(1-pa)*             c0*Density*S*(QI)*q_0+
                PI*(1-pa)*f*  c0*Density*S*(QP+QA)*q_)
                /(S+I+R+A+QA+QP+QS+QI+P) 
                  -> P",
    
    "S -> (PI*pa*             c0*Density*S*(I)*(1-J*j*j)+
            PI*pa*f*   c0*Density*S*(A)+
            PI*pa*f*   c0*Density*S*(P)*(1-J*j*j)+
              PI*pa*             c0*Density*S*(QI)*q_0+
                PI*pa*f*  c0*Density*S*(QP+QA)*q_)
                /(S+I+R+A+QA+QP+QS+QI+P) 
                  -> A+Acum", 
    
    "S -> eff*test*(1-(PI*(1-pa))-PI*pa)*  c0*Density*S*(I)*J*j*j/
              (td*(S+I+R+A+QA+QP+QS+QI+P)) -> QS+Qcum+T",
    "S -> eff*PI*(1-pa)*           c0*Density*S*(I)*J*j*j/
              (td*(S+I+R+A+QA+QP+QS+QI+P)) -> QP+QIcum+Qcum",
    "S -> eff*PI*    pa*           c0*Density*S*(I)*J*j*j/
              (td*(S+I+R+A+QA+QP+QS+QI+P)) -> QA+Qcum",
    
    
    "P -> P/k -> I+Icum", 
    "P -> eff*c0*Density*P*(I)*J*j*j/
              (td*(S+I+R+A+QA+QP+QS+QI+P)) -> QP+QIcum+Qcum",
    
    "I -> J*I/td -> QI+Qcum",
    "I -> I/th -> R", 
    "I -> m*I -> D",
    
    "A -> A/th -> R", 
    "A -> eff*c0*Density*A*(I)*J*j*j/
              (td*(S+I+R+A+QA+QP+QS+QI+P)) -> QA+Qcum",
    
    "QI -> QI/th -> R", 
    "QI -> m*QI -> D",
    
    "QP -> QP/k -> QI+Icum", 
    
    "QA -> QA/th -> R", 
    
    "QS -> QS/tq -> S")


compartments = c("S", "I" ,"Icum", "R", "A" ,"Acum","QA", "QP","QS", 
                  "QI","Qcum", "P", "D", "T","QIcum")


# This part specifies model and runs simulations

count=2
for (D in 1:length(Ds)) {
  for (c in 1:ncol(Cs)) {
      for (i in 1:length(vect)) {
        
        DENS=Ds[D] #density
        x=8*R*Cs[D,c]/pi
        C0=ifelse(DENS!=1, x,Cs[D, c])
        J=J_*switch
        j=vect[i]*switch
        
        
        nodes=rep(1:nrow(Prov_pop), nsim)
        sim=rep(1:nsim, each=nrow(Prov_pop))
        n = nsim*nrow(Prov_pop)
        
        startP=100
        u0 = data.frame(S = rep(Prov_pop$Residents, nsim), I = rep(startP*0.2, n),Icum = rep(0, n), R = rep(0, n),
                         P = rep(startP*0.8,n), QA=(rep(0,n)),QP=(rep(0,n)),QS=(rep(0,n)),
                         QI=(rep(0,n)),Qcum=(rep(0,n)),QIcum=(rep(0,n)), A=(rep(0,n)), Acum=(rep(0,n)),
                         D=(rep(0,n)),T=(rep(0,n)))
        node_data=NULL
        if (DENS!=1) {
          node_data=data.frame(rep(Prov_pop$Density, nsim), rep(Prov_pop$Hectares, nsim))
          names(node_data)=c("Density","Hectares")
        } else {
          node_data=data.frame(rep(rep(1.0, nrow(Prov_pop)), nsim), rep(Prov_pop$Hectares, nsim))
          names(node_data)=c("Density","Hectares")
        }
        model = mparse(transitions = transitions, compartments = compartments,
                        gdata = c(c0=C0,
                                  PI = Ptrasm, pa=pa, 
                                  j=j, th = 10+td, tq=15, test=TEST, 
                                  k=ti, td=td, J=J, eff=EFF, q_=q_, q_0=q_0,
                                  m=0.01/t_to_death, f=f),
                        ldata = node_data, 
                        #      E=E, N=N, events=rbind(lockdown, release),
                        u0 = u0, tspan = span)
        
        set.seed(123)
        result = run(model = model)
        
        modellist[count]=model
        count=count+1
        
        data_out=trajectory(model = result)
        data_out=cbind(nodes, sim, data_out)
        data_out_G_app_=aggregate(cbind( S ,    I ,    R,     A  ,  
                                         Acum,  QA  ,  QP   , QS  ,  QI ,   Qcum,  P ,    D,    
                                         Icum,  T, Qcum)~time+sim, data=data_out, FUN=sum)
        
        data_out_G_app=aggregate(cbind( S ,    I ,    R,     A  ,  
                                        Acum,  QA  ,  QP   , QS  ,  QI ,   Qcum,  P ,    D,    
                                        Icum,  T, Qcum)~time, data=data_out_G_app_, FUN=mean)
        
        data_std=aggregate(cbind( S ,    I ,    R,     A  ,  
                                  Acum,  QA  ,  QP   , QS  ,  QI ,   Qcum,  P ,    D,    
                                  Icum,  T, Qcum)~time, data=data_out_G_app_, FUN=sd)
        
        print(c(D,c, i))
        raw[D, c, i,, ]=(as.matrix(data_out))
        outputs_mn[D, c, i,,  ]=as.matrix(data_out_G_app)
        outputs_std[D, c, i,, ]=as.matrix(data_std)
        
        print(vect[i])
        print(C0)
        if (i==1){
          plot(data_out_G_app$time, data_out_G_app$I+data_out_G_app$QI, 
               type="l", col="red", xlab="Time (days)",
               ylab="Subjects")
          lines(data_out_G_app$time, data_out_G_app$D, col="black")
        } else {
          lines(data_out_G_app$time, data_out_G_app$I+data_out_G_app$QI, 
                lty=i, col="red")
          lines(data_out_G_app$time, data_out_G_app$D, lty=i, col="black")
        }
        
    }
  }
}


# Report and table on quarantined subjects

col1=c(rep("xxvv = 1.5xx",4), rep("xxvv = 2.5xx",4), rep("xxvv = 5.2xx",4), 
       rep("xxC = 7.5xx",4), rep("xxC = 10xx",4), rep("xxC = 14.8xx",4))
xxjxx=rep(c(0,0.25,0.5,0.75),6)

Qdframe=data.frame(col1, xxjxx)

QS=NULL
QI=NULL
for (D in 1:length(Ds)) {
  for (c in 1:ncol(Cs)) {
    for (i in 1:length(vect)) {
      data=as.data.frame(outputs_mn[D,c,i,,])
      colnames(data)=c("time", "S",  "I",  "R", "A", "Acum", "QA",  
                       "QP",  "QS" , "QI",  "Qcum", "P", "D","Icum", "T", "QIcum"  )
      print(c(D, Cs[D,c], vect[i]))
      print(c("True positives:", max(data$QI)))
      QI=c(QI, max(data$QI))
      print(c("False positives:", max(data$QS)))
      QS=c(QS, max(data$QS))
    }
  }
}

Qdframe$xxQIxx=QI
Qdframe$xxQSxx=QS

Qdframe=rbind(c("col1", rep(NA,3)), Qdframe[1:(nrow(Qdframe)*0.5),], 
              c("col1", rep(NA,3)), Qdframe[(1+nrow(Qdframe)*0.5):nrow(Qdframe),])

write.csv(Qdframe, file="Table 3.csv", row.names=F)
tab3= readLines("Table 3.csv")
tab3b=gsub(pattern = "NA", replace = " ", x = tab3)
tab3c=gsub(pattern = "xx", replace = " ", x = tab3b)
tab3d=gsub(pattern = "vv", replace = "v", x = tab3c)
tab3e=gsub(pattern = "col1", replace = " ", x = tab3d)
writeLines(tab3e, con="Table 3.csv")

print(xtable(Qdframe, caption=c("Average maximum True Positives (xxQIxx) and False Positives (xxQSxx) in each scenario."),
      label="table:3", align="clccc"), type = "latex", file = "QI_QS.tex", include.rownames=FALSE)

tx  = readLines("QI_QS.tex")
tx0  = gsub(pattern = "NA", replace = " ", x = tx)
tx1  = gsub(pattern = "col1", replace = " ", x = tx0)
tx2  = gsub(pattern = "xx", replace = "$", x = tx1)
tx3  = gsub(pattern = "vv", replace = "\\\\bar{v}", x = tx2)
writeLines(tx3, con="QI_QS.tex")

# This creates figure 3

par(mfcol=c(ncol(Cs),2*length(Ds)), mar=c(2,3,2,1), oma=c(1.8,1,1.2,1))

counter=0
lim=c(0,300)
for (D in 1:length(Ds)) {
  for (h in 1:2) {
    for (c in 1:ncol(Cs)) {
      counter=counter+1
      if (h==1) {
        for (i in 1:length(vect)) {
          ylab=ifelse(D==1, "Subjects", "")
          xlab=ifelse(c==ncol(Cs), "Time (days)", "")
          data=as.data.frame(outputs_mn[D,c,i,,])
          colnames(data)=c("time", "S",  "I",  "R", "A", "Acum", "QA",  
                           "QP",  "QS" , "QI",  "Qcum", "P", "D","Icum", "T", "QIcum"  )
          mx=0.5*max(data$I+data$QI)
          if (i==1){
            plot(data$time, data$I+data$QI, 
                 type="l", col="red", ann = FALSE, xlim=lim)
            title(main=letters[counter], line=0.8, adj=0)
            #lines(data$time, data$D, col="black")
            mtext(side = 1, text = xlab, line = 2.5)
            mtext(side = 2, text = ylab, line = 2.5)
            if (D==1) {
              text(250, mx, labels=bquote(bar("v")~"="~.(Cs[D,c])))
            } else {
              text(250, mx, labels=bquote("C"~"="~.(Cs[D,c])))
            }
            
          } else {
            lines(data$time, data$I+data$QI, 
                  lty=i, col="red")
            #lines(data$time, data$D, lty=i, col="black")
          }
        }       
      } else {
        for (i in 1:length(vect)) {
          ylab=ifelse(D==1, "", "")
          xlab=ifelse(c==ncol(Cs), "Time (days)", "")
          data=as.data.frame(outputs_mn[D,c,i,,])
          colnames(data)=c("time", "S",  "I",  "R", "A", "Acum", "QA",  
                           "QP",  "QS" , "QI",  "Qcum", "P", "D","Icum", "T", "QIcum"  )
          if (i==1){
            plot(data$time, data$D, 
                 type="l", col="black", ann = FALSE, xlim=lim)
            title(main=letters[counter], line=0.8, adj=0)
            #lines(data$time, data$D, col="black")
            mtext(side = 1, text = xlab, line = 2.5)
            mtext(side = 2, text = ylab, line = 2.5)
            if (D==1) {
              text(250, mx, labels=bquote(bar("v")~"="~.(Cs[D,c])))
            } else {
              text(250, mx, labels=bquote("C"~"="~.(Cs[D,c])))
            }
            
          } else {
            lines(data$time, data$D, 
                  lty=i, col="black")
            #lines(data$time, data$D, lty=i, col="black")
          }
          
        } 
      }
    }
  }
}

# This creates figure 4

par(mfcol=c(ncol(Cs),length(Ds)), mar=c(3,3,0,1), oma=c(1,1,1,1))

for (D in 1:length(Ds)) {
  for (c in 1:ncol(Cs)) {
    for (i in 1:length(vect)) {
      ylab=ifelse(D==1, "Subjects", "")
      xlab=ifelse(c==ncol(Cs), "Time (days)", "")
      
      data=as.data.frame(outputs_mn[D,c,i,,])
      colnames(data)=c("time", "S",  "I",  "R", "A", "Acum", "QA",  
                       "QP",  "QS" , "QI",  "Qcum", "P", "D","Icum", "T", "QIcum"  )
      mx=10000
      if (i==1){
        plot(data$time, data$I+data$QI, 
             type="l", col="red", ann = FALSE,
             xlim=c(0,50), ylim=c(0,20000))
        lines(data$time, data$D, col="black")
        mtext(side = 1, text = xlab, line = 2.5)
        mtext(side = 2, text = ylab, line = 2.5)
        if (D==1) {
          text(45, mx, labels=bquote(bar("v")~"="~.(Cs[D,c])))
        } else {
          text(45, mx, labels=bquote("C"~"="~.(Cs[D,c])))
        }
      } else {
        lines(data$time, data$I+data$QI, 
              lty=i, col="red")
        lines(data$time, data$D, lty=i, col="black")
      }
    }
  }
}


# This part creates figure 5 (normal or logarithmic scale)

subdata=raw[1, 1, 2,, ]
colnames(subdata)=colnames(data_out)
data_bynode_=aggregate(cbind( S ,    I ,    R,     A  ,  
                              Acum,  QA  ,  QP   , QS  ,  QI ,   Qcum,  P ,    D,    
                              Icum,  T)~time+sim+nodes, data=subdata, FUN=sum)
data_bynode=aggregate(cbind( S ,    I ,    R,     A  ,  
                             Acum,  QA  ,  QP   , QS  ,  QI ,   Qcum,  P ,    D,    
                             Icum,  T)~time+nodes, data=data_bynode_, FUN=mean)

count=2
par(mfrow=c(1,1))
data_bynode$nodes=as.factor(data_bynode$nodes)
data_bynode$IQI=data_bynode$I+data_bynode$QI

Prov_pop$District=ifelse(Prov_pop$District=="Monza e della Brianza", "Monza",
                          Prov_pop$District)
Prov_pop$District=ifelse(Prov_pop$District=="Napoli", "Neaples",
                          Prov_pop$District)
Prov_pop$District=ifelse(Prov_pop$District=="Milano", "Milan",
                          Prov_pop$District)
par(mar=c(4,4,0,1))

# linear scale
yl=250
counter=1
cuts=-50+c(200, 170,190)
for (fac in levels(data_bynode$nodes)) {
  
  dat2=subset(data_bynode,data_bynode$nodes==fac & 
                data_bynode$QI+data_bynode$I>110 )
  LAB=Prov_pop[Prov_pop$Pos==fac, "District"]
  
  dat=subset(data_bynode,data_bynode$nodes==fac )
  if (fac=="1") {
    plot(dat$time, dat$I+dat$QI, col="red", type="l",ylim=c(0,yl),
         xlim=c(0,400), xlab="Time (days)", ylab="Subjects" )
  } else {
    if (nrow(dat2)>0) {
      cut=cuts[counter]
      dat3=subset(dat2, time>100)
      dat3$vct=(dat3$I+dat3$QI-cut)^2
      MIN=min(dat3$vct)
      print(fac)
      print(MIN)
      x_=dat3[dat3$vct==MIN, "time"]
      lines(dat$time, dat$I+dat$QI, col="red", lty=counter+1)
      text(x=max(x_), y=cut, labels=LAB, cex=0.8, pos=4, offset=0)
      print(x_)
      counter=counter+1
    } else {
      lines(dat$time, dat$I+dat$QI, col="red")
    }
    count=count+1
  }
}

# logarithmic
yl=log10(1000000)
counter=1
cuts=log10(-50+c(450, 160,300))
for (fac in levels(data_bynode$nodes)) {
  
  dat2=subset(data_bynode,data_bynode$nodes==fac & 
                data_bynode$QI+data_bynode$I>110 )
  LAB=Prov_pop[Prov_pop$Pos==fac, "District"]
  
  dat=subset(data_bynode,data_bynode$nodes==fac )
  if (fac=="1") {
    plot(dat$time, log10(dat$I+dat$QI), col="red", type="l",ylim=c(0,yl),
         xlim=c(0,400), xlab="Time (days)", ylab=expression(paste('Subjects ', ' (log '[10],")" )) )
  } else {
    if (nrow(dat2)>0) {
      cut=cuts[counter]
      dat3=subset(dat2, time>100)
      dat3$vct=(dat3$I+dat3$QI-cut)^2
      MIN=min(dat3$vct)
      print(fac)
      print(MIN)
      x_=dat3[dat3$vct==MIN, "time"]
      lines(dat$time, log10(dat$I+dat$QI), col="red", lty=counter+1)
      text(x=max(x_), y=cut, labels=LAB, cex=0.8, pos=4, offset=0)
      print(x_)
      counter=counter+1
    } else {
      lines(dat$time, log10(dat$I+dat$QI), col="red")
    }
    count=count+1
  }
}