improve 'repair_lookup_table'

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: pomp
 Type: Package
 Title: Statistical Inference for Partially Observed Markov Processes
-Version: 5.8.2.0
-Date: 2024-05-13
+Version: 5.8.2.1
+Date: 2024-05-14
 Authors@R: c(person(given=c("Aaron","A."),family="King",role=c("aut","cre"),email="[email protected]",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")),

R/lookup.R

@@ -12,7 +12,6 @@
 ##' A numeric vector or matrix of the interpolated values.
 ##' @inheritSection covariates Extrapolation
 ##' @export
-
 lookup <- function (table, t) {
   d <- .Call(P_lookup_in_table,table,t)
   data.frame(t=t,t(d))
@@ -26,12 +25,15 @@ lookup <- function (table, t) {
 ##' times at which interpolated values of the covariates in \code{table} are required.
 ##' @details
 ##' \code{repair_lookup_table} applies \code{\link{lookup}} at the provided values of \code{t} and returns the resulting lookup table.
+##' If \code{order} is unsupplied, the interpolation-order from \code{table} is preserved.
 ##' \strong{\code{repair_lookup_table} should be considered experimental: its interface may change without notice}.
 ##' @export
-repair_lookup_table <- function (table, t) {
+repair_lookup_table <- function (table, t, order) {
+  if (missing(order))
+    order <- if (table@order==0L) "constant" else "linear"
   covariate_table(
     lookup(table,t=t),
-    order=if (table@order==0L) "constant" else "linear",
+    order=order,
     times="t"
   )
 }

tests/lookup.R

@@ -73,4 +73,17 @@ lookup(tab,c(0,2.5,3.6,10,20))
 repair_lookup_table(tab,t=c(seq(0,10,by=1),20)) -> tab2
 lookup(tab2,c(0,2.5,3.6,10,20))
 
+covariate_table(
+  x=seq(1,10,by=1),
+  y=seq(1,10,by=1),
+  order="const",
+  times="x"
+) -> tab
+
+repair_lookup_table(tab,t=c(seq(0,10,by=1),20),order="lin") -> tab2
+lookup(tab2,c(0,2.5,3.6,10,20))
+
+repair_lookup_table(tab,t=c(seq(0,10,by=1),20),order="const") -> tab2
+lookup(tab2,c(0,2.5,3.6,10,20))
+
 dev.off()

tests/lookup.Rout.save

@@ -184,6 +184,37 @@ Warning messages:
 4 10.0 10
 5 20.0 10
 > 
+> covariate_table(
++   x=seq(1,10,by=1),
++   y=seq(1,10,by=1),
++   order="const",
++   times="x"
++ ) -> tab
+> 
+> repair_lookup_table(tab,t=c(seq(0,10,by=1),20),order="lin") -> tab2
+Warning messages:
+1: in 'table_lookup': extrapolating at 0.000000e+00. 
+2: in 'table_lookup': extrapolating at 2.000000e+01. 
+> lookup(tab2,c(0,2.5,3.6,10,20))
+     t    y
+1  0.0  1.0
+2  2.5  2.5
+3  3.6  3.6
+4 10.0 10.0
+5 20.0 10.0
+> 
+> repair_lookup_table(tab,t=c(seq(0,10,by=1),20),order="const") -> tab2
+Warning messages:
+1: in 'table_lookup': extrapolating at 0.000000e+00. 
+2: in 'table_lookup': extrapolating at 2.000000e+01. 
+> lookup(tab2,c(0,2.5,3.6,10,20))
+     t  y
+1  0.0  1
+2  2.5  2
+3  3.6  3
+4 10.0 10
+5 20.0 10
+> 
 > dev.off()
 null device 
           1