phylopomp
Phylodynamics for POMPs
Loading...
Searching...
No Matches
Functions | Variables
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
 
 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

◆ 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 }
genealogy_t
Encodes a genealogy.
Definition genealogy.h:19
genealogy_t::timezero
slate_t & timezero(void)
view/set zero time.
Definition genealogy.h:153
genealogy_t::time
slate_t & time(void)
view/set current time.
Definition genealogy.h:145
genealogy_t::curtail
void curtail(slate_t tnew, slate_t troot)
Definition curtail.cc:12
serial
SEXP serial(const TYPE &X)
binary serialization
Definition generics.h:33
Here is the call graph for this function:

◆ DECLARATIONS() [1/11]

DECLARATIONS ( LBDP )

◆ DECLARATIONS() [2/11]

DECLARATIONS ( MERS )

◆ DECLARATIONS() [3/11]

DECLARATIONS ( Moran )

◆ DECLARATIONS() [4/11]

DECLARATIONS ( S2I2R2 )

◆ DECLARATIONS() [5/11]

DECLARATIONS ( SEIR )

◆ DECLARATIONS() [6/11]

DECLARATIONS ( SI2R )

◆ DECLARATIONS() [7/11]

DECLARATIONS ( SIIR )

◆ DECLARATIONS() [8/11]

DECLARATIONS ( SIR )

◆ DECLARATIONS() [9/11]

DECLARATIONS ( Strains )

◆ DECLARATIONS() [10/11]

DECLARATIONS ( TwoSpecies )

◆ DECLARATIONS() [11/11]

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
genealogy_t & prune(void)
prune the tree (drop all black balls)
Definition genealogy.h:310
genealogy_t::gendat
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
genealogy_t & obscure(void)
erase all deme information
Definition genealogy.h:321
nodeseq_t::trace_lineages
void trace_lineages(void)
Definition nodeseq.h:242
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 }
S
#define S
Definition seirs_pomp.c:37
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 }
slate_t
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"};
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 < 4) {
42 flag[j] = *LOGICAL(AS_LOGICAL(arg));
43 } else if (j < narg) {
44 flag[j] = *LOGICAL(AS_LOGICAL(arg));
45 if (flag[j]) nout++;
46 } else {
47 err("unrecognized argument '%s' in '%s'.",name,__func__);
48 }
49 args = CDR(args);
50 }
51
52 if (!flag[0]) err("no genealogy furnished to '%s'",__func__);
53 genealogy_t A = object;
54
55 // prune and/or obscure if requested
56 const bool *f = flag+1;
57 if (*(f++)) A.prune();
58 if (*(f++)) A.obscure();
59 A.trace_lineages();
60 bool extended = false;
61 if (*(f++)) {
62 extended = true;
63 } else {
64 A.insert_zlb();
65 }
66
67 SEXP out, outnames;
68 PROTECT(out = NEW_LIST(nout));
69 PROTECT(outnames = NEW_CHARACTER(nout));
70 k = 0;
71 if (*(f++)) { // t0
72 k = set_list_elem(out,outnames,timezero(A),"t0",k);
73 }
74 if (*(f++)) { // time
75 k = set_list_elem(out,outnames,time(A),"time",k);
76 }
77 if (*(f++)) { // nsample
78 k = set_list_elem(out,outnames,nsample(A),"nsample",k);
79 }
80 if (*(f++)) { // nroot
81 k = set_list_elem(out,outnames,nroot(A),"nroot",k);
82 }
83 if (*(f++)) { // ndeme
84 k = set_list_elem(out,outnames,ndeme(A),"ndeme",k);
85 }
86 if (*(f++)) { // structure
87 k = set_list_elem(out,outnames,structure(A),"structure",k);
88 }
89 if (*(f++)) { // yaml
90 k = set_list_elem(out,outnames,yaml(A),"yaml",k);
91 }
92 if (*(f++)) { // newick
93 k = set_list_elem(out,outnames,newick(A,extended),"newick",k);
94 }
95 if (*(f++)) { // lineages
96 k = set_list_elem(out,outnames,lineage_count(A),"lineages",k);
97 }
98 if (*(f++)) { // gendat
99 k = set_list_elem(out,outnames,gendat(A),"gendat",k);
100 }
101 if (*(f++)) { // genealogy
102 SEXP S;
103 PROTECT(S = serial(A));
104 SET_ATTR(S,install("class"),mkString("gpgen"));
105 k = set_list_elem(out,outnames,S,"genealogy",k);
106 UNPROTECT(1);
107 }
108 SET_NAMES(out,outnames);
109 UNPROTECT(2);
110 return out;
111 }
genealogy_t::insert_zlb
void insert_zlb(void)
insert zero-length branches for samples where needed
Definition genealogy.h:358
gendat
SEXP gendat(SEXP State, SEXP Obscure)
data-frame format
Definition gendat.cc:104
ndeme
SEXP ndeme(TYPE &X)
Definition generics.h:7
nroot
SEXP nroot(TYPE &X)
Definition generics.h:17
timezero
SEXP timezero(TYPE &X)
Definition generics.h:22
time
SEXP time(TYPE &X)
Definition generics.h:27
structure
SEXP structure(const TYPE &X)
structure in R list format
Definition generics.h:49
yaml
SEXP yaml(const TYPE &X)
human/machine readable output
Definition generics.h:43
lineage_count
SEXP lineage_count(const TYPE &G)
number of lineages through time
Definition generics.h:61
nsample
SEXP nsample(TYPE &X)
Definition generics.h:12
newick
SEXP newick(const TYPE &X, bool extended)
tree in newick format
Definition generics.h:55
matchargs
static size_t matchargs(const char *prov, const char **set, size_t n)
Definition getinfo.cc:7
set_list_elem
static int set_list_elem(SEXP list, SEXP names, SEXP element, const char *name, int pos)
Definition internal.h:76
err
#define err(...)
Definition internal.h:18
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 259 of file parse.cc.

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

◆ R_init_phylopomp()

void R_init_phylopomp ( DllInfo * info)

Definition at line 60 of file init.c.

60 {
61 // Register routines
62 R_registerRoutines(info,NULL,callMethods,NULL,extMethods);
63 R_useDynamicSymbols(info,TRUE);
64 // R_useDynamicSymbols(info,FALSE);
65 // R_forceSymbols(info,TRUE);
66 get_userdata = (get_userdata_t*) R_GetCCallable("pomp","get_userdata");
67 get_userdata_double = (get_userdata_double_t*) R_GetCCallable("pomp","get_userdata_double");
68 get_userdata_int = (get_userdata_int_t*) R_GetCCallable("pomp","get_userdata_int");
69}
extMethods
static const R_CallMethodDef extMethods[]
Definition init.c:54
get_userdata_int
get_userdata_int_t * get_userdata_int
Definition init.c:7
callMethods
static const R_CallMethodDef callMethods[]
Definition init.c:33
get_userdata
get_userdata_t * get_userdata
Definition init.c:5
get_userdata_double
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 }
genealogy_t::yaml
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(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},
{NULL, NULL, 0}
}
curtail
SEXP curtail(SEXP State, SEXP Time, SEXP Troot)
curtail the given genealogy
Definition curtail.cc:89
geneal
SEXP geneal(SEXP State)
extract the bare genealogy
Definition geneal.cc:11
parse_newick
SEXP parse_newick(SEXP, SEXP, SEXP)
Definition parse.cc:259
genealScaleShift
SEXP genealScaleShift(SEXP, SEXP, SEXP)
rescale and/or reset origin
Definition scale.cc:11
METHODS
#define METHODS(X)
Definition init.h:13

Definition at line 33 of file init.c.

33 {
34 METHODS(LBDP),
35 METHODS(MERS),
36 METHODS(Moran),
37 METHODS(S2I2R2),
38 METHODS(SEIR),
39 METHODS(SI2R),
40 METHODS(SIIR),
41 METHODS(SIR),
42 METHODS(Strains),
43 METHODS(TwoSpecies),
44 METHODS(TwoUndead),
45 {"parse_newick", (DL_FUNC) &parse_newick, 3},
46 {"curtail", (DL_FUNC) &curtail, 3},
47 {"yaml", (DL_FUNC) &yaml, 1},
48 {"gendat", (DL_FUNC) &gendat, 2},
49 {"geneal", (DL_FUNC) &geneal, 1},
50 {"geneal_scale", (DL_FUNC) &genealScaleShift, 3},
51 {NULL, NULL, 0}
52};

◆ extMethods

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

Definition at line 54 of file init.c.

54 {
55 {"getInfo", (DL_FUNC) &getInfo, -1},
56 {"genealSum", (DL_FUNC) &genealSum, -1},
57 {NULL, NULL, 0}
58};

◆ 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.