AAK edits

Author: kingaa

R/lbdp.R

@@ -15,6 +15,8 @@
 ##' @param time final time
 ##' @param t0 initial time
 ##' @return \code{runLBDP} and \code{continueLBDP} return objects of class \sQuote{gpsim} with \sQuote{model} attribute \dQuote{LBDP}.
+##' @details
+##' Destructive sampling (nonzero \code{r}) is supported for simulation but not for \code{lbdp_pomp} or \code{lbdp_exact}.
 ##' @references
 ##' \King2024
 ##'
@@ -28,7 +30,8 @@ NULL
 ##' @export
 runLBDP <- function (
   time,  t0 = 0,
-  lambda = 2, mu = 1, psi = 1, r = 0,
+  lambda = 2, mu = 1, psi = 1,
+  r = 0,
   n0 = 5
 ) {
   if (!is.numeric(r) || length(r) != 1L || !is.finite(r) || r < 0 || r > 1)
@@ -49,10 +52,10 @@ runLBDP <- function (
 continueLBDP <- function (
   object, time, lambda = NA, mu = NA, psi = NA, r = NA
 ) {
-  if (!isTRUE(is.na(r))) {
-    if (!is.numeric(r) || length(r) != 1L || !is.finite(r) || r < 0 || r > 1)
-      pStop(sQuote("r")," must be between 0 and 1.")
-  }
+  if (!is.na(r) &&
+        (!is.numeric(r) || length(r) != 1L || !is.finite(r) || r < 0 || r > 1)
+  )
+    pStop(sQuote("r")," must be between 0 and 1.")
   params <- c(lambda=lambda,mu=mu,psi=psi,r=r)
   x <- .Call(P_reviveLBDP,object,params)
   .Call(P_runLBDP,x,time) |>

man/lbdp.Rd

@@ -44,8 +44,6 @@ void lbdp_proc_t::update_params (double *p, int n) {
   PARAM_SET(mu);
   PARAM_SET(psi);
   PARAM_SET(r);
-  if (!R_FINITE(params.r) || params.r < 0 || params.r > 1)
-    err("r must be between 0 and 1.");
   if (m != n) err("wrong number of parameters!");
 }
 

src/lbdp.cc

@@ -0,0 +1,26 @@
+options(digits=3)
+suppressPackageStartupMessages({
+  library(phylopomp)
+})
+set.seed(1253219857)
+
+runLBDP(time=1,lambda=0,mu=0,psi=10,r=1,n0=5) |>
+  gendat() -> gi
+sample_idx <- gi$nodetype == 1L
+stopifnot(
+  `no samples`=any(sample_idx),
+  `bad saturation`=all(gi$saturation[sample_idx] == 0)
+)
+
+runLBDP(time=1,lambda=0,mu=0,psi=100,r=0,n0=5) |>
+  gendat() -> gi
+sample_idx <- gi$nodetype == 1L
+stopifnot(
+  `no samples`=any(sample_idx),
+  `bad saturation`=sum(gi$saturation[sample_idx] == 0)==5
+)
+
+try(runLBDP(time=1,lambda=0,mu=0,psi=1,r=-0.1,n0=1))
+try(runLBDP(time=1,lambda=0,mu=0,psi=1,r=1.5,n0=1))
+try(runLBDP(time=1,lambda=0,mu=0,psi=1,r=Inf,n0=1))
+try(runLBDP(time=1,lambda=0,mu=0,psi=1,r=NA,n0=1))

tests/lbdp4.R

@@ -0,0 +1,50 @@
+
+R version 4.5.2 (2025-10-31) -- "[Not] Part in a Rumble"
+Copyright (C) 2025 The R Foundation for Statistical Computing
+Platform: x86_64-pc-linux-gnu
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+  Natural language support but running in an English locale
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> options(digits=3)
+> suppressPackageStartupMessages({
++   library(phylopomp)
++ })
+> set.seed(1253219857)
+> 
+> runLBDP(time=1,lambda=0,mu=0,psi=10,r=1,n0=5) |>
++   gendat() -> gi
+> sample_idx <- gi$nodetype == 1L
+> stopifnot(
++   `no samples`=any(sample_idx),
++   `bad saturation`=all(gi$saturation[sample_idx] == 0)
++ )
+> 
+> runLBDP(time=1,lambda=0,mu=0,psi=100,r=0,n0=5) |>
++   gendat() -> gi
+> sample_idx <- gi$nodetype == 1L
+> stopifnot(
++   `no samples`=any(sample_idx),
++   `bad saturation`=sum(gi$saturation[sample_idx] == 0)==5
++ )
+> 
+> try(runLBDP(time=1,lambda=0,mu=0,psi=1,r=-0.1,n0=1))
+Error : in 'runLBDP': 'r' must be between 0 and 1.
+> try(runLBDP(time=1,lambda=0,mu=0,psi=1,r=1.5,n0=1))
+Error : in 'runLBDP': 'r' must be between 0 and 1.
+> try(runLBDP(time=1,lambda=0,mu=0,psi=1,r=Inf,n0=1))
+Error : in 'runLBDP': 'r' must be between 0 and 1.
+> try(runLBDP(time=1,lambda=0,mu=0,psi=1,r=NA,n0=1))
+Error : in 'runLBDP': 'r' must be between 0 and 1.
+>