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
7static 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
15extern "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();
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:26
SEXP gendat(SEXP State)
data-frame format
Definition bare.cc:32
Encodes a genealogy.
Definition genealogy.h:22
genealogy_t & prune(void)
prune the tree (drop all black balls)
Definition genealogy.h:468
genealogy_t & obscure(void)
erase all deme information
Definition genealogy.h:479
void trace_lineages(void)
Definition nodeseq.h:241
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