phylopomp
Phylodynamics for POMPs
All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Pages
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 curtail (SEXP, SEXP)
 curtail the given genealogy More...
 
SEXP yaml (SEXP)
 extract a YAML description More...
 
SEXP gendat (SEXP)
 data-frame format More...
 
 DECLARATIONS (LBDP)
 
 DECLARATIONS (Moran)
 
 DECLARATIONS (S2I2R2)
 
 DECLARATIONS (SEIR)
 
 DECLARATIONS (SI2R)
 
 DECLARATIONS (SIIR)
 
 DECLARATIONS (SIR)
 
 DECLARATIONS (TwoSpecies)
 
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 
)

curtail the given genealogy

Definition at line 10 of file bare.cc.

10  {
11  genealogy_t A = State;
12  A.curtail(*REAL(AS_NUMERIC(Time)));
13  SEXP out;
14  PROTECT(out = serial(A));
15  SET_ATTR(out,install("class"),mkString("gpgen"));
16  UNPROTECT(1);
17  return out;
18  }
Encodes a genealogy.
Definition: genealogy.h:22
void curtail(slate_t tnew)
Definition: genealogy.h:496
SEXP serial(const TYPE &X)
binary serialization
Definition: generics.h:28
Here is the call graph for this function:

◆ DECLARATIONS() [1/8]

DECLARATIONS ( LBDP  )

◆ DECLARATIONS() [2/8]

DECLARATIONS ( Moran  )

◆ DECLARATIONS() [3/8]

DECLARATIONS ( S2I2R2  )

◆ DECLARATIONS() [4/8]

DECLARATIONS ( SEIR  )

◆ DECLARATIONS() [5/8]

DECLARATIONS ( SI2R  )

◆ DECLARATIONS() [6/8]

DECLARATIONS ( SIIR  )

◆ DECLARATIONS() [7/8]

DECLARATIONS ( SIR  )

◆ DECLARATIONS() [8/8]

DECLARATIONS ( TwoSpecies  )

◆ gendat()

SEXP gendat ( SEXP  State)

data-frame format

Definition at line 27 of file bare.cc.

27  {
28  genealogy_t A = State;
29  A.prune();
30  A.obscure();
31  A.trace_lineages();
32  return A.gendat();
33  }
genealogy_t & prune(void)
prune the tree (drop all black balls)
Definition: genealogy.h:465
genealogy_t & obscure(void)
erase all deme information
Definition: genealogy.h:476
void gendat(double *tout, int *anc, int *lin, int *sat, int *type, int *index, int *child) const
nodelist in data-frame format
Definition: genealogy.h:231
void trace_lineages(void)
Definition: nodeseq.h:244
Here is the call graph for this function:
Here is the caller 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",
22  "t0","time","nsample","ndeme",
23  "description","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 < 3) {
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 
61  SEXP out, outnames;
62  PROTECT(out = NEW_LIST(nout));
63  PROTECT(outnames = NEW_CHARACTER(nout));
64  k = 0;
65  if (*(f++)) { // t0
66  k = set_list_elem(out,outnames,timezero(A),"t0",k);
67  }
68  if (*(f++)) { // time
69  k = set_list_elem(out,outnames,time(A),"time",k);
70  }
71  if (*(f++)) { // nsample
72  k = set_list_elem(out,outnames,nsample(A),"nsample",k);
73  }
74  if (*(f++)) { // ndeme
75  k = set_list_elem(out,outnames,ndeme(A),"ndeme",k);
76  }
77  if (*(f++)) { // description
78  k = set_list_elem(out,outnames,describe(A),"description",k);
79  }
80  if (*(f++)) { // structure
81  k = set_list_elem(out,outnames,structure(A),"structure",k);
82  }
83  if (*(f++)) { // yaml
84  k = set_list_elem(out,outnames,yaml(A),"yaml",k);
85  }
86  if (*(f++)) { // newick
87  k = set_list_elem(out,outnames,newick(A),"newick",k);
88  }
89  if (*(f++)) { // lineages
90  k = set_list_elem(out,outnames,lineage_count(A),"lineages",k);
91  }
92  if (*(f++)) { // gendat
93  k = set_list_elem(out,outnames,gendat(A),"gendat",k);
94  }
95  if (*(f++)) { // genealogy
96  SEXP S;
97  PROTECT(S = serial(A));
98  SET_ATTR(S,install("class"),mkString("gpgen"));
99  k = set_list_elem(out,outnames,S,"genealogy",k);
100  UNPROTECT(1);
101  }
102  SET_NAMES(out,outnames);
103  UNPROTECT(2);
104  return out;
105  }
SEXP yaml(SEXP State)
extract a YAML description
Definition: bare.cc:21
SEXP gendat(SEXP State)
data-frame format
Definition: bare.cc:27
SEXP ndeme(TYPE &X)
Definition: generics.h:7
SEXP describe(const TYPE &X)
human readable output
Definition: generics.h:44
SEXP timezero(TYPE &X)
Definition: generics.h:17
SEXP time(TYPE &X)
Definition: generics.h:22
SEXP structure(const TYPE &X)
structure in R list format
Definition: generics.h:50
SEXP newick(const TYPE &X)
tree in newick format
Definition: generics.h:56
SEXP lineage_count(const TYPE &G)
number of lineages through time
Definition: generics.h:62
SEXP nsample(TYPE &X)
Definition: generics.h:12
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:67
#define err(...)
Definition: internal.h:18
#define S
Definition: seirs_pomp.c:33
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 10 of file parse.cc.

10  {
11  PROTECT(X = AS_CHARACTER(X));
12  PROTECT(T0 = AS_NUMERIC(T0));
13  PROTECT(Tf = AS_NUMERIC(Tf));
14  double t0 = *REAL(T0);
15  double tf = *REAL(Tf);
16  // parse the Newick representation into a genealogy:
17  std::string x = CHAR(STRING_ELT(X,0));
18  genealogy_t G(t0);
19  G.parse(x,t0);
20  if (!ISNA(tf)) {
21  if (G.time() > tf) {
22  G.curtail(tf);
23  } else {
24  G.time() = tf;
25  }
26  }
27  G.trace_lineages();
28  UNPROTECT(3);
29  return serial(G);
30  }
Here is the call graph for this function:

◆ R_init_phylopomp()

void R_init_phylopomp ( DllInfo *  info)

Definition at line 48 of file init.c.

48  {
49  // Register routines
50  R_registerRoutines(info,NULL,callMethods,NULL,extMethods);
51  R_useDynamicSymbols(info,TRUE);
52  // R_useDynamicSymbols(info,FALSE);
53  // R_forceSymbols(info,TRUE);
54  get_userdata = (get_userdata_t*) R_GetCCallable("pomp","get_userdata");
55  get_userdata_double = (get_userdata_double_t*) R_GetCCallable("pomp","get_userdata_double");
56  get_userdata_int = (get_userdata_int_t*) R_GetCCallable("pomp","get_userdata_int");
57 }
static const R_CallMethodDef extMethods[]
Definition: init.c:43
get_userdata_int_t * get_userdata_int
Definition: init.c:7
static const R_CallMethodDef callMethods[]
Definition: init.c:27
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 21 of file bare.cc.

21  {
22  genealogy_t A = State;
23  return mkString(A.yaml().c_str());
24  }
virtual std::string yaml(std::string tab="") const
machine-readable info
Definition: genealogy.h:352
Here is the call graph for this function:
Here is the caller graph for this function:

Variable Documentation

◆ callMethods

const R_CallMethodDef callMethods[]
static
Initial value:
= {
METHODS(LBDP),
METHODS(Moran),
METHODS(S2I2R2),
METHODS(SEIR),
METHODS(SI2R),
METHODS(SIIR),
METHODS(SIR),
METHODS(TwoSpecies),
{"parse_newick", (DL_FUNC) &parse_newick, 3},
{"curtail", (DL_FUNC) &curtail, 2},
{"yaml", (DL_FUNC) &yaml, 1},
{"gendat", (DL_FUNC) &gendat, 1},
{NULL, NULL, 0}
}
SEXP gendat(SEXP)
data-frame format
Definition: bare.cc:27
SEXP curtail(SEXP, SEXP)
curtail the given genealogy
Definition: bare.cc:10
SEXP parse_newick(SEXP, SEXP, SEXP)
Definition: parse.cc:10
SEXP yaml(SEXP)
extract a YAML description
Definition: bare.cc:21
#define METHODS(X)
Definition: init.h:14

Definition at line 27 of file init.c.

◆ extMethods

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

Definition at line 43 of file init.c.

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