add deme information for samples and along lineages with gendat

Author: kingaa

DESCRIPTION

@@ -45,6 +45,7 @@ Collate:
     'simulate.R'
     'sir_pomp.R'
     'strains.R'
+    'strains_pomp.R'
     'treeplot.R'
     'twospecies.R'
     'twospecies_pomp.R'

NAMESPACE

@@ -69,6 +69,7 @@ export(simulate)
 export(sir_pomp)
 export(sirs_pomp)
 export(stew)
+export(strains_pomp)
 export(treeplot)
 export(twospecies_pomp)
 export(viewport)

R/gendat.R

@@ -5,9 +5,10 @@
 ##' @name gendat
 ##' @include package.R
 ##' @param object a \sQuote{gpgen} object.
+##' @inheritParams getInfo
 ##' @return A list of objects containing the information pertinent for filtering.
 ##' @rdname gendat
 ##' @export
-gendat <- function (object) {
-  .Call(P_gendat,geneal(object))
+gendat <- function (object, obscure = TRUE) {
+  .Call(P_gendat,geneal(object),as.logical(obscure))
 }

R/getinfo.R

@@ -45,6 +45,10 @@ getInfo <- function (
   ndeme = FALSE, lineages = FALSE, newick = FALSE,
   nsample = FALSE, genealogy = FALSE, gendat = FALSE
 ) {
+  if (gendat & !prune) {
+    warning("pruning since 'gendat=TRUE'",call.=FALSE)
+    prune <- TRUE
+  }
   x <- .External(
     P_getInfo,
     object=geneal(object),

R/strains_pomp.R

@@ -0,0 +1,44 @@
+##' @name strains_pomp
+##' @rdname strains
+##' @include strains.R
+##' @param x genealogy in \pkg{phylopomp} format (i.e., an object that inherits from \sQuote{gpgen}).
+##' @details
+##' \code{strains_pomp} constructs a \sQuote{pomp} object containing a given set of data and the Strains model.
+##' @return
+##' \code{strains_pomp} returns a \sQuote{pomp} object.
+##' @importFrom pomp pomp onestep
+##' @export
+strains_pomp <- function (x, Beta1, Beta2, Beta3, gamma, psi1, psi2, psi3, S0, I1_0, I2_0, I3_0, R0, t0 = 0)
+{
+  x |> gendat(obscure=FALSE) -> gi
+  ic <- as.integer(c(S0,I1_0,I2_0,I3_0,R0))
+  names(ic) <- c("S0","I1_0","I2_0","I3_0","R0")
+  if (any(ic < 0))
+    pStop(paste(sQuote(names(ic)),collapse=","),
+      " must be nonnegative integers.")
+  pomp(
+    data=NULL,
+    t0=gi$nodetime[1L],
+    times=gi$nodetime[-1L],
+    params=c(
+      Beta1=Beta1,Beta2=Beta2,Beta3=Beta3,
+      gamma=gamma,
+      psi1=psi1,psi2=psi2,psi3=psi3,
+      ic,N=sum(ic)
+    ),
+    userdata=gi,
+    rinit="strains_rinit",
+    rprocess=onestep("strains_gill"),
+    dmeasure="strains_dmeas",
+    statenames=c(
+      "S","I2","I2","I3","R",
+      "ll","ell1","ell2","ell3","node"
+    ),
+    paramnames=c(
+      "Beta1","Beta2","Beta3","gamma",
+      "psi1","psi2","psi3",
+      "S0","I1_0","I2_0","I3_0","R0","N"
+    ),
+    PACKAGE="phylopomp"
+  )
+}

inst/NEWS

@@ -1,5 +1,9 @@
 _N_e_w_s _f_o_r _p_a_c_k_a_g_e '_p_h_y_l_o_p_o_m_p'
 
+_C_h_a_n_g_e_s _i_n '_p_h_y_l_o_p_o_m_p' _v_e_r_s_i_o_n _0._1_6:
+
+        • ‘gendat()’ now returns the deme for samples.
+
 _C_h_a_n_g_e_s _i_n '_p_h_y_l_o_p_o_m_p' _v_e_r_s_i_o_n _0._1_5:
 
         • New model in which three distinct strains compete for

inst/NEWS.Rd

@@ -1,5 +1,10 @@
 \name{NEWS}
 \title{News for package `phylopomp'}
+\section{Changes in \pkg{phylopomp} version 0.16}{
+  \itemize{
+    \item \code{gendat()} now returns the deme for samples.
+  }
+}
 \section{Changes in \pkg{phylopomp} version 0.15}{
   \itemize{
     \item New model in which three distinct strains compete for susceptibles from a single pool.

man/gendat.Rd

@@ -29,10 +29,10 @@ extern "C" {
   }
 
   //! data-frame format
-  SEXP gendat (SEXP State) {
+  SEXP gendat (SEXP State, SEXP Obscure) {
     genealogy_t A = State;
     A.prune();
-    A.obscure();
+    if (*LOGICAL(Obscure)) A.obscure();
     A.trace_lineages();
     return A.gendat();
   }