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

Go to the source code of this file.

Macros

#define Exposed   1
 
#define Infected   2
 
#define sigma   (__p[__parindex[0]])
 
#define lambda   (__p[__parindex[1]])
 
#define mu   (__p[__parindex[2]])
 
#define chi   (__p[__parindex[3]])
 
#define POP   (__p[__parindex[4]])
 
#define E0   (__p[__parindex[5]])
 
#define I0   (__p[__parindex[6]])
 
#define E   (__x[__stateindex[0]])
 
#define I   (__x[__stateindex[1]])
 
#define ll   (__x[__stateindex[2]])
 
#define node   (__x[__stateindex[3]])
 
#define ellE   (__x[__stateindex[4]])
 
#define ellI   (__x[__stateindex[5]])
 
#define COLOR   (__x[__stateindex[6]])
 
#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 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 bdei_rinit (double *__x, const double *__p, double t0, const int *__stateindex, const int *__parindex, const int *__covindex, const double *__covars)
 
void bdei_gill (double *__x, const double *__p, const int *__stateindex, const int *__parindex, const int *__covindex, const double *__covars, double t, double dt)
 
void bdei_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 = 5
 

Macro Definition Documentation

◆ chi

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

Definition at line 29 of file bdei_pomp.c.

◆ COLOR

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

Definition at line 39 of file bdei_pomp.c.

◆ E

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

Definition at line 33 of file bdei_pomp.c.

◆ E0

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

Definition at line 31 of file bdei_pomp.c.

◆ ellE

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

Definition at line 37 of file bdei_pomp.c.

◆ ellI

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

Definition at line 38 of file bdei_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, const int *__covindex, const double *__covars, double *rate, double *logpi, double *penalty)
Definition bdei_pomp.c:47

Definition at line 41 of file bdei_pomp.c.

41#define EVENT_RATES \
42 event_rates(__x,__p,t, \
43 __stateindex,__parindex,__covindex, \
44 __covars,rate,logpi,&penalty) \
45

◆ Exposed

#define Exposed   1

Definition at line 4 of file bdei_pomp.c.

◆ I

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

Definition at line 34 of file bdei_pomp.c.

◆ I0

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

Definition at line 32 of file bdei_pomp.c.

◆ Infected

#define Infected   2

Definition at line 5 of file bdei_pomp.c.

◆ lambda

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

Definition at line 27 of file bdei_pomp.c.

◆ lik

#define lik   (__lik[0])

Definition at line 317 of file bdei_pomp.c.

◆ ll

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

Definition at line 35 of file bdei_pomp.c.

◆ mu

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

Definition at line 28 of file bdei_pomp.c.

◆ node

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

Definition at line 36 of file bdei_pomp.c.

◆ POP

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

Definition at line 30 of file bdei_pomp.c.

◆ sigma

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

Definition at line 26 of file bdei_pomp.c.

Function Documentation

◆ bdei_dmeas()

void bdei_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 320 of file bdei_pomp.c.

333 {
334 assert(!ISNAN(ll));
335 lik = (give_log) ? ll : exp(ll);
336}
#define lik
Definition bdei_pomp.c:317
#define ll
Definition bdei_pomp.c:35

◆ bdei_gill()

void bdei_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 BDEI process.

Definition at line 138 of file bdei_pomp.c.

148 {
149 double tstep = 0.0, tmax = t + dt;
150 double *color = &COLOR;
151 const int nsample = *get_userdata_int("nsample");
152 const int *nodetype = get_userdata_int("nodetype");
153 const int *lineage = get_userdata_int("lineage");
154 const int *sat = get_userdata_int("saturation");
155 const int *index = get_userdata_int("index");
156 const int *child = get_userdata_int("child");
157
158 int parent = (int) nearbyint(node);
159
160#ifndef NDEBUG
161 int nnode = *get_userdata_int("nnode");
162 assert(parent>=0);
163 assert(parent<=nnode);
164#endif
165
166 int parlin = lineage[parent];
167 int parcol = color[parlin];
168 assert(parlin >= 0 && parlin < nsample);
169
170 ll = 0;
171
172 // singular portion of filter equation
173 switch (nodetype[parent]) {
174 default:
175 break;
176 case 0: // root
177 assert(sat[parent]==1);
178 {
179 int c = child[index[parent]];
180 assert(lineage[parent]==lineage[c]);
181 if (E-ellE + I-ellI > 0) {
182 double x = (E-ellE)/(E-ellE + I-ellI);
183 if (unif_rand() < x) {
184 color[lineage[c]] = Exposed;
185 ellE += 1;
186 ll -= log(x);
187 } else {
188 color[lineage[c]] = Infected;
189 ellI += 1;
190 ll -= log(1-x);
191 }
192 } else {
193 ll += R_NegInf;
194 if (unif_rand() < 0.5) {
195 color[lineage[c]] = Exposed;
196 ellE += 1; E += 1;
197 } else {
198 color[lineage[c]] = Infected;
199 ellI += 1; I += 1;
200 }
201 }
202 }
203 break;
204 case 1: // sample
205 if (parcol != Infected) {
206 ll += R_NegInf;
207 color[parlin] = Infected;
208 ellE -= 1; ellI += 1;
209 E -= 1; I += 1;
210 }
211 if (sat[parent] == 0) { // destructive sample
212 ellI -= 1;
213 ll += (I > 0) ? log(chi*I) : R_NegInf;
214 I -= 1;
215 } else {
216 assert(0); // #nocov
217 ll += R_NegInf; // #nocov
218 }
219 color[parlin] = R_NaReal;
220 break;
221 case 2: // branch point: I births E
222 if (parcol != Infected) {
223 ll += R_NegInf;
224 color[parlin] = Infected;
225 ellE -= 1; ellI += 1;
226 E -= 1; I += 1;
227 }
228 assert(sat[parent]==2);
229 ll += (I > 0) ? log(lambda/(E+1)) : R_NegInf;
230 E += 1;
231 ellE += 1;
232 {
233 int c1 = child[index[parent]];
234 int c2 = child[index[parent]+1];
235 assert(c1 != c2);
236 assert(lineage[c1] != lineage[c2]);
237 assert(lineage[c1] != parlin || lineage[c2] != parlin);
238 assert(lineage[c1] == parlin || lineage[c2] == parlin);
239 if (unif_rand() < 0.5) {
240 color[lineage[c1]] = Exposed;
241 color[lineage[c2]] = Infected;
242 } else {
243 color[lineage[c1]] = Infected;
244 color[lineage[c2]] = Exposed;
245 }
246 ll -= log(0.5);
247 }
248 break;
249 }
250
251 // regular portion of filter equation
252 if (tmax > t && R_FINITE(ll)) {
253
254 double rate[nrate], logpi[nrate];
255 int event;
256 double event_rate = 0;
257 double penalty = 0;
258
259 event_rate = EVENT_RATES;
260 tstep = exp_rand()/event_rate;
261
262 while (t + tstep < tmax) {
263 event = rcateg(event_rate,rate,nrate);
264 assert(event>=0 && event<nrate);
265 ll -= penalty*tstep + logpi[event];
266 switch (event) {
267 case 0: // birth, s=(0,0) or s=(0,1)
268 E += 1;
269 ll += log(1-ellE/E);
270 assert(!ISNAN(ll));
271 break;
272 case 1: // birth, s=(1,0)
274 ellE += 1; ellI -= 1;
275 E += 1;
276 ll += log(1-ellI/I)-log(E);
277 assert(!ISNAN(ll));
278 break;
279 case 2: // progression, s=(0,0)
280 assert(E>=1);
281 E -= 1; I += 1;
282 ll += log(1-ellI/I);
283 assert(!ISNAN(ll));
284 break;
285 case 3: // progression, s=(0,1)
286 assert(E>=1);
288 ellE -= 1; ellI += 1;
289 E -= 1; I += 1;
290 ll -= log(I);
291 assert(!ISNAN(ll));
292 break;
293 case 4: // death
294 assert(I>=1);
295 I -= 1;
296 assert(!ISNAN(ll));
297 break;
298 default: // #nocov
299 assert(0); // #nocov
300 break; // #nocov
301 }
302
303 ellE = nearbyint(ellE);
304 ellI = nearbyint(ellI);
305
306 t += tstep;
307 event_rate = EVENT_RATES;
308 tstep = exp_rand()/event_rate;
309
310 }
311 tstep = tmax - t;
312 ll -= penalty*tstep;
313 }
314 node += 1;
315}
#define ellE
Definition bdei_pomp.c:37
#define E
Definition bdei_pomp.c:33
static void change_color(double *color, int nsample, int n, int from, int to)
Definition bdei_pomp.c:13
#define COLOR
Definition bdei_pomp.c:39
static int random_choice(double n)
Definition bdei_pomp.c:9
#define I
Definition bdei_pomp.c:34
#define ellI
Definition bdei_pomp.c:38
#define chi
Definition bdei_pomp.c:29
static const int nrate
Definition bdei_pomp.c:7
#define Infected
Definition bdei_pomp.c:5
#define lambda
Definition bdei_pomp.c:27
#define Exposed
Definition bdei_pomp.c:4
#define EVENT_RATES
Definition bdei_pomp.c:41
#define node
Definition bdei_pomp.c:36
SEXP nsample(TYPE &X)
Definition generics.h:12
get_userdata_int_t * get_userdata_int
Definition init.c:7
static int rcateg(double erate, double *rate, int nrate)
Definition internal.h:85
Here is the call graph for this function:

◆ bdei_rinit()

void bdei_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 E, I 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 106 of file bdei_pomp.c.

115 {
116 if (!R_FINITE(sigma) || sigma < 0 ||
117 !R_FINITE(lambda) || lambda < 0 ||
118 !R_FINITE(mu) || mu < 0 || !R_FINITE(chi) || chi < 0)
119 err("BDEI rates must be finite and nonnegative.");
120 if (!R_FINITE(POP) || POP < 0 ||
121 !R_FINITE(E0) || E0 < 0 || !R_FINITE(I0) || I0 < 0 ||
122 !R_FINITE(E0+I0) || E0+I0 <= 0)
123 err("BDEI initial values must be finite and nonnegative, with E0+I0 > 0.");
124 double adj = POP/(E0+I0);
125 if (!R_FINITE(adj)) err("BDEI: pop/(E0+I0) must be finite.");
126 E = nearbyint(E0*adj);
127 I = nearbyint(I0*adj);
128 ellE = 0;
129 ellI = 0;
130 ll = 0;
131 node = 0;
132}
#define POP
Definition bdei_pomp.c:30
#define mu
Definition bdei_pomp.c:28
#define sigma
Definition bdei_pomp.c:26
#define I0
Definition bdei_pomp.c:32
#define E0
Definition bdei_pomp.c:31
#define err(...)
Definition internal.h:18

◆ change_color()

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

Definition at line 13 of file bdei_pomp.c.

14 {
15 int i = -1;
16 while (n >= 0 && i < nsample) {
17 i++;
18 if (!ISNA(color[i]) && nearbyint(color[i]) == from) n--;
19 }
20 assert(i < nsample);
21 assert(n == -1);
22 assert(nearbyint(color[i]) == from);
23 color[i] = to;
24}
#define n
Definition lbdp_pomp.c:9
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 46 of file bdei_pomp.c.

58 {
59 double event_rate = 0;
60 double alpha, pi;
61 *penalty = 0;
62 // 0: birth, s=(0,0) or s=(0,1)
63 assert(I >= ellI);
64 assert(ellI >= 0);
65 alpha = lambda*I;
66 pi = 1/(ellI+1);
67 event_rate += (*rate = alpha*pi); rate++;
68 *logpi = log(pi); logpi++;
69 // 1: birth, s=(1,0)
70 pi = ellI/(ellI+1);
71 event_rate += (*rate = alpha*pi); rate++;
72 *logpi = (ellI > 0) ? -log(ellI+1) : 0; logpi++;
73 // 2: progression, s=(0,0)
74 assert(E >= ellE);
75 assert(ellE >= 0);
76 alpha = sigma*E;
77 pi = (E > 0) ? 1-ellE/E : 1;
78 event_rate += (*rate = alpha*pi); rate++;
79 *logpi = log(pi); logpi++;
80 // 3: progression, s=(0,1)
81 pi = 1-pi;
82 event_rate += (*rate = alpha*pi); rate++;
83 *logpi = (ellE > 0) ? log(pi)-log(ellE) : 0; logpi++;
84 // 4: death
85 alpha = mu*I;
86 if (I > ellI) {
87 event_rate += (*rate = alpha); rate++;
88 *logpi = 0; logpi++;
89 } else {
90 *rate = 0; rate++;
91 *logpi = 0; logpi++;
92 *penalty += alpha;
93 }
94 // sampling (Q = 0): destructive only
95 *penalty += chi*I;
96 assert(R_FINITE(event_rate));
97 return event_rate;
98}
Here is the caller graph for this function:

◆ random_choice()

static int random_choice ( double n)
inlinestatic

Definition at line 9 of file bdei_pomp.c.

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

Variable Documentation

◆ nrate

const int nrate = 5
static

Definition at line 7 of file bdei_pomp.c.