## default parameter values
theta <- c(deltaH0 = 0.0854, deltaHinfty = 0.00299, cH = 0.00586, mu0 = 0.1, muM0 = 0.8,
           alpha0 = 0.59, beta0 = 0.33, lambda0 = 1.1538, muH = 0.04, amax = 80, da = 1, 
           rhoF = 0.45, deltaV0 = 0.005, cV = 0, aH = 0.5, muL0 = 104, h = 0.96, g = 0.0096,
           muV = 52, alphaV = 0.60, Q = 1.20, E0 = .10, q = 0, alphaF = -0.023, alphaM = 0.007, 
           beta1Max = 32.4, gammabeta = 19.6, nu = 9.6E-3, omega = 1.25, zeta = 0.35, kW = 999,
           kM0 = 0.013, kM1 = 0.025, startTreat = 80, ABR = 2250,  ntreat = 5, ftreat = 1, cov=0.805,
           noncmp = 0)

## initial value function
init <- function( theta )
{
  nst <- 3
  ns <- 2
  ncp <- 4
  na <- theta[10]/theta[11]
  ntrt <- theta[36];
  ftreat <- theta[37];
  
  nev <- vector("integer", ncp)
  ntr <- vector("integer", ncp)
  ftr <- vector("double", ncp)
 
  for (l in 1:ncp)
  {
    # set the number of treatments for the complicance group 1
    # that is treated every round 
    if (l==1) 
    {
      ntr[l] <- ntrt
      ftr[l] <- ftreat
    }
    # set the number of treatments for the complicance group 2
    # that is treated once every other round and begins treatment
    # at the same time as the fully compliant group
    else if (l > 1 && l < ncp && (l %% 2) == 0 )
    {
      ntr[l] = ceiling(ntrt/2)
      ftr[l] = 2*ftreat
    }
  # set the number of treatments for the other complicance group 3
  # that is treated once every other rounds and begins
  # treatment after the fully compliant group
    else if (l > 2 && l < ncp && (l %% 2) > 0) 
    {
      ntr[l] = floor( ntrt/2 )
      ftr[l] = ( 2*ftreat )
    } 
  # set the treatments for the non compliant group
    else if (l == ncp )
    {
    ntr[l] = 0
    ftr[l] = 2*ftreat
    }
  }
  
  # turn the number of treatments into events with a dummy
  # event at time 0 and at a time arbitraily far in the future 
  # and record cumulative total number of events
  nevcum <- vector("integer", ncp + 1)
  nevcum[1] = 0;
  
  for (l in 1:ncp) 
  {
    nev[l] = ntr[l] + 1
    nevcum[l+1] = nevcum[l] + nev[l] 
  }

  # indicator for order of human parasite states
  Nid <- 0
  Fid <- 1
  Mid <- 2

  # total number of compartments
  tcmpcum <- vector("integer", ncp+1)
  tcmpcum[1] <- 0;
  
  # vector jumps
  jumplcum <- vector("integer", ncp+1)
  jumplcum[1] <- 0
  
  for (l in 1:ncp)
  {
  tcmpcum[l+1] = tcmpcum[l] + (nev[l]*nst*na +na)*ns
  jumpl = ns*(nst*nev[l]*na+na)
  jumplcum[l+1] = jumplcum[l] + jumpl
  }

  tcmp <- tcmpcum[ncp+1]

  # storage vector for initial values
  y0 <- vector("double", tcmp)
  
  # loop and fill appropriate compartments
  for (l in 1:ncp)
    {
      for (k  in 1:ns) 
      {
        jumpk = (k-1)*(nst*nev[l]*na+na);
        jumptoL = nst*nev[l]*na + jumplcum[l] + jumpk;
        for (j in 1:na)
        {
          jumpj = (j-1)*nst*nev[l];
          jump = jumplcum[l] + jumpk + jumpj;
          for (i in 1:nev[l])
          {
            if (i==1)
            {
              y0[i+Nid*nev[l]+jump] = 5;
              y0[i+Fid*nev[l]+jump] = 5;
              y0[i+Mid*nev[l]+jump] = 15;
            }
            else
            {
              y0[i+Nid*nev[l]+jump] = 0;
              y0[i+Fid*nev[l]+jump] = 0;
              y0[i+Mid*nev[l]+jump] = 0;
            } 
            y0[j+jumptoL] = 0; 
          }
        }
      }
    }
  
  return(y0);
  
}

## run EPIONCHO to endemic equilibrium
simequib <- function(theta)
{
  stepsize=21/365
  equibt <- theta["startTreat"]
  t <- seq(0, equibt, stepsize)
  ini <- init(theta)
  nout <- 14
  
  outnames <- c("Nm", "Fm", "Wm", "Mm", "Mm5", "Mm20", "Mpr", "Mpr5",
    "Mpr20", "Lm", "R0", "thercov", "compliant", "semicompliant")
    
  out <- rk(y = ini, times = t, func = "derivs", parms = theta,  dllname = "EPIONCHO", 
            initfunc = "initmod", nout = nout, outnames = outnames, method="rk4", hini=0)
  
  df <- data.frame(time = c(out[, 1]), Mm = c(out[,"Mm"]), Mm5 = c(out[,"Mm5"]), 
                   Mm20 = c(out[,"Mm20"]), Mpr = c(out[,"Mpr"]), Mpr5 = c(out[,"Mpr5"]), 
                   Mpr20 = c(out[,"Mpr20"]),  ATP = c(out[, "Lm"]*theta["ABR"]), 
                   covpop = c(out[,"thercov"]), cmp = c(out[,"compliant"]), 
                   semicmp = c(out[,"semicompliant"]))
    
    return(df)
    
}

## run EPIONCHO through a treatment programme
simtrt <- function(theta)
{
  ## step 1. run model to startTreat using a  relatively large stepsize
  stepsize=21/365
  equibt <- theta["startTreat"]
  t <- seq(0, equibt, stepsize)
  ini <- init(theta)
  nout <- 14
 
  outnames <- c("Nm", "Fm", "Wm", "Mm", "Mm5", "Mm20", "Mpr", "Mpr5",
                "Mpr20", "Lm", "R0", "thercov", "compliant", "semicompliant")
  
  out <- rk(y = ini, times = t, func = "derivs", parms = theta,  dllname = "EPIONCHO", 
            initfunc = "initmod", nout = nout, outnames = outnames, method="rk4", hini=0)
  
  dims<-dim(out)
  ini <- out[dims[1],2:(dims[2]-nout)]
  
  ## step 2. run model through treatment rounds using a smaller stepsize using
  ## initial values from first run
  stepsize<-5/365
  theta["startTreat"] <- 1
  stoptrt <- 1
  
  tmax <- (theta["startTreat"] + theta["ntreat"]*theta["ftreat"])
  
  t <- seq(0, tmax, stepsize)
  
  out <- rk(y = ini, times = t, func = "derivs", parms = theta,  dllname = "EPIONCHO", 
            initfunc = "initmod", nout = nout, outnames = outnames, method="rk4", hini=0)
  

  df <- data.frame(time = c(out[, 1]), Mm = c(out[,"Mm"]), Mm5 = c(out[,"Mm5"]), 
                   Mm20 = c(out[,"Mm20"]), Mpr = c(out[,"Mpr"]), Mpr5 = c(out[,"Mpr5"]), 
                   Mpr20 = c(out[,"Mpr20"]),  ATP = c(out[, "Lm"]*theta["ABR"]), 
                   covpop = c(out[,"thercov"]), cmp = c(out[,"compliant"]), 
                   semicmp = c(out[,"semicompliant"]))
  return(df)
  
}