rjitter has new argument and returns more info

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: spatstat.geom
-Version: 3.3-2.002
-Date: 2024-09-07
+Version: 3.3-2.004
+Date: 2024-09-09
 Title: Geometrical Functionality of the 'spatstat' Family 
 Authors@R: c(person("Adrian", "Baddeley", 
                     role = c("aut", "cre", "cph"),

NEWS

@@ -1,8 +1,10 @@
-        CHANGES IN spatstat.geom VERSION 3.3-2.002
+        CHANGES IN spatstat.geom VERSION 3.3-2.004
 
 OVERVIEW
 
     o Perspective plot of spatial point pattern with numerical marks.
+
+    o Improvements to rjitter.ppp
 
     o Tweaks to documentation.
 
@@ -13,6 +15,12 @@ NEW FUNCTIONS
     generate a perspective plot in which each data point is
     shown as a vertical spike, with height proportional to the mark value.
 
+SIGNIFICANT USER-VISIBLE CHANGES
+
+    o rjitter.ppp
+    New argument 'adjust' allows the default radius to be adjusted.
+    The resulting point pattern now has attribute 'radius'.
+
         CHANGES IN spatstat.geom VERSION 3.3-2
 
 OVERVIEW

R/randombasic.R

@@ -7,7 +7,7 @@
 #'    rsyst()           systematic random (randomly-displaced grid)
 #'    rjitter()         random perturbation
 #'
-#'   $Revision: 1.17 $  $Date: 2024/06/09 00:11:04 $
+#'   $Revision: 1.18 $  $Date: 2024/09/09 01:43:21 $
 
 
 simulationresult <- function(resultlist, nsim=length(resultlist), drop=TRUE, NameBase="Simulation") {
@@ -106,7 +106,7 @@ rjitter <- function(X, ...) {
 }
 
 rjitter.ppp <- function(X, radius, retry=TRUE, giveup=10000, trim=FALSE, ...,
-                        nsim=1, drop=TRUE) {
+                        nsim=1, drop=TRUE, adjust=1) {
   verifyclass(X, "ppp")
   if(!missing(nsim)) {
     check.1.integer(nsim)
@@ -119,11 +119,11 @@ rjitter.ppp <- function(X, radius, retry=TRUE, giveup=10000, trim=FALSE, ...,
     result <- simulationresult(result, nsim, drop)
     return(result)
   }
+  #' determine the jitter radius
   if(missing(radius) || is.null(radius)) {
-    ## Stoyan rule of thumb
+    ## default: Stoyan rule of thumb
     bws <- 0.15/sqrt(5 * nX/area(W))
     radius <- min(bws, shortside(Frame(W)))
-    sameradius <- TRUE
   } else {
     ## either one radius, or a vector of radii
     check.nvector(radius, nX, oneok=TRUE, vname="radius")
@@ -132,29 +132,45 @@ rjitter.ppp <- function(X, radius, retry=TRUE, giveup=10000, trim=FALSE, ...,
       warning("Negative values of jitter radius were set to zero")
       radius <- pmax(0, radius)
     }
-    sameradius <- (length(radius) == 1)
   }
-  #'
-  if(isTRUE(trim)) {
+  #' trim?
+  if(isTRUE(trim)) 
     radius <- pmin(radius, bdist.points(X))
-    sameradius <- FALSE
+  #' adjust the jitter radius
+  if(!missing(adjust)) {
+    check.nvector(adjust, nX, oneok=TRUE, vname="adjust")
+    if(min(adjust) < 0) {
+      nbad <- sum(adjust < 0)
+      howmanyvalues <- if(length(adjust) == 1) {
+                         "the value"
+                       } else {
+                         paste(nbad, ngettext(nbad, "value", "values"))
+                       }
+      warning(paste("Negative sign was ignored in",
+                    howmanyvalues, "of", sQuote("adjust")),
+              call.=FALSE)
+      adjust <- abs(adjust)
+    }
+    radius <- adjust * radius
   }
   #'
+  sameradius <- (length(radius) == 1)
+  #' start jitterin'
   result <- vector(mode="list", length=nsim)
-  Xshift <- X
   for(isim in seq_len(nsim)) {
+    Xshift <- X
     if(!retry) {
       ## points outside window are lost
       rD <- radius * sqrt(runif(nX))
       aD <- runif(nX, max= 2 * pi)
-      Xshift$x <- X$x + rD * cos(aD)
-      Xshift$y <- X$y + rD * sin(aD)
-      result[[isim]] <- Xshift[W]
+      Xshift$x <- xx <- X$x + rD * cos(aD)
+      Xshift$y <- yy <- X$y + rD * sin(aD)
+      ok <- inside.owin(xx, yy, W)
+      Xshift <- Xshift[ok]
     } else {
       ## retry = TRUE: condition on points being inside window
       undone <- rep.int(TRUE, nX)
       triesleft <- giveup
-      Xshift <- X
       while(any(undone)) {
         triesleft <- triesleft - 1
         if(triesleft <= 0) 
@@ -174,8 +190,10 @@ rjitter.ppp <- function(X, radius, retry=TRUE, giveup=10000, trim=FALSE, ...,
           undone[changed] <- FALSE
         }
       }
-      result[[isim]] <- Xshift
+      attr(Xshift, "tries") <- giveup - triesleft
     }
+    attr(Xshift, "radius") <- radius
+    result[[isim]] <- Xshift
   }
   result <- simulationresult(result, nsim, drop)
   return(result)

inst/doc/packagesizes.txt

@@ -28,4 +28,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
 "2024-02-28" "3.2-9" 452 1209 0 36325 15824
 "2024-07-05" "3.3-0" 442 1186 0 35638 15596
 "2024-07-09" "3.3-2" 442 1186 0 35638 15596
-"2024-09-07" "3.3-2.002" 443 1187 0 35800 15596
+"2024-09-09" "3.3-2.004" 443 1187 0 35818 15596

inst/info/packagesizes.txt

@@ -28,4 +28,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
 "2024-02-28" "3.2-9" 452 1209 0 36325 15824
 "2024-07-05" "3.3-0" 442 1186 0 35638 15596
 "2024-07-09" "3.3-2" 442 1186 0 35638 15596
-"2024-09-07" "3.3-2.002" 443 1187 0 35800 15596
+"2024-09-09" "3.3-2.004" 443 1187 0 35818 15596

man/rjitter.Rd

@@ -10,7 +10,7 @@
 rjitter(X, \dots)
 
 \method{rjitter}{ppp}(X, radius, retry=TRUE, giveup = 10000, trim=FALSE,
-        \dots, nsim=1, drop=TRUE)
+        \dots, nsim=1, drop=TRUE, adjust=1)
 }
 \arguments{
   \item{X}{
@@ -47,11 +47,18 @@ rjitter(X, \dots)
     result will be a point pattern, rather than a list 
     containing a point pattern.
   }
+  \item{adjust}{
+    Adjustment factor applied to the radius.
+    A numeric value or numeric vector.
+  }
 }
 \value{
   The result of \code{rjitter.ppp} is
   a point pattern (an object of class \code{"ppp"})
   or a list of point patterns.
+
+  Each point pattern has attributes \code{"radius"}
+  and (if \code{retry=TRUE}) \code{"tries"}.
 }
 \details{
   The function \code{rjitter} is generic, with methods for point
@@ -65,19 +72,32 @@ rjitter(X, \dots)
   \code{retry=FALSE} the point will be lost. 
 
   However if \code{retry=TRUE}, the algorithm will try again: each time a
-  perturbed point lies outside the window, the algorithm will reject it and
+  perturbed point lies outside the window, the algorithm will reject
+  the perturbed point and
   generate another proposed perturbation of the original point,
   until one lies inside the window, or until \code{giveup} unsuccessful
   attempts have been made. In the latter case, any unresolved points
-  will be included without any perturbation. The return value will
+  will be included, without any perturbation. The return value will
   always be a point pattern with the same number of points as \code{X}.
 
   If \code{trim=TRUE}, then the displacement radius for each data point
   will be constrained to be less than or equal to 
   the distance from the data point to the window boundary.
   This ensures that the randomly displaced points will
   always fall inside the window; no displaced points will be lost and no
-  retrying will be required.
+  retrying will be required. However, it implies that a point lying
+  exactly on the boundary will never be perturbed.
+
+  If \code{adjust} is given, the jittering radius will be multiplied
+  by \code{adjust}. This allows the user to specify
+  that the radius should be a multiple of the default radius.
+
+  The resulting point pattern
+  has an attribute \code{"radius"} giving the value
+  of \code{radius} used.
+  If \code{retry=TRUE}, the resulting point pattern also has an attribute
+  \code{"tries"} reporting the maximum number of trials needed to
+  ensure that all jittered points were inside the window.
 }
 \examples{
    X <- rsyst(owin(), 10, 10)

man/spatstat.geom-package.Rd

@@ -147,6 +147,8 @@
 	plot a point pattern (e.g. \code{plot(X)}) \cr
 	\code{spatstat.gui::iplot} \tab
 	plot a point pattern interactively \cr 
+	\code{\link{persp.ppp}} \tab
+	perspective plot of marked point pattern \cr
 	\code{\link{edit.ppp}} \tab interactive text editor \cr
 	\code{\link{[.ppp}} \tab 
 	extract or replace a subset of a point pattern \cr