#Too much of a good thing: resource provisioning alters
#infectious disease dynamics in wildlife

#Daniel J. Becker and Richard J. Hall
#dbecker@uga.edu
#modified 6/27/2014

#sample code for provisioning simulation

rm(list=ls()) 
graphics.off()

############################################################
#declare provisioning functions
############################################################

#for parameters that increase with provisioning
pos=function(rvec,min,max,t){
  par=rep(0,length(rvec))
  ct=1
  for(prov in rvec) #provisioning parameter
  {
    par[ct]=max-(max-min)*(exp(-t*prov));
    ct=ct+1
  } 
  return(list(par=par))
}

#for parameters that decrease with provisioning
neg=function(rvec,min,max,t){
  par=rep(0,length(rvec))
  ct=1
  for(prov in rvec) #provisioning parameter
  {
    par[ct]=min+(max-min)*(exp(-t*prov));
    ct=ct+1
  } 
  return(list(par=par))
}

#full provisioning model 
#td, tc, and ti are theta values
#td = demography, tc = contact, ti= immune defense
RP=function(rvec,bmin,bmax,dmin,dmax,cmin,cmax,
            imin,imax,vmin,vmax,gam,td,tc,ti){
  
  #create output vectors
  Rn=rep(0,length(rvec)) #for R naught
  prevSIS=rep(0,length(rvec)) #for equiibrium SIS prevalence
  prevSIR=rep(0,length(rvec)) #for equiibrium SIR prevalence
  
  ct=1; #just a counter to be able to index vectors
  for(prov in rvec) #provisioning parameter rho
  {
    #functional dependence of pars on prov
    b0=bmax-(bmax-bmin)*(exp(-td*prov)) #fecundity
    d0=dmin+(dmax-dmin)*(exp(-td*prov)) #natural mortality    
    cont=cmax-(cmax-cmin)*(exp(-tc*prov)) #contact
    inf=imin+(imax-imin)*(exp(-ti*prov)) #infectivity/susceptibility
    beta=cont*inf; beta #transmission = inf * cont
    v=vmin+(vmax-vmin)*(exp(-ti*prov)) #disease mortality
    
    # if birth rate too low, host population can't persist
    if(b0<d0){    S=0
                  ISIS=0
                  ISIR=0
                  R=0
                  NSIS=0
                  NSIR=0
                  pSIS=0
                  pSIR=0
                  R0=0
    }
    else{
      #calculate K and R0
      K=(b0-d0)/b1
      R0=beta*K/(d0+v+gam)   
      
      #if R0<1, disease can't invade host population
      if(R0<1){      S=K
                     ISIS=0
                     ISIR=0
                     R=0
                     NSIS=K
                     NSIR=K
                     pSIS=0
                     pSIR=0
      }
      # otherwise disease reaches endemic equilibrium
      else
      {      
        S=(d0+v+gam)/beta
        A1=b1
        B1=(((2*b1)+beta)*S)-b0-gam
        C1=(-(b0-(b1*S))*S)+(d0*S)
        
        A2=b1*(1+(gam/d0))^2
        B2=(((2*b1)*(1+(gam/d0))+beta)*S)-(b0*(1+(gam/d0)))
        C2=(-(b0-(b1*S))*S)+(d0*S)
        
        ISIS=(-B1+sqrt((B1^2)-(4*A1*C1)))/(2*A1)
        ISIR=(-B2+sqrt((B2^2)-(4*A2*C2)))/(2*A2)
        R=(gam/d0)*ISIR
        
        NSIS=S+ISIS
        NSIR=S+ISIR+R
        
        pSIS=ISIS/NSIS
        pSIR=ISIR/NSIR      
      }
    }
    
    #record outputs for each iteration
    Rn[ct]=R0 #R naught
    prevSIS[ct]=pSIS #equilibrium prevalence for SIS
    prevSIR[ct]=pSIR #equilibrium prevalence for SIR
    ct=ct+1 #finish counting
  }
  return(list(Rn,prevSIS,prevSIR))
}


############################################################
#declare model parameters
############################################################
#previously reported R0 for FeLV in cats
fR0=10*0.33/(2.4+0.53); fR0=round(fR0,digits=2); fR0
carry=300 #carrying capacity

#baseline parameters
bmin=2.4 #birth
dmax=0.6 #death
b1=(bmin-dmax)/carry; b1
vmax=0.5 #disease mortality
gam=1/(3*7/365); gam=round(gam,digits=2); gam #recovery
beta=fR0*(dmax+vmax+gam)/carry; #derive from reported R0
bet=beta
imax=0.8 #probability of infection / susceptibility
cmin=bet/imax; cmin #contact
R0n=bet*carry/(vmax+dmax+gam); R0n #R0 from above values
fR0==R0n #matches reported R0

#provisioning maximum or minimum of parameters
bmax=1.6*2.75
dmin=0.2
cmax=cmin*5
imin=0.1
vmin=0

#state theta values
thet=c(0,1,2,4,8)
td=thet[4] #for demographic parameters, saturating
tc=thet[2] #for behavior parameter, similar to linear

############################################################
#visualize functional forms of parameters
############################################################
rvec=seq(0,1,length=length(thet)); 

#demographic parameters
birth=pos(rvec,bmin,bmax,td)$par  
death=neg(rvec,dmin,dmax,td)$par  

#contact parameter
cont=pos(rvec,cmin,cmax,tc)$par

#immune defense parameters
#both susceptibility and tolerance take same form
#model over different theta values
imm0=neg(rvec,imin,imax,thet[1])$par
imm1=neg(rvec,imin,imax,thet[2])$par
imm2=neg(rvec,imin,imax,thet[3])$par
imm3=neg(rvec,imin,imax,thet[4])$par
imm4=neg(rvec,imin,imax,thet[5])$par

#plot functional dependence of demographic & behavior pars
par(mfrow=c(1,3))
plot(rvec,birth,las=1,type="l",ylab="b0",xlab="provisioning")
plot(rvec,death,las=1,type="l",ylab="mu",xlab="provisioning")
plot(rvec,cont,las=1,type="l",ylab="alpha",xlab="provisioning")

#plot different assumptions about immune defence
par(mfrow=c(1,1))
plot(rvec,imm0,ylim=c(imin,imax),type="l",lty=2,las=1,
     ylab="delta and nu",xlab="provisioning")
lines(rvec,imm1,lwd=1)
lines(rvec,imm2,lwd=2)
lines(rvec,imm3,lwd=3)
lines(rvec,imm4,lwd=4)

############################################################
#model effect of provisioning on disease outcomes
############################################################
#run provisioning models by varying theta of immunity (ti)
rvec=seq(0,1,length=21); 
P0=RP(rvec,bmin,bmax,dmin,dmax,cmin,cmax,
      imin,imax,vmin,vmax,gam,td,tc,thet[1])
P1=RP(rvec,bmin,bmax,dmin,dmax,cmin,cmax,
      imin,imax,vmin,vmax,gam,td,tc,thet[2])
P2=RP(rvec,bmin,bmax,dmin,dmax,cmin,cmax,
      imin,imax,vmin,vmax,gam,td,tc,thet[3])
P3=RP(rvec,bmin,bmax,dmin,dmax,cmin,cmax,
      imin,imax,vmin,vmax,gam,td,tc,thet[4])
P4=RP(rvec,bmin,bmax,dmin,dmax,cmin,cmax,
      imin,imax,vmin,vmax,gam,td,tc,thet[5])

#plot epidemiological outcomes as function of provisioning
par(mfrow=c(1,3))

#R0
plot(rvec,P0[[1]],type="l",lty=2,log="y",ylab="R0",
     xlab="provisioning",
     ylim=c(min(P4[[1]]),max(P0[[1]])),las=1)
abline(h=1,col="grey",lty=1,lwd=2)
lines(rvec,P1[[1]],type="l",lwd=1)
lines(rvec,P2[[1]],type="l",lwd=2)
lines(rvec,P3[[1]],type="l",lwd=3)
lines(rvec,P4[[1]],type="l",lwd=4)

#SIS prevalence
plot(rvec,P0[[2]],type="l",lty=2,ylab="SIS",xlab="provisioning",
     ylim=c(min(P4[[2]]),max(P0[[2]])),las=1)
lines(rvec,P1[[2]],type="l",lwd=1)
lines(rvec,P2[[2]],type="l",lwd=2)
lines(rvec,P3[[2]],type="l",lwd=3)
lines(rvec,P4[[2]],type="l",lwd=4)

#SIR prevalence
plot(rvec,P0[[3]],type="l",lty=2,ylab="SIR",xlab="provisioning",
     ylim=c(min(P4[[3]]),max(P0[[3]])),las=1)
lines(rvec,P1[[3]],type="l",lwd=1)
lines(rvec,P2[[3]],type="l",lwd=2)
lines(rvec,P3[[3]],type="l",lwd=3)
lines(rvec,P4[[3]],type="l",lwd=4)