phylopomp
Phylodynamics for POMPs
Loading...
Searching...
No Matches
twospecies_pomp.c File Reference
#include "pomplink.h"
#include "internal.h"
Include dependency graph for twospecies_pomp.c:

Go to the source code of this file.

Macros

#define host1   0
 
#define host2   1
 
#define Beta11   (__p[__parindex[0]])
 
#define Beta12   (__p[__parindex[1]])
 
#define Beta21   (__p[__parindex[2]])
 
#define Beta22   (__p[__parindex[3]])
 
#define gamma1   (__p[__parindex[4]])
 
#define gamma2   (__p[__parindex[5]])
 
#define psi1   (__p[__parindex[6]])
 
#define psi2   (__p[__parindex[7]])
 
#define omega1   (__p[__parindex[8]])
 
#define omega2   (__p[__parindex[9]])
 
#define b1   (__p[__parindex[10]])
 
#define b2   (__p[__parindex[11]])
 
#define d1   (__p[__parindex[12]])
 
#define d2   (__p[__parindex[13]])
 
#define C1   (__p[__parindex[14]])
 
#define C2   (__p[__parindex[15]])
 
#define S1_0   (__p[__parindex[16]])
 
#define S2_0   (__p[__parindex[17]])
 
#define I1_0   (__p[__parindex[18]])
 
#define I2_0   (__p[__parindex[19]])
 
#define R1_0   (__p[__parindex[20]])
 
#define R2_0   (__p[__parindex[21]])
 
#define S1   (__x[__stateindex[0]])
 
#define S2   (__x[__stateindex[1]])
 
#define I1   (__x[__stateindex[2]])
 
#define I2   (__x[__stateindex[3]])
 
#define R1   (__x[__stateindex[4]])
 
#define R2   (__x[__stateindex[5]])
 
#define N1   (__x[__stateindex[6]])
 
#define N2   (__x[__stateindex[7]])
 
#define ll   (__x[__stateindex[8]])
 
#define node   (__x[__stateindex[9]])
 
#define ell1   (__x[__stateindex[10]])
 
#define ell2   (__x[__stateindex[11]])
 
#define COLOR   (__x[__stateindex[12]])
 
#define EVENT_RATES
 
#define lik   (__lik[0])
 

Functions

static int random_choice (double n)
 
static void change_color (double *color, int nsample, int n, int from, int to)
 
static int check_color (double *color, int nsample, double size1, double size2)
 
static double event_rates (double *__x, const double *__p, double t, const int *__stateindex, const int *__parindex, const int *__covindex, const double *__covars, double *rate, double *logpi, double *penalty)
 
void twospecies_rinit (double *__x, const double *__p, double t0, const int *__stateindex, const int *__parindex, const int *__covindex, const double *__covars)
 
void twospecies_gill (double *__x, const double *__p, const int *__stateindex, const int *__parindex, const int *__covindex, const double *__covars, double t, double dt)
 
void twospecies_dmeas (double *__lik, const double *__y, const double *__x, const double *__p, int give_log, const int *__obsindex, const int *__stateindex, const int *__parindex, const int *__covindex, const double *__covars, double t)
 Measurement model likelihood (dmeasure).
 

Variables

static const int nrate = 18
 

Macro Definition Documentation

◆ b1

#define b1   (__p[__parindex[10]])

Definition at line 51 of file twospecies_pomp.c.

◆ b2

#define b2   (__p[__parindex[11]])

Definition at line 52 of file twospecies_pomp.c.

◆ Beta11

#define Beta11   (__p[__parindex[0]])

Definition at line 41 of file twospecies_pomp.c.

◆ Beta12

#define Beta12   (__p[__parindex[1]])

Definition at line 42 of file twospecies_pomp.c.

◆ Beta21

#define Beta21   (__p[__parindex[2]])

Definition at line 43 of file twospecies_pomp.c.

◆ Beta22

#define Beta22   (__p[__parindex[3]])

Definition at line 44 of file twospecies_pomp.c.

◆ C1

#define C1   (__p[__parindex[14]])

Definition at line 55 of file twospecies_pomp.c.

◆ C2

#define C2   (__p[__parindex[15]])

Definition at line 56 of file twospecies_pomp.c.

◆ COLOR

#define COLOR   (__x[__stateindex[12]])

Definition at line 75 of file twospecies_pomp.c.

◆ d1

#define d1   (__p[__parindex[12]])

Definition at line 53 of file twospecies_pomp.c.

◆ d2

#define d2   (__p[__parindex[13]])

Definition at line 54 of file twospecies_pomp.c.

◆ ell1

#define ell1   (__x[__stateindex[10]])

Definition at line 73 of file twospecies_pomp.c.

◆ ell2

#define ell2   (__x[__stateindex[11]])

Definition at line 74 of file twospecies_pomp.c.

◆ EVENT_RATES

#define EVENT_RATES
Value:
event_rates(__x,__p,t, \
__stateindex,__parindex,__covindex, \
__covars,rate,logpi,&penalty) \
static double event_rates(double *__x, const double *__p, double t, const int *__stateindex, const int *__parindex, double *rate, double *penalty)
Definition lbdp_pomp.c:18

Definition at line 77 of file twospecies_pomp.c.

77#define EVENT_RATES \
78 event_rates(__x,__p,t, \
79 __stateindex,__parindex,__covindex, \
80 __covars,rate,logpi,&penalty) \
81

◆ gamma1

#define gamma1   (__p[__parindex[4]])

Definition at line 45 of file twospecies_pomp.c.

◆ gamma2

#define gamma2   (__p[__parindex[5]])

Definition at line 46 of file twospecies_pomp.c.

◆ host1

#define host1   0

Definition at line 5 of file twospecies_pomp.c.

◆ host2

#define host2   1

Definition at line 6 of file twospecies_pomp.c.

◆ I1

#define I1   (__x[__stateindex[2]])

Definition at line 65 of file twospecies_pomp.c.

◆ I1_0

#define I1_0   (__p[__parindex[18]])

Definition at line 59 of file twospecies_pomp.c.

◆ I2

#define I2   (__x[__stateindex[3]])

Definition at line 66 of file twospecies_pomp.c.

◆ I2_0

#define I2_0   (__p[__parindex[19]])

Definition at line 60 of file twospecies_pomp.c.

◆ lik

#define lik   (__lik[0])

Definition at line 634 of file twospecies_pomp.c.

◆ ll

#define ll   (__x[__stateindex[8]])

Definition at line 71 of file twospecies_pomp.c.

◆ N1

#define N1   (__x[__stateindex[6]])

Definition at line 69 of file twospecies_pomp.c.

◆ N2

#define N2   (__x[__stateindex[7]])

Definition at line 70 of file twospecies_pomp.c.

◆ node

#define node   (__x[__stateindex[9]])

Definition at line 72 of file twospecies_pomp.c.

◆ omega1

#define omega1   (__p[__parindex[8]])

Definition at line 49 of file twospecies_pomp.c.

◆ omega2

#define omega2   (__p[__parindex[9]])

Definition at line 50 of file twospecies_pomp.c.

◆ psi1

#define psi1   (__p[__parindex[6]])

Definition at line 47 of file twospecies_pomp.c.

◆ psi2

#define psi2   (__p[__parindex[7]])

Definition at line 48 of file twospecies_pomp.c.

◆ R1

#define R1   (__x[__stateindex[4]])

Definition at line 67 of file twospecies_pomp.c.

◆ R1_0

#define R1_0   (__p[__parindex[20]])

Definition at line 61 of file twospecies_pomp.c.

◆ R2

#define R2   (__x[__stateindex[5]])

Definition at line 68 of file twospecies_pomp.c.

◆ R2_0

#define R2_0   (__p[__parindex[21]])

Definition at line 62 of file twospecies_pomp.c.

◆ S1

#define S1   (__x[__stateindex[0]])

Definition at line 63 of file twospecies_pomp.c.

◆ S1_0

#define S1_0   (__p[__parindex[16]])

Definition at line 57 of file twospecies_pomp.c.

◆ S2

#define S2   (__x[__stateindex[1]])

Definition at line 64 of file twospecies_pomp.c.

◆ S2_0

#define S2_0   (__p[__parindex[17]])

Definition at line 58 of file twospecies_pomp.c.

Function Documentation

◆ change_color()

static void change_color ( double * color,
int nsample,
int n,
int from,
int to )
static

Definition at line 12 of file twospecies_pomp.c.

13 {
14 int i = -1;
15 while (n >= 0 && i < nsample) {
16 i++;
17 if (!ISNA(color[i]) && nearbyint(color[i]) == from) n--;
18 }
19 assert(i < nsample);
20 assert(n == -1);
21 assert(nearbyint(color[i]) == from);
22 color[i] = to;
23}
SEXP nsample(TYPE &X)
Definition generics.h:12
#define n
Definition lbdp_pomp.c:8
Here is the call graph for this function:
Here is the caller graph for this function:

◆ check_color()

static int check_color ( double * color,
int nsample,
double size1,
double size2 )
static

Definition at line 26 of file twospecies_pomp.c.

27 {
28 int n1 = 0, n2 = 0;
29 int s1 = (int) nearbyint(size1);
30 int s2 = (int) nearbyint(size2);
31 for (int i = 0; i < nsample; i++) {
32 if (!ISNA(color[i])) {
33 if (nearbyint(color[i]) == host1) n1++;
34 if (nearbyint(color[i]) == host2) n2++;
35 }
36 }
37 return (n1==s1) && (n2==s2);
38}
#define host1
#define host2
Here is the call graph for this function:
Here is the caller graph for this function:

◆ event_rates()

static double event_rates ( double * __x,
const double * __p,
double t,
const int * __stateindex,
const int * __parindex,
const int * __covindex,
const double * __covars,
double * rate,
double * logpi,
double * penalty )
static

Definition at line 84 of file twospecies_pomp.c.

96 {
97 double event_rate = 0;
98 double alpha, pi, disc;
99 *penalty = 0;
100 // 0: Trans_11, s = (0,0),(1,0)
101 assert(S1>=0 && I1>=ell1 && ell1>=0);
102 alpha = (N1 > 0) ? Beta11*S1*I1/N1 : 0;
103 disc = (I1 > 0) ? ell1*(ell1-1)/I1/(I1+1) : 1;
104 *penalty += alpha*disc;
105 event_rate += (*rate = alpha*(1-disc)); rate++;
106 *logpi = 0; logpi++;
107 assert(R_FINITE(event_rate));
108 // 1: Trans_22, s = (0,0),(0,1)
109 assert(S2>=0 && I2>=ell2 && ell2>=0);
110 alpha = (N2 > 0) ? Beta22*S2*I2/N2 : 0;
111 disc = (I2 > 0) ? ell2*(ell2-1)/I2/(I2+1) : 1;
112 *penalty += alpha*disc;
113 event_rate += (*rate = alpha*(1-disc)); rate++;
114 *logpi = 0; logpi++;
115 assert(R_FINITE(event_rate));
116 // 2: Trans_21, s = (0,0),(1,0)
117 // s = (0,0): pi = (I1-ell1)/I1, m = 1,
118 // s = (1,0): pi = 1/(2*I1), m = ell1
119 // total pi = (I1-0.5*ell1)/I1
120 assert(S2>=0 && I1>=ell1 && ell1>=0);
121 alpha = (N1 > 0) ? Beta21*S2*I1/N1 : 0;
122 pi = (I1 > 0) ? (I1-0.5*ell1)/I1 : 1;
123 event_rate += (*rate = alpha*pi); rate++;
124 *logpi = log(pi); logpi++;
125 assert(R_FINITE(event_rate));
126 // 3: Trans_21, s = (0,1)
127 // s = (0,1): pi = 1/(2*I1), m = ell1
128 pi = (I1 > 0) ? 1-pi : 1;
129 event_rate += (*rate = alpha*pi); rate++;
130 *logpi = log(pi)-log(ell1); logpi++;
131 assert(R_FINITE(event_rate));
132 // 4: Trans_12, s = (0,0),(0,1)
133 assert(S1>=0 && I2>=ell2 && ell2>=0);
134 alpha = (N2 > 0) ? Beta12*S1*I2/N2 : 0;
135 pi = (I2 > 0) ? (I2-ell2*0.5)/I2 : 1;
136 event_rate += (*rate = alpha*pi); rate++;
137 *logpi = log(pi); logpi++;
138 assert(R_FINITE(event_rate));
139 // 5: Trans_12, s = (1,0)
140 pi = (I2 > 0) ? 1-pi : 0;
141 event_rate += (*rate = alpha*pi); rate++;
142 *logpi = log(pi)-log(ell2); logpi++;
143 assert(R_FINITE(event_rate));
144 // 6: Recov_1
145 assert(I1>=0 && ell1>=0);
146 alpha = gamma1*I1;
147 if (I1 > ell1) {
148 event_rate += (*rate = alpha); rate++;
149 } else {
150 *rate = 0; rate++;
151 *penalty += alpha;
152 }
153 *logpi = 0; logpi++;
154 assert(R_FINITE(event_rate));
155 // 7: Recov_2
156 assert(I2>=0 && ell2>=0);
157 alpha = gamma2*I2;
158 if (I2 > ell2) {
159 event_rate += (*rate = alpha); rate++;
160 } else {
161 *rate = 0; rate++;
162 *penalty += alpha;
163 }
164 *logpi = 0; logpi++;
165 assert(R_FINITE(event_rate));
166 // 8: Wane_1
167 assert(R1>=0);
168 alpha = omega1*R1;
169 event_rate += (*rate = alpha); rate++;
170 *logpi = 0; logpi++;
171 assert(R_FINITE(event_rate));
172 // 9: Wane_2
173 assert(R2>=0);
174 alpha = omega2*R2;
175 event_rate += (*rate = alpha); rate++;
176 *logpi = 0; logpi++;
177 assert(R_FINITE(event_rate));
178 // 10: Birth_1
179 assert(N1>=0);
180 alpha = b1*N1;
181 event_rate += (*rate = alpha); rate++;
182 *logpi = 0; logpi++;
183 assert(R_FINITE(event_rate));
184 // 11: Birth_2
185 assert(N2>=0);
186 alpha = b2*N2;
187 event_rate += (*rate = alpha); rate++;
188 *logpi = 0; logpi++;
189 assert(R_FINITE(event_rate));
190 // 12: Death_S1
191 assert(S1>=0);
192 alpha = d1*S1;
193 event_rate += (*rate = alpha); rate++;
194 *logpi = 0; logpi++;
195 assert(R_FINITE(event_rate));
196 // 13: Death_I1
197 assert(I1>=0);
198 alpha = d1*I1;
199 if (I1 > ell1) {
200 event_rate += (*rate = alpha); rate++;
201 } else {
202 *rate = 0; rate++;
203 *penalty += alpha;
204 }
205 *logpi = 0; logpi++;
206 assert(R_FINITE(event_rate));
207 // 14: Death_R1
208 assert(R1>=0);
209 alpha = d1*R1;
210 event_rate += (*rate = alpha); rate++;
211 *logpi = 0; logpi++;
212 assert(R_FINITE(event_rate));
213 // 15: Death_S2
214 assert(S2>=0);
215 alpha = d2*S2;
216 event_rate += (*rate = alpha); rate++;
217 *logpi = 0; logpi++;
218 assert(R_FINITE(event_rate));
219 // 16: Death_I2
220 assert(I2>=0);
221 alpha = d2*I2;
222 if (I2 > ell2) {
223 event_rate += (*rate = alpha); rate++;
224 } else {
225 *rate = 0; rate++;
226 *penalty += alpha;
227 }
228 *logpi = 0; logpi++;
229 assert(R_FINITE(event_rate));
230 // 17: Death_R2
231 assert(R2>=0);
232 alpha = d2*R2;
233 event_rate += (*rate = alpha); rate++;
234 *logpi = 0; logpi++;
235 assert(R_FINITE(event_rate));
236 // Sample_1 (Q = 0) // NB: (1-C1)*psi1+C1*psi1 = psi1
237 *penalty += psi1*I1;
238 // Sample_2 (Q = 0) // NB: (1-C2)*psi2+C2*psi2 = psi2
239 *penalty += psi2*I2;
240 return event_rate;
241}
#define psi1
#define I2
#define psi2
#define I1
#define ell1
#define d1
#define Beta21
#define Beta12
#define b1
#define Beta22
#define S1
#define R2
#define R1
#define Beta11
#define N1
#define omega2
#define gamma1
#define N2
#define b2
#define S2
#define d2
#define ell2
#define gamma2
#define omega1

◆ random_choice()

static int random_choice ( double n)
inlinestatic

Definition at line 8 of file twospecies_pomp.c.

8 {
9 return floor(R_unif_index(n));
10}
Here is the caller graph for this function:

◆ twospecies_dmeas()

void twospecies_dmeas ( double * __lik,
const double * __y,
const double * __x,
const double * __p,
int give_log,
const int * __obsindex,
const int * __stateindex,
const int * __parindex,
const int * __covindex,
const double * __covars,
double t )

Measurement model likelihood (dmeasure).

Definition at line 637 of file twospecies_pomp.c.

650 {
651 assert(!ISNAN(ll));
652 lik = (give_log) ? ll : exp(ll);
653}
#define lik
Definition lbdp_pomp.c:160
#define ll
Definition lbdp_pomp.c:9

◆ twospecies_gill()

void twospecies_gill ( double * __x,
const double * __p,
const int * __stateindex,
const int * __parindex,
const int * __covindex,
const double * __covars,
double t,
double dt )

Simulator for the latent-state process (rprocess).

This is the Gillespie algorithm applied to the solution of the filter equation for the TwoSpecies model. It advances the state from time t to time t+dt.

A tricky aspect of this function is that it must return a "valid" state even when the state is incompatible with the genealogy. In such a case, we set the log likelihood (ll) to R_NegInf, but the state must remain valid. Hence insertion of extra infectives, etc.

FIXME: At the moment, the following codes exclude the possibility of importation of infection.

Definition at line 290 of file twospecies_pomp.c.

300 {
301 double tstep = 0.0, tmax = t + dt;
302 double *color = &COLOR;
303 const int nsample = *get_userdata_int("nsample");
304 const int *nodetype = get_userdata_int("nodetype");
305 const int *nodedeme = get_userdata_int("deme");
306 const int *lineage = get_userdata_int("lineage");
307 const int *sat = get_userdata_int("saturation");
308 const int *index = get_userdata_int("index");
309 const int *child = get_userdata_int("child");
310
311 int parent = (int) nearbyint(node);
312
313#ifndef NDEBUG
314 int nnode = *get_userdata_int("nnode");
315 assert(parent>=0);
316 assert(parent<=nnode);
317#endif
318
319 int parlin = lineage[parent];
320 int parcol = color[parlin];
321 int deme = nodedeme[parent];
322 assert(parlin >= 0 && parlin < nsample);
323 assert(nearbyint(N1)==nearbyint(S1+I1+R1));
324 assert(nearbyint(N2)==nearbyint(S2+I2+R2));
325 assert(check_color(color,nsample,ell1,ell2));
326
327 ll = 0;
328
329 // singular portion of filter equation
330 switch (nodetype[parent]) {
331 default: // non-genealogical event
332 break;
333 case 0: // root
334 // color lineages by sampling without replacement
335 assert(sat[parent]==1);
336 int c = child[index[parent]];
337 assert(parlin==lineage[c]);
338 if (I1-ell1+I2-ell2 > 0) {
339 double x = (I1-ell1)/(I1-ell1 + I2-ell2);
340 if (unif_rand() < x) { // lineage is put into I1 deme
341 color[lineage[c]] = host1;
342 ell1 += 1;
343 ll -= log(x);
344 } else { // lineage is put into I2 deme
345 color[lineage[c]] = host2;
346 ell2 += 1;
347 ll -= log(1-x);
348 }
349 } else { // more roots than infectives
350 ll += R_NegInf; // this is incompatible with the genealogy
351 // the following keeps the state valid
352 if (unif_rand() < 0.5) { // lineage is put into I1 deme
353 color[lineage[c]] = host1;
354 ell1 += 1; I1 += 1; N1 += 1;
355 } else { // lineage is put into I2 deme
356 color[lineage[c]] = host2;
357 ell2 += 1; I2 += 1; N2 += 1;
358 }
359 }
360 assert(nearbyint(N1)==nearbyint(S1+I1+R1));
361 assert(nearbyint(N2)==nearbyint(S2+I2+R2));
362 assert(check_color(color,nsample,ell1,ell2));
363 break;
364 case 1: // sample
365 if (parcol != deme) { // parent color does not match the observed deme
366 ll += R_NegInf;
367 }
368 if (sat[parent] == 0) { // s=(0,0)
369 if (parcol == host1) {
370 ell1 -= 1;
371 if (C1 < 1 && unif_rand() > C1) {
372 ll += log(psi1*(I1-ell1));
373 } else {
374 ll += log(psi1*I1);
375 I1 -= 1; N1 -= 1;
376 }
377 } else if (parcol == host2) {
378 ell2 -= 1;
379 if (C2 < 1 && unif_rand() > C2) {
380 ll += log(psi2*(I2-ell2));
381 } else {
382 ll += log(psi2*I2);
383 I2 -= 1; N2 -= 1;
384 }
385 } else {
386 assert(0); // #nocov
387 ll += R_NegInf; // #nocov
388 }
389 } else if (sat[parent] == 1) {
390 int c = child[index[parent]];
391 color[lineage[c]] = parcol;
392 if (parcol==host1) {
393 ll += log(psi1*(1-C1)); // s=(1,0)
394 } else if (parcol==host2) {
395 ll += log(psi2*(1-C2)); // s=(0,1)
396 } else {
397 assert(0); // #nocov
398 ll += R_NegInf; // #nocov
399 }
400 } else {
401 assert(0); // #nocov
402 ll += R_NegInf; // #nocov
403 }
404 color[parlin] = R_NaReal;
405 assert(nearbyint(N1)==nearbyint(S1+I1+R1));
406 assert(nearbyint(N2)==nearbyint(S2+I2+R2));
407 assert(check_color(color,nsample,ell1,ell2));
408 break;
409 case 2: // branch point
410 assert(sat[parent]==2);
411 if (parcol == host1) { // parent is in I1
412 assert(S1>=0 && S2 >=0 && I1>=ell1 && ell1>=0);
413 double lambda11 = Beta11*S1*I1/N1;
414 double lambda21 = Beta21*S2*I1/N1;
415 double lambda = lambda11+lambda21;
416 double x = (lambda > 0) ? lambda11/lambda : 0;
417 int c1 = child[index[parent]];
418 int c2 = child[index[parent]+1];
419 assert(c1 != c2);
420 assert(lineage[c1] != lineage[c2]);
421 assert(lineage[c1] != parlin || lineage[c2] != parlin);
422 assert(lineage[c1] == parlin || lineage[c2] == parlin);
423 if (unif_rand() < x) { // s = (2,0)
424 color[lineage[c1]] = host1;
425 color[lineage[c2]] = host1;
426 if (S1 > 0) {
427 S1 -= 1; I1 += 1; ell1 += 1;
428 ll += log(lambda)-log(I1*(I1-1)/2);
429 } else {
430 // the genealogy is incompatible with the state.
431 // nevertheless, the state remains valid.
432 I1 += 1; N1 += 1; ell1 += 1;
433 ll += R_NegInf;
434 }
435 } else { // s = (1,1)
436 if (unif_rand() < 0.5) {
437 color[lineage[c1]] = host1;
438 color[lineage[c2]] = host2;
439 } else {
440 color[lineage[c1]] = host2;
441 color[lineage[c2]] = host1;
442 }
443 ll -= log(0.5);
444 if (S2 > 0) {
445 S2 -= 1; I2 += 1; ell2 += 1;
446 ll += log(lambda)-log(I1*I2);
447 } else {
448 // the genealogy is incompatible with the state.
449 // nevertheless, the state remains valid.
450 I2 += 1; N2 += 1; ell2 += 1;
451 ll += R_NegInf;
452 }
453 }
454 } else if (parcol == host2) { // parent is in I2
455 assert(S1>=0 && S2 >=0 && I2>=ell2);
456 double lambda12 = Beta12*S1*I2/N2;
457 double lambda22 = Beta22*S2*I2/N2;
458 double lambda = lambda12+lambda22;
459 double x = (lambda > 0) ? lambda22/lambda : 0;
460 int c1 = child[index[parent]];
461 int c2 = child[index[parent]+1];
462 assert(c1 != c2);
463 assert(lineage[c1] != lineage[c2]);
464 assert(lineage[c1] != parlin || lineage[c2] != parlin);
465 assert(lineage[c1] == parlin || lineage[c2] == parlin);
466 if (unif_rand() < x) { // s = (0,2)
467 color[lineage[c1]] = host2;
468 color[lineage[c2]] = host2;
469 if (S2 > 0) {
470 S2 -= 1; I2 += 1; ell2 += 1;
471 ll += log(lambda)-log(I2*(I2-1)/2);
472 } else {
473 // the genealogy is incompatible with the state.
474 // nevertheless, the state remains valid.
475 I2 += 1; N2 += 1; ell2 += 1;
476 ll += R_NegInf;
477 }
478 } else { // s = (1,1)
479 if (unif_rand() < 0.5) {
480 color[lineage[c1]] = host1;
481 color[lineage[c2]] = host2;
482 } else {
483 color[lineage[c1]] = host2;
484 color[lineage[c2]] = host1;
485 }
486 ll -= log(0.5);
487 if (S1 > 0) {
488 S1 -= 1; I1 += 1; ell1 += 1;
489 ll += log(lambda)-log(I1*I2);
490 } else {
491 // the genealogy is incompatible with the state.
492 // nevertheless, the state remains valid.
493 I1 += 1; N1 += 1; ell1 += 1;
494 ll += R_NegInf;
495 }
496 }
497 } else {
498 assert(0); // #nocov
499 ll += R_NegInf; // #nocov
500 }
501 assert(nearbyint(N1)==nearbyint(S1+I1+R1));
502 assert(nearbyint(N2)==nearbyint(S2+I2+R2));
503 assert(check_color(color,nsample,ell1,ell2));
504 break;
505 }
506
507 // continuous portion of filter equation:
508 // take Gillespie steps to the end of the interval.
509 if (tmax > t) {
510
511 double rate[nrate], logpi[nrate];
512 int event;
513 double event_rate = 0;
514 double penalty = 0;
515
516 event_rate = EVENT_RATES;
517 tstep = exp_rand()/event_rate;
518
519 while (t + tstep < tmax) {
520 event = rcateg(event_rate,rate,nrate);
521 assert(event>=0 && event<nrate);
522 ll -= penalty*tstep + logpi[event];
523 switch (event) {
524 case 0: // 0: Trans_11, s = (0,0),(1,0)
525 assert(S1>=1 && I1>=0);
526 S1 -= 1; I1 += 1;
527 break;
528 case 1: // 1: Trans_22, s = (0,0),(0,1)
529 assert(S2>=1 && I2>=0);
530 S2 -= 1; I2 += 1;
531 break;
532 case 2: // 2: Trans_21, s = (0,0),(1,0)
533 assert(S2>=1 && I1>=0);
534 S2 -= 1; I2 += 1;
535 ll += log(1-ell2/I2);
536 assert(!ISNAN(ll));
537 break;
538 case 3: // 3: Trans_21, s = (0,1)
539 assert(S2>=1 && I1>=0);
540 S2 -= 1; I2 += 1;
542 ell1 -= 1; ell2 += 1;
543 ll += log(1-ell1/I1)-log(I2);
544 assert(check_color(color,nsample,ell1,ell2));
545 assert(!ISNAN(ll));
546 break;
547 case 4: // 4: Trans_12, s = (0,0),(0,1)
548 assert(S1>=1 && I2>=0);
549 S1 -= 1; I1 += 1;
550 ll += log(1-ell1/I1);
551 assert(!ISNAN(ll));
552 break;
553 case 5: // 5: Trans_12, s = (1,0)
554 assert(S1>=1 && I2>=0);
555 S1 -= 1; I1 += 1;
557 ell2 -= 1; ell1 += 1;
558 ll += log(1-ell2/I2)-log(I1);
559 assert(check_color(color,nsample,ell1,ell2));
560 assert(!ISNAN(ll));
561 break;
562 case 6: // 6: Recov_1
563 assert(I1>=1);
564 I1 -= 1; R1 += 1;
565 break;
566 case 7: // 7: Recov_2
567 assert(I2>=1);
568 I2 -= 1; R2 += 1;
569 break;
570 case 8: // 8: Wane_1
571 assert(R1>=1);
572 R1 -= 1; S1 += 1;
573 break;
574 case 9: // 9: Wane_2
575 assert(R2>=1);
576 R2 -= 1; S2 += 1;
577 break;
578 case 10: // 10: Birth_1
579 assert(N1>=1);
580 S1 += 1; N1 += 1;
581 break;
582 case 11: // 11: Birth_2
583 assert(N2>=1);
584 S2 += 1; N2 += 1;
585 break;
586 case 12: // 12: Death_S1
587 assert(S1>=1 && N1>=1);
588 S1 -= 1; N1 -= 1;
589 break;
590 case 13: // 13: Death_I1
591 assert(I1>=1 && N1>=1);
592 I1 -= 1; N1 -= 1;
593 break;
594 case 14: // 14: Death_R1
595 assert(R1>=1 && N1>=1);
596 R1 -= 1; N1 -= 1;
597 break;
598 case 15: // 15: Death_S2
599 assert(S2>=1 && N2>=1);
600 S2 -= 1; N2 -= 1;
601 break;
602 case 16: // 16: Death_I2
603 assert(I2>=1 && N2>=1);
604 I2 -= 1; N2 -= 1;
605 break;
606 case 17: // 17: Death_R2
607 assert(R2>=1 && N2>=1);
608 R2 -= 1; N2 -= 1;
609 break;
610 default: // #nocov
611 assert(0); // #nocov
612 ll += R_NegInf; // #nocov
613 break; // #nocov
614 }
615
616 ell1 = nearbyint(ell1);
617 ell2 = nearbyint(ell2);
618
619 assert(nearbyint(N1)==nearbyint(S1+I1+R1));
620 assert(nearbyint(N2)==nearbyint(S2+I2+R2));
621 assert(check_color(color,nsample,ell1,ell2));
622
623 t += tstep;
624 event_rate = EVENT_RATES;
625 tstep = exp_rand()/event_rate;
626
627 }
628 tstep = tmax - t;
629 ll -= penalty*tstep;
630 }
631 node += 1;
632}
get_userdata_int_t * get_userdata_int
Definition init.c:7
static int rcateg(double erate, double *rate, int nrate)
Definition internal.h:76
static const int deme
Definition lbdp.cc:7
#define lambda
Definition lbdp_pomp.c:4
#define EVENT_RATES
Definition lbdp_pomp.c:13
#define node
Definition lbdp_pomp.c:11
#define COLOR
Definition seirs_pomp.c:41
static const int nrate
Definition seirs_pomp.c:4
static void change_color(double *color, int nsample, int n, int from, int to)
static int check_color(double *color, int nsample, double size1, double size2)
#define C1
static int random_choice(double n)
#define C2
Here is the call graph for this function:

◆ twospecies_rinit()

void twospecies_rinit ( double * __x,
const double * __p,
double t0,
const int * __stateindex,
const int * __parindex,
const int * __covindex,
const double * __covars )

Latent-state initializer (rinit component).

The state variables include S, E, I, R plus 'ellE' and 'ellI' (numbers of E- and I-deme lineages), the accumulated weight ('ll'), the current node number ('node'), and the coloring of each lineage ('COLOR').

Definition at line 249 of file twospecies_pomp.c.

258 {
259 double adj;
260 N1 = S1_0+I1_0+R1_0;
261 N2 = S2_0+I2_0+R2_0;
262 adj = N1/(S1_0+I1_0+R1_0);
263 S1 = nearbyint(S1_0*adj);
264 I1 = nearbyint(I1_0*adj);
265 R1 = N1-S1-I1;
266 adj = N2/(S2_0+I2_0+R2_0);
267 S2 = nearbyint(S2_0*adj);
268 I2 = nearbyint(I2_0*adj);
269 R2 = N2-S2-I2;
270 ell1 = 0;
271 ell2 = 0;
272 ll = 0;
273 node = 0;
274}
#define I2_0
#define I1_0
#define S2_0
#define S1_0
#define R2_0
#define R1_0

Variable Documentation

◆ nrate

const int nrate = 18
static

Definition at line 4 of file twospecies_pomp.c.