generics.h

Go to the documentation of this file.

#ifndef _GENERICS_H_
#define _GENERICS_H_
 
#include "internal.h"
 
template <class TYPE>
SEXP ndeme (TYPE& X) {
  return ScalarInteger(X.ndeme());
}
 
template <class TYPE>
SEXP nsample (TYPE& X) {
  return ScalarInteger(X.nsample());
}
 
template <class TYPE>
SEXP nroot (TYPE& X) {
  return ScalarInteger(X.nroot());
}
 
template <class TYPE>
SEXP timezero (TYPE& X) {
  return ScalarReal(X.timezero());
}
 
template <class TYPE>
SEXP time (TYPE& X) {
  return ScalarReal(X.time());
}

template <class TYPE>
SEXP serial (const TYPE& X) {
  SEXP out;
  PROTECT(out = NEW_RAW(X.bytesize()));
  X >> RAW(out);
  UNPROTECT(1);
  return out;
}

template <class TYPE>
SEXP yaml (const TYPE& X) {
  return mkString(X.yaml().c_str());
}

template <class TYPE>
SEXP structure (const TYPE& X) {
  return X.structure();
}

template <class TYPE>
SEXP newick (const TYPE& X, bool extended) {
  return mkString(X.newick(extended).c_str());
}

template <class TYPE>
SEXP lineage_count (const TYPE& G) {
  return G.lineage_count();
}

template <class TYPE>
SEXP gendat (const TYPE& G) {
  return G.gendat();
}

template<class TYPE>
SEXP make (SEXP Params, SEXP IVPs, SEXP T0) {
  SEXP o;
  PROTECT(Params = AS_NUMERIC(Params));
  PROTECT(IVPs = AS_NUMERIC(IVPs));
  PROTECT(T0 = AS_NUMERIC(T0));
  GetRNGstate();
  TYPE X = *REAL(T0);
  X.update_params(REAL(Params),LENGTH(Params));
  X.update_IVPs(REAL(IVPs),LENGTH(IVPs));
  X.rinit();
  X.update_clocks();
  PutRNGstate();
  PROTECT(o = serial(X));
  UNPROTECT(4);
  return o;
}

template<class TYPE>
SEXP revive (SEXP State, SEXP Params) {
  SEXP o;
  TYPE X = State;
  PROTECT(Params = AS_NUMERIC(Params));
  X.update_params(REAL(Params),LENGTH(Params));
  PROTECT(o = serial(X));
  UNPROTECT(2);
  return o;
}

template<class TYPE>
SEXP run (SEXP State, SEXP Tout) {
  SEXP out;
  TYPE X = State;
  PROTECT(Tout = AS_NUMERIC(Tout));
  GetRNGstate();
  X.valid();
  X.play(*REAL(Tout));
  PutRNGstate();
  PROTECT(out = serial(X));
  UNPROTECT(2);
  return out;
}
 
#define MAKEFN(X,TYPE) SEXP make ## X (SEXP Params, SEXP IVPs, SEXP T0) { \
    return make<TYPE>(Params,IVPs,T0);                                  \
  }                                                                     \
 
#define REVIVEFN(X,TYPE) SEXP revive ## X (SEXP State, SEXP Params) {   \
    return revive<TYPE>(State,Params);                                  \
  }                                                                     \
 
#define RUNFN(X,TYPE) SEXP run ## X (SEXP State, SEXP Times) {  \
    return run<TYPE>(State,Times);                              \
  }                                                             \
 
#define YAMLFN(X,TYPE) SEXP yaml ## X (SEXP State) {    \
    return yaml<TYPE>(State);                           \
  }                                                     \
 
#define GENERICS(X,TYPE)                        \
  extern "C" {                                  \
                                                \
    MAKEFN(X,TYPE)                              \
                                                \
    REVIVEFN(X,TYPE)                            \
                                                \
    RUNFN(X,TYPE)                               \
                                                \
    YAMLFN(X,TYPE)                              \
                                                \
  }                                             \
 
#endif