// SIR model with Euler multinomial step
// forced transmission (basis functions passed as covariates)
// constant population size as a parameter
// environmental stochasticity on transmission
void _sir_euler_simulator (double *x, const double *p,
const int *stateindex, const int *parindex, const int *covindex,
int covdim, const double *covar,
double t, double dt)
{
int nrate = 6;
double rate[nrate]; // transition rates
double trans[nrate]; // transition numbers
double beta;
double dW;
int nbasis = *(get_pomp_userdata_int("nbasis"));
int deg = *(get_pomp_userdata_int("degree"));
double period = *(get_pomp_userdata_double("period"));
double seasonality[nbasis];
int k;
if (nbasis <= 0) return;
periodic_bspline_basis_eval(t,period,deg,nbasis,&seasonality[0]);
for (k = 0, beta = 0; k < nbasis; k++)
beta += seasonality[k]*BETA[k];
// test to make sure the parameters and state variable values are sane
if (!(R_FINITE(beta)) ||
!(R_FINITE(GAMMA)) ||
!(R_FINITE(MU)) ||
!(R_FINITE(BETA_SD)) ||
!(R_FINITE(IOTA)) ||
!(R_FINITE(POPSIZE)) ||
!(R_FINITE(SUSC)) ||
!(R_FINITE(INFD)) ||
!(R_FINITE(RCVD)) ||
!(R_FINITE(CASE)) ||
!(R_FINITE(W)))
return;
dW = rgammawn(BETA_SD,dt); // gamma noise, mean=dt, variance=(beta_sd^2 dt)
// compute the transition rates
rate[0] = MU*POPSIZE; // birth into susceptible class
rate[1] = (IOTA+beta*INFD*dW/dt)/POPSIZE; // force of infection
rate[2] = MU; // death from susceptible class
rate[3] = GAMMA; // recovery
rate[4] = MU; // death from infectious class
rate[5] = MU; // death from recovered class
// compute the transition numbers
trans[0] = rpois(rate[0]*dt); // births are Poisson
reulermultinom(2,SUSC,&rate[1],dt,&trans[1]);
reulermultinom(2,INFD,&rate[3],dt,&trans[3]);
reulermultinom(1,RCVD,&rate[5],dt,&trans[5]);
// balance the equations
SUSC += trans[0]-trans[1]-trans[2];
INFD += trans[1]-trans[3]-trans[4];
RCVD += trans[3]-trans[5];
CASE += trans[3]; // cases are cumulative recoveries
if (BETA_SD > 0.0) W += (dW-dt)/BETA_SD; // mean = 0, variance = dt
}
void _sir_ODE (double *f, double *x, const double *p,
const int *stateindex, const int *parindex, const int *covindex,
int covdim, const double *covar, double t)
{
int nrate = 6;
double rate[nrate]; // transition rates
double term[nrate]; // terms in the equations
double beta;
int nbasis = *(get_pomp_userdata_int("nbasis"));
int deg = *(get_pomp_userdata_int("degree"));
double period = *(get_pomp_userdata_double("period"));
double seasonality[nbasis];
int k;
if (nbasis <= 0) return;
periodic_bspline_basis_eval(t,period,deg,nbasis,&seasonality[0]);
for (k = 0, beta = 0; k < nbasis; k++)
beta += seasonality[k]*BETA[k];
// compute the transition rates
rate[0] = MU*POPSIZE; // birth into susceptible class
rate[1] = (IOTA+beta*INFD)/POPSIZE; // force of infection
rate[2] = MU; // death from susceptible class
rate[3] = GAMMA; // recovery
rate[4] = MU; // death from infectious class
rate[5] = MU; // death from recovered class
// compute the several terms
term[0] = rate[0];
term[1] = rate[1]*SUSC;
term[2] = rate[2]*SUSC;
term[3] = rate[3]*INFD;
term[4] = rate[4]*INFD;
term[5] = rate[5]*RCVD;
// balance the equations
DSDT = term[0]-term[1]-term[2];
DIDT = term[1]-term[3]-term[4];
DRDT = term[3]-term[5];
DCDT = term[3]; // accumulate the new I->R transitions
DWDT = 0; // no noise, so no noise accumulation
}
void _sir_par_trans (double *pt, double *p, int *parindex)
{
int nbasis = *(get_pomp_userdata_int("nbasis"));
int k;
pt[parindex[0]] = exp(GAMMA);
pt[parindex[1]] = exp(MU);
pt[parindex[2]] = exp(IOTA);
for (k = 0; k < nbasis; k++)
pt[parindex[3]+k] = exp(BETA[k]);
pt[parindex[4]] = exp(BETA_SD);
pt[parindex[6]] = expit(RHO);
from_log_barycentric(pt+parindex[7],&S0,3);
}
double _sir_rates (int j, double t, double *x, double *p,
int *stateindex, int *parindex, int *covindex,
int ncovar, double *covar) {
double beta;
double rate = 0.0;
int nbasis = *(get_pomp_userdata_int("nbasis"));
int deg = *(get_pomp_userdata_int("degree"));
double period = *(get_pomp_userdata_double("period"));
double seasonality[nbasis];
int k;
switch (j) {
case 1: // birth
rate = MU*POPN;
break;
case 2: // susceptible death
rate = MU*SUSC;
break;
case 3: // infection
periodic_bspline_basis_eval(t,period,deg,nbasis,&seasonality[0]);
for (k = 0, beta = 0; k < nbasis; k++)
beta += seasonality[k]*BETA[k];
rate = (beta*INFD+IOTA)*SUSC/POPSIZE;
break;
case 4: // infected death
rate = MU*INFD;
break;
case 5: // recovery
rate = GAMMA*INFD;
break;
case 6: // recovered death
rate = MU*RCVD;
break;
default:
error("unrecognized rate code %d",j);
break;
}
return rate;
}