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

Go to the source code of this file.

Functions

SEXP parse_newick (SEXP, SEXP, SEXP)
 
SEXP getInfo (SEXP)
 
SEXP genealSum (SEXP)
 combine genealogies
 
SEXP curtail (SEXP, SEXP, SEXP)
 curtail the given genealogy
 
SEXP yaml (SEXP)
 extract a YAML description
 
SEXP gendat (SEXP, SEXP)
 data-frame format
 
SEXP geneal (SEXP)
 extract the bare genealogy
 
SEXP genealScaleShift (SEXP, SEXP, SEXP)
 rescale and/or reset origin
 
SEXP cblv (SEXP)
 construct CBLV representation as a matrix
 
SEXP parse_cblv (SEXP, SEXP, SEXP)
 parse CBLV representation
 
 DECLARATIONS (BDEI)
 
 DECLARATIONS (BDSS)
 
 DECLARATIONS (LBDP)
 
 DECLARATIONS (MERS)
 
 DECLARATIONS (Moran)
 
 DECLARATIONS (S2I2R2)
 
 DECLARATIONS (SEIR)
 
 DECLARATIONS (SI2R)
 
 DECLARATIONS (SIIR)
 
 DECLARATIONS (SIR)
 
 DECLARATIONS (Strains)
 
 DECLARATIONS (TwoSpecies)
 
 DECLARATIONS (TwoUndead)
 
void R_init_phylopomp (DllInfo *info)
 

Variables

get_userdata_t * get_userdata
 
get_userdata_double_t * get_userdata_double
 
get_userdata_int_t * get_userdata_int
 
static const R_CallMethodDef callMethods []
 
static const R_CallMethodDef extMethods []
 

Function Documentation

◆ cblv()

SEXP cblv ( SEXP State)

construct CBLV representation as a matrix

Definition at line 174 of file cblv.cc.

174 {
175 genealogy_t A = State;
176 return cblv(A);
177 }
SEXP cblv(genealogy_t &A)
Definition cblv.cc:151
Encodes a genealogy.
Definition genealogy.h:20
Here is the call graph for this function:

◆ curtail()

SEXP curtail ( SEXP State,
SEXP Time,
SEXP Troot )

curtail the given genealogy

Definition at line 89 of file curtail.cc.

89 {
90 genealogy_t A = State;
91 double t, t0;
92 t = *REAL(AS_NUMERIC(Time));
93 t0 = *REAL(AS_NUMERIC(Troot));
94 if (ISNA(t)) t = A.time();
95 if (ISNA(t0)) t0 = A.timezero();
96 A.curtail(t,t0);
97 SEXP out;
98 PROTECT(out = serial(A));
99 SET_ATTR(out,install("class"),mkString("gpgen"));
100 UNPROTECT(1);
101 return out;
102 }
slate_t & timezero(void)
view/set zero time.
Definition genealogy.h:154
slate_t & time(void)
view/set current time.
Definition genealogy.h:146
void curtail(slate_t tnew, slate_t troot)
Definition curtail.cc:12
SEXP serial(const TYPE &X)
binary serialization
Definition generics.h:33
Here is the call graph for this function:

◆ DECLARATIONS() [1/13]

DECLARATIONS ( BDEI )

◆ DECLARATIONS() [2/13]

DECLARATIONS ( BDSS )

◆ DECLARATIONS() [3/13]

DECLARATIONS ( LBDP )

◆ DECLARATIONS() [4/13]

DECLARATIONS ( MERS )

◆ DECLARATIONS() [5/13]

DECLARATIONS ( Moran )

◆ DECLARATIONS() [6/13]

DECLARATIONS ( S2I2R2 )

◆ DECLARATIONS() [7/13]

DECLARATIONS ( SEIR )

◆ DECLARATIONS() [8/13]

DECLARATIONS ( SI2R )

◆ DECLARATIONS() [9/13]

DECLARATIONS ( SIIR )

◆ DECLARATIONS() [10/13]

DECLARATIONS ( SIR )

◆ DECLARATIONS() [11/13]

DECLARATIONS ( Strains )

◆ DECLARATIONS() [12/13]

DECLARATIONS ( TwoSpecies )

◆ DECLARATIONS() [13/13]

DECLARATIONS ( TwoUndead )

◆ gendat()

SEXP gendat ( SEXP State,
SEXP Obscure )

data-frame format

Definition at line 104 of file gendat.cc.

104 {
105 genealogy_t A = State;
106 A.prune();
107 if (*LOGICAL(Obscure)) A.obscure();
108 A.trace_lineages();
109 return A.gendat();
110 }
genealogy_t & prune(void)
prune the tree (drop all black balls)
Definition genealogy.h:311
void gendat(double *tout, int *anc, int *lin, int *sat, int *type, int *deme, int *index, int *child) const
genealogy information in list format
Definition gendat.cc:9
genealogy_t & obscure(void)
erase all deme information
Definition genealogy.h:322
void trace_lineages(void)
Definition nodeseq.h:309
Here is the call graph for this function:
Here is the caller graph for this function:

◆ geneal()

SEXP geneal ( SEXP State)

extract the bare genealogy

Definition at line 11 of file geneal.cc.

11 {
12 SEXP S;
13 PROTECT(S = serial(genealogy_t(State)));
14 SET_ATTR(S,install("class"),mkString("gpgen"));
15 UNPROTECT(1);
16 return S;
17 }
#define S
Definition seirs_pomp.c:38
Here is the call graph for this function:

◆ genealScaleShift()

SEXP genealScaleShift ( SEXP State,
SEXP Scale,
SEXP Origin )

rescale and/or reset origin

Definition at line 11 of file scale.cc.

11 {
12 genealogy_t A(State);
13 slate_t scale = *REAL(AS_NUMERIC(Scale));
14 slate_t origin = *REAL(AS_NUMERIC(Origin));
15 SEXP S;
16 A.time_rescale(scale,origin);
17 PROTECT(S = serial(A));
18 SET_ATTR(S,install("class"),mkString("gpgen"));
19 UNPROTECT(1);
20 return S;
21 }
double slate_t
Definition internal.h:53
Here is the call graph for this function:

◆ genealSum()

SEXP genealSum ( SEXP args)

combine genealogies

Definition at line 49 of file sum.cc.

49 {
50 args = CDR(args);
51 genealogy_t A(R_PosInf); // a "null" genealogy
52 A.time() = R_NegInf;
53 while (args != R_NilValue) {
54 A += CAR(args);
55 args = CDR(args);
56 }
57 SEXP S;
58 PROTECT(S = serial(A));
59 SET_ATTR(S,install("class"),mkString("gpgen"));
60 UNPROTECT(1);
61 return S;
62 }
Here is the call graph for this function:

◆ getInfo()

SEXP getInfo ( SEXP args)

extract requested information prune and/or obscure if requested

Definition at line 19 of file getinfo.cc.

19 {
20 const char *argname[] = {
21 "object","prune","obscure","extended",
22 "t0","time","nsample","nroot","ndeme",
23 "structure","yaml","newick",
24 "lineages","gendat","genealogy","cblv"};
25 const int narg = sizeof(argname)/sizeof(const char *);
26 bool flag[narg];
27 SEXP object = R_NilValue;
28 size_t nout = 0;
29 int k;
30
31 for (k = 0; k < narg; k++) flag[k] = false;
32 args = CDR(args);
33
34 while (args != R_NilValue) {
35 const char *name = isNull(TAG(args)) ? "" : CHAR(PRINTNAME(TAG(args)));
36 SEXP arg = CAR(args);
37 size_t j = matchargs(name,argname,narg);
38 if (j == 0) {
39 object = arg;
40 flag[0] = true;
41 } else if (j < narg) {
42 flag[j] = *LOGICAL(AS_LOGICAL(arg));
43 if (j > 3 && flag[j]) nout++;
44 } else {
45 err("unrecognized argument '%s' in '%s'.",name,__func__);
46 }
47 args = CDR(args);
48 }
49
50 if (!flag[0]) err("no genealogy furnished to '%s'",__func__);
51 genealogy_t A = object;
52
53 // prune and/or obscure if requested
54 const bool *f = flag+1;
55 if (*(f++)) A.prune();
56 if (*(f++)) A.obscure();
58 bool extended = false;
59 if (*(f++)) {
60 extended = true;
61 } else {
62 A.insert_zlb();
63 }
64
65 SEXP out, outnames;
66 PROTECT(out = NEW_LIST(nout));
67 PROTECT(outnames = NEW_CHARACTER(nout));
68 k = 0;
69 if (*(f++)) { // t0
70 k = set_list_elem(out,outnames,timezero(A),"t0",k);
71 }
72 if (*(f++)) { // time
73 k = set_list_elem(out,outnames,time(A),"time",k);
74 }
75 if (*(f++)) { // nsample
76 k = set_list_elem(out,outnames,nsample(A),"nsample",k);
77 }
78 if (*(f++)) { // nroot
79 k = set_list_elem(out,outnames,nroot(A),"nroot",k);
80 }
81 if (*(f++)) { // ndeme
82 k = set_list_elem(out,outnames,ndeme(A),"ndeme",k);
83 }
84 if (*(f++)) { // structure
85 k = set_list_elem(out,outnames,structure(A),"structure",k);
86 }
87 if (*(f++)) { // yaml
88 k = set_list_elem(out,outnames,yaml(A),"yaml",k);
89 }
90 if (*(f++)) { // newick
91 k = set_list_elem(out,outnames,newick(A,extended),"newick",k);
92 }
93 if (*(f++)) { // lineages
94 k = set_list_elem(out,outnames,lineage_count(A),"lineages",k);
95 }
96 if (*(f++)) { // gendat
97 k = set_list_elem(out,outnames,gendat(A),"gendat",k);
98 }
99 if (*(f++)) { // genealogy
100 SEXP S;
101 PROTECT(S = serial(A));
102 SET_ATTR(S,install("class"),mkString("gpgen"));
103 k = set_list_elem(out,outnames,S,"genealogy",k);
104 UNPROTECT(1);
105 }
106 if (*(f++)) { // cblv
107 k = set_list_elem(out,outnames,cblv(A),"cblv",k);
108 }
109 SET_NAMES(out,outnames);
110 UNPROTECT(2);
111 return out;
112 }
genealogy_t & insert_zlb(void)
insert zero-length branches for samples where needed
Definition genealogy.h:359
SEXP gendat(SEXP State, SEXP Obscure)
data-frame format
Definition gendat.cc:104
SEXP ndeme(TYPE &X)
Definition generics.h:7
SEXP nroot(TYPE &X)
Definition generics.h:17
SEXP timezero(TYPE &X)
Definition generics.h:22
SEXP time(TYPE &X)
Definition generics.h:27
SEXP structure(const TYPE &X)
structure in R list format
Definition generics.h:49
SEXP yaml(const TYPE &X)
human/machine readable output
Definition generics.h:43
SEXP lineage_count(const TYPE &G)
number of lineages through time
Definition generics.h:61
SEXP nsample(TYPE &X)
Definition generics.h:12
SEXP newick(const TYPE &X, bool extended)
tree in newick format
Definition generics.h:55
static size_t matchargs(const char *prov, const char **set, size_t n)
Definition getinfo.cc:7
static int set_list_elem(SEXP list, SEXP names, SEXP element, const char *name, int pos)
Definition internal.h:76
#define err(...)
Definition internal.h:18
Here is the call graph for this function:

◆ parse_cblv()

SEXP parse_cblv ( SEXP XY,
SEXP T0,
SEXP Time )

parse CBLV representation

Definition at line 180 of file cblv.cc.

180 {
181 int *n = INTEGER(GET_DIM(XY));
182 if (n[1] != 2)
183 err("in 'parse_cblv': 'xy' must be a two-column matrix.");
184 double *xp = REAL(XY);
185 double *yp = xp+n[0];
186 double *t0 = REAL(T0);
187 double *time = REAL(Time);
188 genealogy_t A(*t0);
189 A.parse_cblv(xp,yp,*n,*time);
190 return serial(A);
191 }
#define n
Definition lbdp_pomp.c:9
Here is the call graph for this function:

◆ parse_newick()

SEXP parse_newick ( SEXP X,
SEXP T0,
SEXP Tf )

A parser for Newick code. Returns a genealogy in the phylopomp format.

Definition at line 264 of file parse.cc.

264 {
265 PROTECT(X = AS_CHARACTER(X));
266 PROTECT(T0 = AS_NUMERIC(T0));
267 PROTECT(Tf = AS_NUMERIC(Tf));
268 double t0 = *REAL(T0);
269 double tf = *REAL(Tf);
270 // parse the Newick representation into a genealogy:
271 string_t x = CHAR(STRING_ELT(X,0));
272 genealogy_t G(t0);
273 G.parse(x);
274 if (!ISNA(tf)) {
275 G.curtail(tf,t0);
276 }
277 G.trace_lineages();
278 UNPROTECT(3);
279 return serial(G);
280 }
Here is the call graph for this function:

◆ R_init_phylopomp()

void R_init_phylopomp ( DllInfo * info)

Definition at line 68 of file init.c.

68 {
69 // Register routines
70 R_registerRoutines(info,NULL,callMethods,NULL,extMethods);
71 R_useDynamicSymbols(info,TRUE);
72 // R_useDynamicSymbols(info,FALSE);
73 // R_forceSymbols(info,TRUE);
74 get_userdata = (get_userdata_t*) R_GetCCallable("pomp","get_userdata");
75 get_userdata_double = (get_userdata_double_t*) R_GetCCallable("pomp","get_userdata_double");
76 get_userdata_int = (get_userdata_int_t*) R_GetCCallable("pomp","get_userdata_int");
77}
static const R_CallMethodDef extMethods[]
Definition init.c:62
get_userdata_int_t * get_userdata_int
Definition init.c:7
static const R_CallMethodDef callMethods[]
Definition init.c:37
get_userdata_t * get_userdata
Definition init.c:5
get_userdata_double_t * get_userdata_double
Definition init.c:6

◆ yaml()

SEXP yaml ( SEXP State)

extract a YAML description

Definition at line 78 of file yaml.cc.

78 {
79 genealogy_t A = State;
80 return mkString(A.yaml().c_str());
81 }
string_t yaml(string_t tab="") const
human/machine-readable info
Definition yaml.cc:64
Here is the call graph for this function:

Variable Documentation

◆ callMethods

const R_CallMethodDef callMethods[]
static
Initial value:
= {
METHODS(BDEI),
METHODS(BDSS),
METHODS(LBDP),
METHODS(MERS),
METHODS(Moran),
METHODS(S2I2R2),
METHODS(SEIR),
METHODS(SI2R),
METHODS(SIIR),
METHODS(SIR),
METHODS(Strains),
METHODS(TwoSpecies),
METHODS(TwoUndead),
{"parse_newick", (DL_FUNC) &parse_newick, 3},
{"curtail", (DL_FUNC) &curtail, 3},
{"yaml", (DL_FUNC) &yaml, 1},
{"gendat", (DL_FUNC) &gendat, 2},
{"geneal", (DL_FUNC) &geneal, 1},
{"geneal_scale", (DL_FUNC) &genealScaleShift, 3},
{"cblv", (DL_FUNC) &cblv, 1},
{"parse_cblv", (DL_FUNC) &parse_cblv, 3},
{NULL, NULL, 0}
}
SEXP parse_cblv(SEXP XY, SEXP T0, SEXP Time)
parse CBLV representation
Definition cblv.cc:180
SEXP curtail(SEXP State, SEXP Time, SEXP Troot)
curtail the given genealogy
Definition curtail.cc:89
SEXP geneal(SEXP State)
extract the bare genealogy
Definition geneal.cc:11
SEXP parse_newick(SEXP, SEXP, SEXP)
Definition parse.cc:264
SEXP genealScaleShift(SEXP, SEXP, SEXP)
rescale and/or reset origin
Definition scale.cc:11
#define METHODS(X)
Definition init.h:13

Definition at line 37 of file init.c.

37 {
38 METHODS(BDEI),
39 METHODS(BDSS),
40 METHODS(LBDP),
41 METHODS(MERS),
42 METHODS(Moran),
43 METHODS(S2I2R2),
44 METHODS(SEIR),
45 METHODS(SI2R),
46 METHODS(SIIR),
47 METHODS(SIR),
48 METHODS(Strains),
49 METHODS(TwoSpecies),
50 METHODS(TwoUndead),
51 {"parse_newick", (DL_FUNC) &parse_newick, 3},
52 {"curtail", (DL_FUNC) &curtail, 3},
53 {"yaml", (DL_FUNC) &yaml, 1},
54 {"gendat", (DL_FUNC) &gendat, 2},
55 {"geneal", (DL_FUNC) &geneal, 1},
56 {"geneal_scale", (DL_FUNC) &genealScaleShift, 3},
57 {"cblv", (DL_FUNC) &cblv, 1},
58 {"parse_cblv", (DL_FUNC) &parse_cblv, 3},
59 {NULL, NULL, 0}
60};

◆ extMethods

const R_CallMethodDef extMethods[]
static
Initial value:
= {
{"getInfo", (DL_FUNC) &getInfo, -1},
{"genealSum", (DL_FUNC) &genealSum, -1},
{NULL, NULL, 0}
}
SEXP getInfo(SEXP args)
Definition getinfo.cc:19
SEXP genealSum(SEXP)
combine genealogies
Definition sum.cc:49

Definition at line 62 of file init.c.

62 {
63 {"getInfo", (DL_FUNC) &getInfo, -1},
64 {"genealSum", (DL_FUNC) &genealSum, -1},
65 {NULL, NULL, 0}
66};

◆ get_userdata

get_userdata_t* get_userdata

Definition at line 5 of file init.c.

◆ get_userdata_double

get_userdata_double_t* get_userdata_double

Definition at line 6 of file init.c.

◆ get_userdata_int

get_userdata_int_t* get_userdata_int

Definition at line 7 of file init.c.