add eeulermultinom

Author: kingaa

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: pomp
 Type: Package
 Title: Statistical Inference for Partially Observed Markov Processes
-Version: 5.11.0.3
-Date: 2024-11-08
+Version: 5.11.1.0
+Date: 2024-12-07
 Authors@R: c(person(given=c("Aaron","A."),family="King",role=c("aut","cre"),email="kingaa@umich.edu",comment=c(ORCID="0000-0001-6159-3207")),
 	  person(given=c("Edward","L."),family="Ionides",role="aut",comment=c(ORCID="0000-0002-4190-0174"))	,
 	  person(given="Carles",family="Bretó",role="aut",comment=c(ORCID="0000-0003-4695-4902")),

TODO.md

@@ -2,6 +2,10 @@ _N_e_w_s _f_o_r _p_a_c_k_a_g_e '_p_o_m_p'
 
 _C_h_a_n_g_e_s _i_n '_p_o_m_p' _v_e_r_s_i_o_n _5._1_1._1:
 
+        • A new addition to the C API allows one to easily compute the
+          expectation of the Euler-multinomial.  The function is
+          ‘eeulermultinom’.
+
         • The help-page discussion of accumulator variables has been
           expanded and clarified.
 

inst/NEWS

@@ -2,6 +2,8 @@
 \title{News for package `pomp'}
 \section{Changes in \pkg{pomp} version 5.11.1}{
   \itemize{
+    \item A new addition to the C API allows one to easily compute the expectation of the Euler-multinomial.
+    The function is \code{eeulermultinom}.
     \item The help-page discussion of accumulator variables has been expanded and clarified.
   }
 }

inst/NEWS.Rd

@@ -125,6 +125,34 @@ double rgammawn
   return (sigmasq > 0) ? rgamma(dt/sigmasq,sigmasq) : dt;
 }
 
+static R_INLINE
+void eeulermultinom
+(int m, double size, const double *rate, double dt, double *trans)
+{
+  double lambda = 0.0;
+  int j, k;
+  if ( !R_FINITE(size) || size < 0.0 || !R_FINITE(dt) || dt < 0.0) {
+    for (k = 0; k < m; k++) trans[k] = R_NaReal;
+    warn("in 'eeulermultinom': NAs produced.");
+    return;
+  }
+  for (k = 0; k < m; k++) {
+    if (!R_FINITE(rate[k]) || rate[k] < 0.0) {
+      for (j = 0; j < m; j++) trans[j] = R_NaReal;
+      warn("in 'eeulermultinom': NAs produced.");
+      return;
+    }
+    lambda += rate[k];
+  }
+  if (lambda > 0.0) {
+    size = size*(1-exp(-lambda*dt));
+    for (k = 0; k < m; k++)
+      trans[k] = size*rate[k]/lambda;
+  } else {
+    for (k = 0; k < m; k++) trans[k] = 0.0;
+  }
+}
+
 static R_INLINE
 void reulermultinom
 (int m, double size, const double *rate, double dt, double *trans)

inst/include/pomp.h

@@ -133,6 +133,34 @@ double rgammawn
   return (sigmasq > 0) ? rgamma(dt/sigmasq,sigmasq) : dt;
 }
 
+static R_INLINE
+void eeulermultinom
+(int m, double size, const double *rate, double dt, double *trans)
+{
+  double lambda = 0.0;
+  int j, k;
+  if ( !R_FINITE(size) || size < 0.0 || !R_FINITE(dt) || dt < 0.0) {
+    for (k = 0; k < m; k++) trans[k] = R_NaReal;
+    warn("in 'eeulermultinom': NAs produced.");
+    return;
+  }
+  for (k = 0; k < m; k++) {
+    if (!R_FINITE(rate[k]) || rate[k] < 0.0) {
+      for (j = 0; j < m; j++) trans[j] = R_NaReal;
+      warn("in 'eeulermultinom': NAs produced.");
+      return;
+    }
+    lambda += rate[k];
+  }
+  if (lambda > 0.0) {
+    size = size*(1-exp(-lambda*dt));
+    for (k = 0; k < m; k++)
+      trans[k] = size*rate[k]/lambda;
+  } else {
+    for (k = 0; k < m; k++) trans[k] = 0.0;
+  }
+}
+
 static R_INLINE
 void reulermultinom
 (int m, double size, const double *rate, double dt, double *trans)

src/pomp.h

@@ -1,5 +1,5 @@
 
-R version 4.4.1 (2024-06-14) -- "Race for Your Life"
+R version 4.4.2 (2024-10-31) -- "Pile of Leaves"
 Copyright (C) 2024 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu
 
@@ -109,16 +109,16 @@ Type 'q()' to quit R.
 > ## ----comparison----------------------------------------------------------
 > system.time(simulate(gompertz,nsim=10000,format="arrays"))
    user  system elapsed 
-  5.415   0.114   5.530 
+  5.480   0.064   5.544 
 > system.time(simulate(Gompertz,nsim=10000,format="arrays"))
    user  system elapsed 
-  0.155   0.004   0.160 
+  0.156   0.005   0.161 
 > system.time(pfilter(gompertz,Np=1000))
    user  system elapsed 
-  0.547   0.003   0.549 
+  0.554   0.000   0.554 
 > system.time(pfilter(Gompertz,Np=1000))
    user  system elapsed 
-  0.028   0.000   0.029 
+  0.027   0.001   0.028 
 > 
 > dev.off()
 null device 

tests/R_v_C.Rout

@@ -1,5 +1,5 @@
 
-R version 4.4.1 (2024-06-14) -- "Race for Your Life"
+R version 4.4.2 (2024-10-31) -- "Pile of Leaves"
 Copyright (C) 2024 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu
 

tests/abc.Rout.save

@@ -1,5 +1,5 @@
 
-R version 4.4.1 (2024-06-14) -- "Race for Your Life"
+R version 4.4.2 (2024-10-31) -- "Pile of Leaves"
 Copyright (C) 2024 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu
 

tests/baddm.Rout.save

@@ -1,5 +1,5 @@
 
-R version 4.4.1 (2024-06-14) -- "Race for Your Life"
+R version 4.4.2 (2024-10-31) -- "Pile of Leaves"
 Copyright (C) 2024 The R Foundation for Statistical Computing
 Platform: x86_64-pc-linux-gnu