Consolidated code for sparse Markov chain

Author: baddstats

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: spatstat.sparse
-Version: 3.1-0.002
-Date: 2026-04-10
+Version: 3.1-0.003
+Date: 2026-04-11
 Title: Sparse Three-Dimensional Arrays and Linear Algebra Utilities
 Authors@R: c(person("Adrian", "Baddeley", 
                     role = c("aut", "cre", "cph"),

NEWS

@@ -1,5 +1,5 @@
 
-        CHANGES IN spatstat.sparse VERSION 3.1-0.002
+        CHANGES IN spatstat.sparse VERSION 3.1-0.003
 
 OVERVIEW
 

R/sparseMarkov.R

@@ -4,7 +4,7 @@
 #'  discrete-time finite-state Markov chain simulation
 #'  using a sparse matrix representation of the transition matrix
 #'
-#'  $Revision: 1.4 $ $Date: 2026/04/10 03:58:24 $
+#'  $Revision: 1.5 $ $Date: 2026/04/11 04:25:09 $
 #'
 #'  Copyright (c) Adrian Baddeley 2026
 #'  GNU Public Licence (>= 2.0)
@@ -15,7 +15,7 @@ runSparseMarkovChain <- function(P, x0, nsteps, ...,
                                  check=TRUE,
                                  method=c("C", "interpreted")) {
   P <- as(P, "RsparseMatrix")
-  if(!inherits(P, "dgRMatrix"))
+  if(!inherits(P, "RsparseMatrix"))
     stop("Unable to convert P to a sparse matrix in row-major form",
          call.=FALSE)
   method <- match.arg(method)
@@ -25,6 +25,8 @@ runSparseMarkovChain <- function(P, x0, nsteps, ...,
   nx <- length(x0)
   if(check) {
     ra <- range(P)
+    if(!all(is.finite(ra)))
+      stop("P contains infinite, NA or NaN entries", call.=FALSE)
     if(ra[1L] < 0) stop("P contains negative entries", call.=FALSE)
     if(ra[2L] > 1) stop("P contains entries greater than 1", call.=FALSE)
     rs <- range(rowSums(P))

inst/doc/packagesizes.txt

@@ -19,4 +19,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
 "2023-03-12" "3.0-1" 15 48 0 2092 740
 "2023-10-24" "3.0-3" 15 48 0 2092 740
 "2024-06-21" "3.1-0" 15 48 0 2092 740
-"2026-04-10" "3.1-0.002" 16 49 0 2187 907
+"2026-04-11" "3.1-0.003" 16 49 0 2189 907

inst/info/packagesizes.txt

@@ -19,4 +19,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
 "2023-03-12" "3.0-1" 15 48 0 2092 740
 "2023-10-24" "3.0-3" 15 48 0 2092 740
 "2024-06-21" "3.1-0" 15 48 0 2092 740
-"2026-04-10" "3.1-0.002" 16 49 0 2187 907
+"2026-04-11" "3.1-0.003" 16 49 0 2189 907

tests/sparsemarkov.R

@@ -0,0 +1,66 @@
+#' Header for spatstat.sparse/tests/*R
+#'
+
+require(spatstat.sparse)
+ALWAYS <- FULLTEST <- TRUE
+#'    tests/sparsemarkov.R
+#'  Tests of code for Markov chain with sparse transition matrix
+#'  $Revision: 1.1 $ $Date: 2026/04/11 04:29:47 $
+
+if(!exists("ALWAYS")) ALWAYS <- TRUE
+if(!exists("FULLTEST")) FULLTEST <- ALWAYS
+
+if(FULLTEST) { 
+  local({
+    testit <- function(P, Pname, xstart=50, ns=10, np=3, walkies=TRUE) {
+      cat(paste(">>>>>> ", Pname, " <<<<<<<\n"))
+      cat("\tsingle particle, final state..\n")
+      X1 <- runSparseMarkovChain(P, x0=xstart, nsteps=ns, result="l")
+      cat("\tsingle particle, history..\n")
+      X2 <- runSparseMarkovChain(P, x0=xstart, nsteps=ns, result="h")
+      cat("\tseveral particles, final states..\n")
+      X3 <- runSparseMarkovChain(P, x0=rep(xstart, np), nsteps=ns,
+                                 result="l")
+      cat("\tseveral particles, histories..\n")
+      X4 <- runSparseMarkovChain(P, x0=rep(xstart, np), nsteps=ns,
+                                 result="h")
+      if(length(X1) != 1)
+        stop(paste(Pname, "end state was not a single particle"))
+      if(abs(X1 - xstart) > ns)
+        stop(paste(Pname, "wandered impossibly far"))
+      if(length(X2) != (ns + 1))
+        stop(paste(Pname, "history has wrong length"))
+      if(walkies && !all(abs(diff(X2)) == 1))
+        stop(paste(Pname, "jumps were not all +- 1"))
+      if(length(X3) != np)
+        stop(paste(Pname, "final number of particles was not preserved"))
+      if(max(abs(X3 - xstart)) > ns)
+        stop(paste(Pname, "some particles wandered impossibly far"))
+      if(!is.matrix(X4))
+        stop(paste(Pname, "a matrix was expected for the history"))
+      if(nrow(X4) != np)
+        stop(paste(Pname, "number of particles was not preserved"))
+      if(ncol(X4) != (ns + 1))
+        stop(paste(Pname, "histories have wrong length"))
+      if(walkies && !all(abs(apply(X4, 1, diff)) == 1))
+        stop(paste(Pname, "jumps were not all +- 1"))
+      cat("OK\n")
+      return(invisible(list(X1=X1, X2=X2, X3=X3, X4=X4)))
+    }
+      
+    #' Simple random walk
+    Pwalk <- matrix(0, 100, 100)
+    Pwalk[abs(row(Pwalk) - col(Pwalk)) == 1] <- 1
+    Pwalk <- Pwalk/rowSums(Pwalk)
+    testit(Pwalk, "Simple random walk")
+
+    #' Absorbing
+    Pabsorb <- matrix(0, 10, 10)
+    Pabsorb[row(Pabsorb) < col(Pabsorb)] <- 1
+    Pabsorb[10,10] <- 1
+    Pabsorb <- Pabsorb/rowSums(Pabsorb)
+    a <- testit(Pabsorb, "Absorbing chain", xstart=1, ns=10, walkies=FALSE)
+    if(a$X1 != 10) stop("Absorbing chain didn't absorb")
+    if(any(a$X3 != 10)) stop("Absorbing chains didn't absorb")
+  }
+)}