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	newick (SEXP, SEXP)
	tree in newick format
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
	DECLARATIONS (LBDP)
	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 88 of file curtail.cc.

                                                   {
    genealogy_t A = State;
    double t, t0;
    t = *REAL(AS_NUMERIC(Time));
    t0 = *REAL(AS_NUMERIC(Troot));
    if (ISNA(t)) t = A.time();
    if (ISNA(t0)) t0 = A.timezero();
    A.curtail(t,t0);
    SEXP out;
    PROTECT(out = serial(A));
    SET_ATTR(out,install("class"),mkString("gpgen"));
    UNPROTECT(1);
    return out;
  }

Here is the call graph for this function:

Here is the caller graph for this function:

DECLARATIONS() [1/10]

DECLARATIONS

(

LBDP

)

DECLARATIONS() [2/10]

DECLARATIONS

(

Moran

)

DECLARATIONS() [3/10]

DECLARATIONS

(

S2I2R2

)

DECLARATIONS() [4/10]

DECLARATIONS

(

SEIR

)

DECLARATIONS() [5/10]

DECLARATIONS

(

SI2R

)

DECLARATIONS() [6/10]

DECLARATIONS

(

SIIR

)

DECLARATIONS() [7/10]

DECLARATIONS

(

SIR

)

DECLARATIONS() [8/10]

DECLARATIONS

(

Strains

)

DECLARATIONS() [9/10]

DECLARATIONS

(

TwoSpecies

)

DECLARATIONS() [10/10]

DECLARATIONS

(

TwoUndead

)

gendat()

SEXP gendat	(	SEXP	State,
		SEXP	Obscure )

data-frame format

Definition at line 104 of file gendat.cc.

                                         {
    genealogy_t A = State;
    A.prune();
    if (*LOGICAL(Obscure)) A.obscure();
    A.trace_lineages();
    return A.gendat();
  }

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 12 of file geneal.cc.

                           {
    SEXP S;
    PROTECT(S = serial(genealogy_t(State)));
    SET_ATTR(S,install("class"),mkString("gpgen"));
    UNPROTECT(1);
    return S;
  }

Here is the call graph for this function:

genealSum()

SEXP genealSum

(

SEXP

args

)

combine genealogies

Definition at line 50 of file sum.cc.

                             {
    args = CDR(args);
    genealogy_t A(R_NegInf); // a "null" genealogy on [-inf,inf]
    A.time() = R_PosInf;
    while (args != R_NilValue) {
      A += CAR(args);
      args = CDR(args);
    }
    SEXP S;
    PROTECT(S = serial(A));
    SET_ATTR(S,install("class"),mkString("gpgen"));
    UNPROTECT(1);
    return S;
  }

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.

                           {
    const char *argname[] = {
      "object","prune","obscure","extended",
        "t0","time","nsample","nroot","ndeme",
        "structure","yaml","newick",
        "lineages","gendat","genealogy"};
    const int narg = sizeof(argname)/sizeof(const char *);
    bool flag[narg];
    SEXP object = R_NilValue;
    size_t nout = 0;
    int k;
 
    for (k = 0; k < narg; k++) flag[k] = false;
    args = CDR(args);
 
    while (args != R_NilValue) {
      const char *name = isNull(TAG(args)) ? "" : CHAR(PRINTNAME(TAG(args)));
      SEXP arg = CAR(args);
      size_t j = matchargs(name,argname,narg);
      if (j == 0) {
        object = arg;
        flag[0] = true;
      } else if (j < 4) {
        flag[j] = *LOGICAL(AS_LOGICAL(arg));
      } else if (j < narg) {
        flag[j] = *LOGICAL(AS_LOGICAL(arg));
        if (flag[j]) nout++;
      } else {
        err("unrecognized argument '%s' in '%s'.",name,__func__);
      }
      args = CDR(args);
    }
 
    if (!flag[0]) err("no genealogy furnished to '%s'",__func__);
    genealogy_t A = object;
 
    // prune and/or obscure if requested
    const bool *f = flag+1;
    if (*(f++)) A.prune();
    if (*(f++)) A.obscure();
    A.trace_lineages();
    bool extended = false;
    if (*(f++)) {
      extended = true;
    } else {
      A.insert_zlb();
    }
 
    SEXP out, outnames;
    PROTECT(out = NEW_LIST(nout));
    PROTECT(outnames = NEW_CHARACTER(nout));
    k = 0;
    if (*(f++)) {               // t0
      k = set_list_elem(out,outnames,timezero(A),"t0",k);
    }
    if (*(f++)) {               // time
      k = set_list_elem(out,outnames,time(A),"time",k);
    }
    if (*(f++)) {               // nsample
      k = set_list_elem(out,outnames,nsample(A),"nsample",k);
    }
    if (*(f++)) {               // nroot
      k = set_list_elem(out,outnames,nroot(A),"nroot",k);
    }
    if (*(f++)) {               // ndeme
      k = set_list_elem(out,outnames,ndeme(A),"ndeme",k);
    }
    if (*(f++)) {               // structure
      k = set_list_elem(out,outnames,structure(A),"structure",k);
    }
    if (*(f++)) {               // yaml
      k = set_list_elem(out,outnames,yaml(A),"yaml",k);
    }
    if (*(f++)) {               // newick
      k = set_list_elem(out,outnames,newick(A,extended),"newick",k);
    }
    if (*(f++)) {               // lineages
      k = set_list_elem(out,outnames,lineage_count(A),"lineages",k);
    }
    if (*(f++)) {               // gendat
      k = set_list_elem(out,outnames,gendat(A),"gendat",k);
    }
    if (*(f++)) {               // genealogy
      SEXP S;
      PROTECT(S = serial(A));
      SET_ATTR(S,install("class"),mkString("gpgen"));
      k = set_list_elem(out,outnames,S,"genealogy",k);
      UNPROTECT(1);
    }
    SET_NAMES(out,outnames);
    UNPROTECT(2);
    return out;
  }

Here is the call graph for this function:

newick()

SEXP newick	(	SEXP	State,
		SEXP	Extended )

tree in newick format

Definition at line 102 of file newick.cc.

                                          {
    PROTECT(Extended = AS_LOGICAL(Extended));
    bool extended = *LOGICAL(Extended);
    genealogy_t A(State);
    UNPROTECT(1);
    return mkString(A.newick(extended).c_str());
  }

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 236 of file parse.cc.

                                               {
    PROTECT(X = AS_CHARACTER(X));
    PROTECT(T0 = AS_NUMERIC(T0));
    PROTECT(Tf = AS_NUMERIC(Tf));
    double t0 = *REAL(T0);
    double tf = *REAL(Tf);
    // parse the Newick representation into a genealogy:
    string_t x = CHAR(STRING_ELT(X,0));
    genealogy_t G(t0);
    G.parse(x);
    if (!ISNA(tf)) {
      G.curtail(tf,t0);
    }
    G.trace_lineages();
    UNPROTECT(3);
    return serial(G);
  }

Here is the call graph for this function:

R_init_phylopomp()

void R_init_phylopomp

(

DllInfo *

info

)

Definition at line 58 of file init.c.

                                      {
  // Register routines
  R_registerRoutines(info,NULL,callMethods,NULL,extMethods);
  R_useDynamicSymbols(info,TRUE);
  // R_useDynamicSymbols(info,FALSE);
  // R_forceSymbols(info,TRUE);
  get_userdata = (get_userdata_t*) R_GetCCallable("pomp","get_userdata");
  get_userdata_double = (get_userdata_double_t*) R_GetCCallable("pomp","get_userdata_double");
  get_userdata_int = (get_userdata_int_t*) R_GetCCallable("pomp","get_userdata_int");
}

yaml()

SEXP yaml

(

SEXP

State

)

extract a YAML description

Definition at line 78 of file yaml.cc.

                         {
    genealogy_t A = State;
    return mkString(A.yaml().c_str());
  }

Here is the call 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(Strains),
  METHODS(TwoSpecies),
  METHODS(TwoUndead),
  {"parse_newick", (DL_FUNC) &parse_newick, 3},
  {"newick", (DL_FUNC) &newick, 2},
  {"curtail", (DL_FUNC) &curtail, 3},
  {"yaml", (DL_FUNC) &yaml, 1},
  {"gendat", (DL_FUNC) &gendat, 2},
  {"geneal", (DL_FUNC) &geneal, 1},
  {NULL, NULL, 0}
}

Definition at line 32 of file init.c.

                                             {
  METHODS(LBDP),
  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},
  {"newick", (DL_FUNC) &newick, 2},
  {"curtail", (DL_FUNC) &curtail, 3},
  {"yaml", (DL_FUNC) &yaml, 1},
  {"gendat", (DL_FUNC) &gendat, 2},
  {"geneal", (DL_FUNC) &geneal, 1},
  {NULL, NULL, 0}
};

extMethods

const R_CallMethodDef extMethods[]

static

Initial value:

= {
  {"getInfo", (DL_FUNC) &getInfo, -1},
  {"genealSum", (DL_FUNC) &genealSum, -1},
  {NULL, NULL, 0}
}

Definition at line 52 of file init.c.

                                            {
  {"getInfo", (DL_FUNC) &getInfo, -1},
  {"genealSum", (DL_FUNC) &genealSum, -1},
  {NULL, NULL, 0}
};

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.