require(deSolve)
d <- 1/21900 
mu <- 1/10 
r <- d*10^6 
B <- 0.835 
alpha <- (B-mu)/(2*1e6) 
g <-1/6 
a <- 0.008549 
phi <- 0.2 

minPoint <- 365*5 

simulate_baseline <- function(R, epsilon, delta,time)
{
	res <- function(epsilon, delta, T, incond)
		{
		parms <- c(epsilon, delta)
		ov_model <- with(as.list(parms), function(t, x, parms) {

		ds <- r*(1-epsilon) - phi*x["s"]*x["v"]/(x["s"]+x["i"]+x["r"]) - d*x["s"] 
		di <- phi*x["s"]*x["v"]/(x["s"]+x["i"]+x["r"]) - delta*x["i"] - (d+a)*x["i"] - g*x["i"]
		dr <- epsilon*r + (delta+g)*x["i"] - d*x["r"]
		du <- (B-alpha*(x["u"]+x["v"]))*(x["u"]+x["v"])-phi*x["u"]*x["i"]/(x["s"]+x["i"]+x["r"]) - mu*x["u"]
		dv <- phi*x["u"]*x["i"]/(x["s"]+x["i"]+x["r"]) - mu*x["v"]
		dz <- phi*x["s"]*x["v"]/(x["s"]+x["i"]+x["r"])

		res <- c( ds , di , dr, du , dv, dz )
		list(res)
		})

		init <- c(s=incond[1], i=incond[2], r=incond[3], u=incond[4], v=incond[5], z=0)
		times <- seq(0,T,length=2000)
		otpt <- lsoda(y=init, times, ov_model, parms)
		otpt
		}

	initPsi <- 1
	incond0 <- c(r/d,0,0,(B-mu)/alpha, 1, initPsi) # disease endemic equilibrium, from EndemicEquilibrium.nb

	otcm <- res(epsilon, delta, time, incond0)
	return(otcm)
}


simulate <- function(R, failpoint, epsilon, delta, T, incond)
		{
		fu <- function(x) ifelse(R < Inf, 1/(1 + exp(R*x + B0) ), 1) # By fiat, make this value invariant if R=Inf
		fa <- function(x) ifelse(R < Inf, ifelse(x < failpoint, 0, 1), 0)

		parms <- c(epsilon, delta)
		ov_model <- with(as.list(parms), function(t, x, parms) {

		ds <- r*(1-epsilon) - phi*x["s"]*(x["v1"]+x["v2"])/(x["s"]+x["i1"]+x["i2"] + x["r"]) - d*x["s"] 
		di1 <- phi*x["s"]*(x["v1"])/(x["s"]+x["i1"]+x["i2"]+x["r"]) - delta*x["i1"] - (d+a)*x["i1"] - g*x["i1"]
		di2 <- phi*x["s"]*(x["v2"])/(x["s"]+x["i1"]+x["i2"]+x["r"]) - delta*x["i2"] - (d+a)*x["i2"] - g*x["i2"]
		dr <- epsilon*r + (delta+g)*x["i1"] + (delta+g)*x["i2"] - d*x["r"]
		du <- (B-alpha*(x["u"]+x["v1"]+x["v2"]))*(x["u"]+x["v1"]+x["v2"])-fu(t)*phi*x["u"]*x["i1"]/(x["s"]+x["i1"]+x["i2"] + x["r"]) - fa(t)*phi*x["u"]*x["i2"]/(x["s"]+x["i1"]+x["i2"] + x["r"])- mu*x["u"]
		dv1 <- fu(t)*phi*x["u"]*x["i1"]/(x["s"]+x["i1"]+x["i2"] + x["r"]) - mu*x["v1"]
		dv2 <- fa(t)*phi*x["u"]*x["i2"]/(x["s"]+x["i1"]+x["i2"] + x["r"]) - mu*x["v2"] 
	#	dmu <- ifelse(x["mu"] > M, 0, R*x["mu"])
		dz <- phi*x["s"]*(x["v1"]+x["v2"])/(x["s"]+x["i1"]+x["i2"]+x["r"])

		res <- c( ds , di1 ,di2, dr, du , dv1 ,dv2, dz )
		list(res)
		})

		init <- c(s=incond[1], i1=incond[2], i2=0, r=incond[3], u=incond[4], v1=incond[5], v2=0, z=0)
		times <- seq(0,T,length=2000)
		if (R < Inf)
			{
			eventdat <- data.frame(var=c("v2"), time=failpoint, value=1, method="add")
			otpt <- lsoda(y=init, times, ov_model, parms,atol=2^-52,maxsteps=20000,events=list(data=eventdat))
			}
		else
			{
			otpt <- lsoda(y=init, times, ov_model, parms)
			}
		otpt
		}

# look at what happens after 10 years of strategy:
nbins <- 50
baseline <- simulate_baseline(0,0,0,1e5) # should give values similar to what the mathematica notebook obtains

M <- 0

equilVec <- (B-mu)/alpha

FailureRate <- 10^seq(-3,-1.7,length=nbins)
vaccRate <- 0.99*10^seq(-3,0,length=nbins)
cases <- expand.grid(FailureRate, vaccRate)


ans <- matrix(nrow=nbins, ncol=nbins) # answer in terms of cumulative incidence
ansInfs <- matrix(nrow=nbins, ncol=nbins)
ansT <- matrix(nrow=nbins, ncol=nbins) # answer in terms of reduction from equilibrium 
ansMax <- matrix(nrow=nbins, ncol=nbins)
endemicEquil <- as.numeric(baseline[nrow(baseline),2:ncol(baseline)])

timeFrame <- 3.65e3 # 10 years
k <- 1

B0 <- -10

delta <- 0 # drug induced recovery rate 
nothing <- simulate(Inf,0,0,0,timeFrame, endemicEquil) 
for (i in 1:nbins)
	{
	for (j in 1:nbins)
		{
		val <- simulate(cases[k,1], timeFrame*2/3, cases[k,2],delta,timeFrame, endemicEquil)
		ans[i,j] <- val[nrow(val),"z"]-val[1,"z"]
		# omit the event point:
		val <- val[-which(val[,1]==timeFrame*2/3),]
		maxpoint <- which(val[,"z"]/nothing[,"z"]==max(val[,"z"]/nothing[,"z"],na.rm=T))
		ansMax[i,j] <- val[maxpoint,"z"]/nothing[maxpoint,"z"] # omit the case where nothing[,"z"]==0
		ansInfs[i,j] <- sum(val[,"i1"] + val[,"i2"])
		ansT[i,j] <- ifelse(val[nrow(val),3] < endemicEquil[2]*0.01, val[min(which(val[,3] < endemicEquil[2]*0.01)),1], timeFrame)
		k <- k + 1
		print(k)
		}
	}

############################################
#
#
# Scripts related to calculate Effective TR at long term equilibrium for various parameter combinations
#
#
############################################


phi0 <- 0.2

psi <- phi0
# Consider the nonlinear case

effType <- function(t, s, i, r, u, delta, R, P)
	{
	phiVal <- function(t) max(P, exp(R*t))*phi0
	(phiVal(t) * s * u * psi)/((a + d + g + delta)*mu*((i + r + s)^2))
	}


effTypeLT <- function(s, i, r, u, delta, R, P)
	{
	(P*phi0 * s * u * psi)/((a + d + g + delta)*mu*((i + r + s)^2))
	}

typeReprTS <- function(otcm, delta, R, P)
	{
	otpt <- numeric()
	for (i in 1:nrow(otcm))
		{
		otpt[i] <- effType(otcm[i,1], otcm[i,"s"], otcm[i,"i"], otcm[i,"r"], otcm[i,"u"],delta, R, P)
		}
	return(otpt)
	}

# Calculate effective Type Reproductive Number at the long-term endemic equilibrium.

library(rootSolve)

getEquil <- function(epsilon, delta, P)
	{
	# initial guess
	guess <- c("s"=endemicEquil[1],"i"=endemicEquil[2],"r"=endemicEquil[3],"u"=endemicEquil[4],"v"=endemicEquil[5])

	epi_model <- function(t, x, parms) {

		ds <- r*(1-epsilon) - phi*x["s"]*x["v"]/(x["s"]+x["i"]+x["r"]) - d*x["s"] 
		di <- phi*x["s"]*x["v"]/(x["s"]+x["i"]+x["r"]) - delta*x["i"] - (d+a)*x["i"] - g*x["i"]
		dr <- epsilon*r + (delta+g)*x["i"] - d*x["r"]
		du <- (B-alpha*(x["u"]+x["v"]))*(x["u"]+x["v"])- P*phi*x["u"]*x["i"]/(x["s"]+x["i"]+x["r"]) - mu*x["u"]
		dv <- P*phi*x["u"]*x["i"]/(x["s"]+x["i"]+x["r"]) - mu*x["v"]

		res <- c( ds , di , dr, du , dv )
		list(res)
		}

	steady(y=guess, func=epi_model,positive=TRUE)
	}


getEquil2 <- function(epsilon, delta, P,incond)
	{
	# initial guess
	guess <- c("s"=incond[1],"i"=incond[2],"r"=incond[3],"u"=incond[4],"v"=incond[5])

	epi_model <- function(t, x, parms) {

		ds <- r*(1-epsilon) - phi*x["s"]*x["v"]/(x["s"]+x["i"]+x["r"]) - d*x["s"] 
		di <- phi*x["s"]*x["v"]/(x["s"]+x["i"]+x["r"]) - delta*x["i"] - (d+a)*x["i"] - g*x["i"]
		dr <- epsilon*r + (delta+g)*x["i"] - d*x["r"]
		du <- (B-alpha*(x["u"]+x["v"]))*(x["u"]+x["v"])- P*phi*x["u"]*x["i"]/(x["s"]+x["i"]+x["r"]) - mu*x["u"]
		dv <- P*phi*x["u"]*x["i"]/(x["s"]+x["i"]+x["r"]) - mu*x["v"]

		res <- c( ds , di , dr, du , dv )
		list(res)
		}

	steady(y=guess, func=epi_model,positive=TRUE)
	}


EquilFType <- function(epsilon, delta, P)
	{
	equilVal <- getEquil(epsilon, delta, P)$y
	ans <- effTypeLT(equilVal["s"], equilVal["i"], equilVal["r"], equilVal["u"], delta, R, P)
	return(list(TypeRepr=as.numeric(ans), equilibrium=equilVal))
	}