Pertussis-seroprevalence / c-serotransmission_model.c
c-serotransmission_model.c
Raw
// Implementation of the age-structured pertussis serotransmission model

#include <math.h>

//start_globs

// Probability of transition for event of rate r during time step delta_t
// p = 1 - exp(-r * delta_t)
static double pTrans(double r, double delta_t) {
	
	// r: event (instantaneous rate)
	// delta_t: time step
	// Returns: probability of transition
	double out = 1.0 - exp(-r * delta_t);
	return out;
}
//end_globs

//start_stochSim

int i, j; 
double birth_no; // No of births
double lambda_vec[nA]; // Force of infection
double q_vec[nA]; // Susceptibility to infection
double v_rate[nA]; // Effective vaccination rate
double F_mat[nA][nA]; // Contact matrix (density scale)
double from_E1[nA][2], from_I1[nA][2], from_E2[nA][2], from_I2[nA][2];
double from_Re[nA][2], from_Rp1[nA][2], from_Rp2[nA][2], from_Ve[nA][2], from_Vp[nA][2]; 
double from_S1[nA][3], from_S2[nA][3], from_R[nA][3], from_V[nA][3]; 
double rate2[2], trans2[2];
double rate3[3], trans3[3]; 

//Pointers to state variables
double *S1_vec = (double *) &S1_1; // Susceptible to primary infection
double *E1_vec = (double *) &E1_1; // Exposed, primary infection
double *I1_vec = (double *) &I1_1; // Infected, primary infection
double *S2_vec = (double *) &S2_1; // Susceptible to secondary infection
double *E2_vec = (double *) &E2_1; // Exposed, secondary infection
double *I2_vec = (double *) &I2_1; // Infected, secondary infection
double *R_vec = (double *) &R_1; // Recovered
double *Re_vec = (double *) &Re_1; // Exposed, from recovered state 
double *Rp1_vec = (double *) &Rp1_1; // Seropositive, after infection
double *Rp2_vec = (double *) &Rp2_1; // Seropositive, after exposure from recovered state
double *V_vec = (double *) &V_1; // Vaccinated
double *Ve_vec = (double *) &Ve_1; // Exposed, from vaccinated state 
double *Vp_vec = (double *) &Vp_1; // Seropositive, after exposure from vaccinated state
double *Ci1_vec = (double *) &Ci1_1; // Incidence of primary infections
double *Ci2_vec = (double *) &Ci2_1; // Incidence of secondary infections
double *Cs_vec = (double *) &Cs_1; // Sero-incidence

// Vectors of parameters
double *N_vec = (double *) &N_1; // age-specific population size
double *delta_vec = (double *) &delta_1; // age-specific aging rate
double *p_V_vec = (double *) &p_V_1; // age-specific vaccination coverage
double *f_vec = (double *) &f_1; // Contact matrix (density scale) stacked as vector (line by line), size nA*nA

// Extra parameters

// Susceptibility vector and vaccination rate
for(i = 0; i < nA; i++) {
	q_vec[i] = (i <= 10) ? q1 : ((i <= 20) ? (q1 * q21) : (q1 * q21 * q32)); 
	v_rate[i] = (t < t_V) ? 0.0 : (p_V_vec[i] / (1.0 - p_V_vec[i]) * delta_vec[i]);
}

// Re-create contact matrix
for(i = 0; i < nA; i++) {
	for(j = 0; j < nA; j++) {
		F_mat[i][j] = f_vec[nA * i + j];
	}
}

// Check values of parameters, for debugging
if(debug) {
	/*for(i = 0; i < nA; i++) {
		for(j = 0; j < nA; j++) {
			Rprintf("%.2f ", m_mat[i][j]);
		}
		Rprintf("\n");
	}*/
	Rprintf("\n\n");
//	for(i = 0; i < nA; i++) {
//		Rprintf("gamma_%d = %.2f, beta_%d = %.3f, delta_%d = %.4f\n\n", i, gamma_vec[i], i, beta_vec[i], i, delta_vec[i]);
//	}
//	Rprintf("t = %.2f, tV = %.1f, pV = %.1f, v_t = %.1f\n\n", t, tV, pV, v_t); 
}

// Calculate forces of infections
for(i = 0; i < nA; i++) {
	lambda_vec[i] = 0.0; 

	for(j = 0; j < nA; j++) {
		lambda_vec[i] += F_mat[i][j] * (I1_vec[j] + theta * I2_vec[j] + iota); 
	}
	lambda_vec[i] *= q_vec[i]; 
}

// Sample no of stochastic transitions 
birth_no = rpois(b_rate * N_tot * dt); 
for(i = 0; i < nA; i++) {
	
	// Sample stochastic transitions
	
	// From S1
	rate3[0] = delta_vec[i]; // Aging
	rate3[1] = lambda_vec[i]; // S1->E1, S2->E2
	rate3[2] = v_rate[i]; // S1->V, S2->V 
	reulermultinom(3, S1_vec[i], &rate3[0], dt, &trans3[0]);
	for(j = 0; j < 3; j++) from_S1[i][j] = trans3[j]; 
	
	// From S2
	reulermultinom(3, S2_vec[i], &rate3[0], dt, &trans3[0]);
	for(j = 0; j < 3; j++) from_S2[i][j] = trans3[j]; 
	
	// From E1
	rate2[0] = delta_vec[i]; // Aging
	rate2[1] = sigma; // E1->I1, E2->I2 
	reulermultinom(2, E1_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_E1[i][j] = trans2[j]; 
	
	// From E2
	reulermultinom(2, E2_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_E2[i][j] = trans2[j]; 
	
	// From I1
	rate2[0] = delta_vec[i]; // Aging
	rate2[1] = gamma; // E1->I1, E2->I2 
	reulermultinom(2, I1_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_I1[i][j] = trans2[j]; 
	
	// From I2
	reulermultinom(2, I2_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_I2[i][j] = trans2[j]; 

	// From R
	rate3[0] = delta_vec[i]; // Aging
	rate3[1] = alpha_R; // R->S2
	rate3[2] = rho_R * lambda_vec[i]; // R->Re 
	reulermultinom(3, R_vec[i], &rate3[0], dt, &trans3[0]);
	for(j = 0; j < 3; j++) from_R[i][j] = trans3[j]; 
	
	// From Re
	rate2[0] = delta_vec[i]; // Aging
	rate2[1] = 1.0 / t_p_R; // Re->Rp2
	reulermultinom(2, Re_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_Re[i][j] = trans2[j]; 
	
	// From Rp1
	rate2[0] = delta_vec[i]; // Aging
	rate2[1] = 1.0 / t_n_I; // Rp1->R
	reulermultinom(2, Rp1_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_Rp1[i][j] = trans2[j]; 
	
	// From Rp2
	rate2[0] = delta_vec[i]; // Aging
	rate2[1] = 1.0 / t_n_R; // Rp2->R
	reulermultinom(2, Rp2_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_Rp2[i][j] = trans2[j]; 
	
	// From V 
	rate3[0] = delta_vec[i]; // Aging
	rate3[1] = alpha_V; // V->S2
	rate3[2] = rho_V * lambda_vec[i]; // V->Ve 
	reulermultinom(3, V_vec[i], &rate3[0], dt, &trans3[0]);
	for(j = 0; j < 3; j++) from_V[i][j] = trans3[j];
	
	// From Ve
	rate2[0] = delta_vec[i]; // Aging
	rate2[1] = 1.0 / t_p_V; // Ve->Vp
	reulermultinom(2, Ve_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_Ve[i][j] = trans2[j]; 
	
	// From Vp
	rate2[0] = delta_vec[i]; // Aging
	rate2[1] = 1.0 / t_n_V; // Vp->V
	reulermultinom(2, Vp_vec[i], &rate2[0], dt, &trans2[0]);
	for(j = 0; j < 2; j++) from_Vp[i][j] = trans2[j]; 	
}

// Update state variables
for(i = 0; i < nA; i++) {
	
	// State variables
	S1_vec[i] += ((i == 0) ? birth_no : from_S1[i - 1][0]) - from_S1[i][0] - from_S1[i][1] - from_S1[i][2]; 
	E1_vec[i] += ((i == 0) ? 0 : from_E1[i - 1][0]) + from_S1[i][1] - from_E1[i][0] - from_E1[i][1];
	I1_vec[i] += ((i == 0) ? 0 : from_I1[i - 1][0]) + from_E1[i][1] - from_I1[i][0] - from_I1[i][1];
	S2_vec[i] += ((i == 0) ? 0 : from_S2[i - 1][0]) + from_R[i][1] + from_V[i][1] - from_S2[i][0] - from_S2[i][1] - from_S2[i][2]; 
	E2_vec[i] += ((i == 0) ? 0 : from_E2[i - 1][0]) + from_S2[i][1] - from_E2[i][0] - from_E2[i][1];
	I2_vec[i] += ((i == 0) ? 0 : from_I2[i - 1][0]) + from_E2[i][1] - from_I2[i][0] - from_I2[i][1];
	Rp1_vec[i] += ((i == 0) ? 0 : from_Rp1[i - 1][0]) + from_I1[i][1] + from_I2[i][1] - from_Rp1[i][0] - from_Rp1[i][1]; 
	R_vec[i] += ((i == 0) ? 0 : from_R[i - 1][0]) + from_Rp1[i][1] + from_Rp2[i][1] - from_R[i][0] - from_R[i][1] - from_R[i][2]; 
	Re_vec[i] += ((i == 0) ? 0 : from_Re[i - 1][0]) + from_R[i][2] - from_Re[i][0] - from_Re[i][1]; 
	Rp2_vec[i] += ((i == 0) ? 0 : from_Rp2[i - 1][0]) + from_Re[i][1] - from_Rp2[i][0] - from_Rp2[i][1]; 
	V_vec[i] += ((i == 0) ? 0 : from_V[i - 1][0]) + from_S1[i][2] + from_S2[i][2] + from_Vp[i][1] - from_V[i][0] - from_V[i][1] - from_V[i][2];
	Ve_vec[i] += ((i == 0) ? 0 : from_Ve[i - 1][0]) + from_V[i][2] - from_Ve[i][0] - from_Ve[i][1]; 
	Vp_vec[i] += ((i == 0) ? 0 : from_Vp[i - 1][0]) + from_Ve[i][1] - from_Vp[i][0] - from_Vp[i][1]; 
	
	// Incidence rates
	Ci1_vec[i] += from_I1[i][1];
	Ci2_vec[i] += from_I2[i][1];
	Cs_vec[i] += from_I1[i][1] + from_I2[i][1] + from_Re[i][1] + from_Ve[i][1];	
}

//end_stochSim