Tidied

Author: baddstats

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: spatstat.sparse
-Version: 3.1-0.005
-Date: 2026-04-11
+Version: 3.1-0.006
+Date: 2026-04-23
 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.005
+        CHANGES IN spatstat.sparse VERSION 3.1-0.006
 
 OVERVIEW
 

R/sparseMarkov.R

@@ -36,6 +36,11 @@ runSparseMarkovChain <- function(P, x0, nsteps, ...,
     if(rx[1L] < 1 || rx[2L] > nrow(P))
       stop("Some indices in x0 are out of range", call.=FALSE)
   }
+
+  nentries <- length(P@x)
+  if(nentries > .Machine$integer.max || is.na(as.integer(nentries)))
+    stop("Sorry, long vectors are not yet supported", call.=FALSE)
+  
   ## >>>>>>>>>>>>  run chain  <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
   switch(method,
          interpreted = {

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-11" "3.1-0.005" 16 49 0 2189 944
+"2026-04-23" "3.1-0.006" 16 49 0 2194 943

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-11" "3.1-0.005" 16 49 0 2189 944
+"2026-04-23" "3.1-0.006" 16 49 0 2194 943

man/macros/defns.Rd

@@ -7,6 +7,7 @@
 \newcommand{\spatstatAuthorsComma}{\adrian, \rolf, \ege}
 %% Contributors with emails (alphabetical order)
 \newcommand{\abdollah}{Abdollah Jalilian \email{jalilian@razi.ac.ir}}
+\newcommand{\bethany}{Bethany Macdonald \email{bethany.macdonald@canterbury.ac.nz}}
 \newcommand{\colette}{Marie-Colette van Lieshout \email{Marie-Colette.van.Lieshout@cwi.nl}}
 \newcommand{\dominic}{Dominic Schuhmacher \email{dominic.schuhmacher@mathematik.uni-goettingen.de}, URL \code{http://dominic.schuhmacher.name/}}
 \newcommand{\martinH}{Martin Hazelton \email{Martin.Hazelton@otago.ac.nz}}

src/rmarkovchain.c

@@ -23,7 +23,7 @@
 
   The indices in 'colindex' and 'rowstart' are zero-based.
 
-  $Revision: 1.8 $ $Date: 2026/04/11 09:54:48 $
+  $Revision: 1.9 $ $Date: 2026/04/15 03:49:20 $
 
   Copyright (c) Adrian Baddeley 2026
   GNU Public Licence (>= 2.0)
@@ -35,9 +35,9 @@
 #include <math.h>
 
 /* rMCspMF
-   Run 'M'ultiple independent realisations
-   from different starting points, 
-   and return only the 'F'inal states 
+   'r'un 'M'arkov 'C'hain for 'sp'arse matrix
+   'M'ultiple independent realisations from different starting points, 
+   return only the 'F'inal states 
 */
 
 void rMCspMF(
@@ -114,9 +114,9 @@ void rMCspMF(
 
 
 /* rMCspMH
-   Run 'M'ultiple independent realisations
-   from different starting points, 
-   and return the 'H'istory of each point.
+   'r'un 'M'arkov 'C'hain for 'sp'arse matrix
+   'M'ultiple independent realisations from different starting points
+   return the 'H'istory of each point.
 */
 
 void rMCspMH(
@@ -197,4 +197,3 @@ void rMCspMH(
   PutRNGstate();
 }
 
-	      

tests/sparsemarkov.R

@@ -5,14 +5,15 @@ 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 $
+#'  $Revision: 1.3 $ $Date: 2026/04/23 05:20:03 $
 
 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) {
+    testit <- function(P, Pname, xstart=50, ns=10, np=3,
+                       walkies=FALSE, absorb=NULL) {
       cat(paste(">>>>>> ", Pname, " <<<<<<<\n"))
       cat("\tsingle particle, final state..\n")
       X1 <- runSparseMarkovChain(P, x0=xstart, nsteps=ns, result="l")
@@ -26,24 +27,40 @@ if(FULLTEST) {
                                  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"))
+
+      if(walkies) {
+        ## jumps are all +-1
+        if(abs(X1 - xstart) > ns)
+          stop(paste(Pname, "wandered impossibly far"))
+        if(!all(abs(diff(X2)) == 1))
+          stop(paste(Pname, "jumps were not all +- 1"))
+        if(max(abs(X3 - xstart)) > ns)
+          stop(paste(Pname, "some particles wandered impossibly far"))
+        if(!all(abs(apply(X4, 1, diff)) == 1))
+          stop(paste(Pname, "jumps of particles were not all +- 1"))
+      }
+
+      if(!is.null(absorb)) {
+        if(X1 != absorb)
+          stop("Absorbing chain didn't absorb (final)")
+        if(X2[ns+1] != absorb)
+          stop("Absorbing chain didn't absorb (history)")
+        if(any(X3 != absorb))
+          stop("Absorbing chains didn't absorb (final)")
+        if(any(X4[,ns+1] != absorb))
+          stop("Absorbing chains didn't absorb (history)")
+      }
+      
       cat("OK\n")
       return(invisible(list(X1=X1, X2=X2, X3=X3, X4=X4)))
     }
@@ -52,15 +69,13 @@ if(FULLTEST) {
     Pwalk <- matrix(0, 100, 100)
     Pwalk[abs(row(Pwalk) - col(Pwalk)) == 1] <- 1
     Pwalk <- Pwalk/rowSums(Pwalk)
-    testit(Pwalk, "Simple random walk")
+    testit(Pwalk, "Simple random walk", walkies=TRUE)
 
     #' Absorbing
     Pabsorb <- matrix(0, 10, 10)
     Pabsorb[row(Pabsorb) < col(Pabsorb)] <- 1
-    Pabsorb[10,10] <- 1
+    Pabsorb[,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")
+    a <- testit(Pabsorb, "Absorbing chain", xstart=1, ns=10, absorb=10)
   }
 )}