phylopomp
Phylodynamics for POMPs
All Data Structures Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Pages
getinfo.cc
Go to the documentation of this file.
1 // Get information about a genealogy
2 
3 #include "genealogy.h"
4 #include "generics.h"
5 #include "internal.h"
6 
7 static size_t matchargs (const char *prov, const char **set, size_t n) {
8  size_t i;
9  for (i = 0; i < n; i++) {
10  if (strcmp(prov,set[i]) == 0) break;
11  }
12  return i;
13 }
14 
15 extern "C" {
16 
19  SEXP getInfo (SEXP args) {
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  }
106 }
SEXP yaml(SEXP State)
extract a YAML description
Definition: bare.cc:21
SEXP gendat(SEXP State)
data-frame format
Definition: bare.cc:27
Encodes a genealogy.
Definition: genealogy.h:22
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 trace_lineages(void)
Definition: nodeseq.h:244
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 serial(const TYPE &X)
binary serialization
Definition: generics.h:28
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
SEXP getInfo(SEXP args)
Definition: getinfo.cc:19
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 n
Definition: lbdp_pomp.c:8
#define S
Definition: seirs_pomp.c:33