support for diagram objects; improved identify() methods

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: spatstat.geom
-Version: 3.2-9.021
-Date: 2024-06-15
+Version: 3.2-9.022
+Date: 2024-06-16
 Title: Geometrical Functionality of the 'spatstat' Family 
 Authors@R: c(person("Adrian", "Baddeley", 
                     role = c("aut", "cre", "cph"),

NAMESPACE

@@ -29,6 +29,7 @@ export("acedist.noshow")
 export("acedist.show")
 export("add.texture")
 export("affine")
+export("affine.diagramobj")
 export("affine.distfun")
 export("affine.im") 
 export("affine.layered")
@@ -382,6 +383,7 @@ export("fft2D")
 export("fftwAvailable")
 export("fillNA")
 export("flipxy")
+export("flipxy.diagramobj")
 export("flipxy.distfun")
 export("flipxy.im")
 export("flipxy.infline")
@@ -855,13 +857,13 @@ export("rebound.im")
 export("rebound.owin")
 export("rebound.ppp")
 export("rebound.psp")
-export("recognise.spatstat.type")
 export("rectdistmap")
 export("rectquadrat.breaks")
 export("rectquadrat.countEngine")
 export("redraw.simplepanel")
 export("reflect")
 export("reflect.default")
+export("reflect.diagramobj")
 export("reflect.distfun")
 export("reflect.im")
 export("reflect.infline")
@@ -900,6 +902,7 @@ export("rjitter")
 export("rjitter.ppp")
 export("rlinegrid")
 export("rotate")
+export("rotate.diagramobj")
 export("rotate.distfun")
 export("rotate.im")
 export("rotate.infline")
@@ -1208,6 +1211,7 @@ S3method("Summary", "imlist")
 # Automatically generated list of S3 methods
 # ......................................... 
   S3method("$", "hyperframe")
+S3method("affine", "diagramobj")
 S3method("affine", "distfun")
   S3method("affine", "im")
   S3method("affine", "layered")
@@ -1385,6 +1389,7 @@ S3method("eroded.volumes", "boxx")
  S3method("erosion", "psp")
   S3method("fardist", "owin")
   S3method("fardist", "ppp")
+S3method("flipxy", "diagramobj")
 S3method("flipxy", "distfun")
  S3method("flipxy", "im")
 S3method("flipxy", "infline")
@@ -1594,6 +1599,7 @@ S3method("rebound", "owin")
 S3method("rebound", "ppp")
 S3method("rebound", "psp")
   S3method("reflect", "default")
+S3method("reflect", "diagramobj")
 S3method("reflect", "distfun")
   S3method("reflect", "im")
 S3method("reflect", "infline")
@@ -1611,6 +1617,7 @@ S3method("rescale", "distfun")
   S3method("rescale", "unitname")
 S3method("rexplode", "ppp")
 S3method("rjitter", "ppp")
+S3method("rotate", "diagramobj")
 S3method("rotate", "distfun")
  S3method("rotate", "im")
 S3method("rotate", "infline")

NEWS

@@ -1,4 +1,4 @@
-        CHANGES IN spatstat.geom VERSION 3.2-9.021
+        CHANGES IN spatstat.geom VERSION 3.2-9.022
 
 OVERVIEW
 
@@ -8,6 +8,8 @@ OVERVIEW
 
     o Tweaked plot functions.
 
+    o More support for diagram objects.
+
     o Stability improvements and bug fixes.
 
 PACKAGE DEPENDENCE
@@ -22,8 +24,20 @@ NEW FUNCTIONS
     o default.symbolmap.ppp
     Algorithm for determining the graphical symbol map used by plot.ppp.
 
+    o affine.diagramobj, reflect.diagramobj, rotate.diagramobj
+    Methods for geometrical transformations of diagram objects.
+
 SIGNIFICANT USER-VISIBLE CHANGES
 
+    o identify.ppp
+    Automatically starts a new plot device and displays `x`
+    if there is no plot device open.
+
+    o identify.psp
+    Identified segments are highlighted. 
+    Automatically starts a new plot device and displays `x`
+    if there is no plot device open.
+
     o plot.owin
     New argument 'adj.main' controls the justification of the text
     in the main title.
@@ -95,15 +109,15 @@ DELETED FUNCTIONS
 
 BUG FIXES
 
+    o plot.ppp, default.symbolmap.ppp
+    Ignored 'zerosize' in some cases.
+    Fixed.
+
     o symbolmap
     Crashed in some instances when 'inputs' was given
     and the graphical parameters included both functions and vectors.
     Fixed.
 
-    o plot.ppp, default.symbolmap.ppp
-    Ignored 'zerosize' in some cases.
-    Fixed.
-
         CHANGES IN spatstat.geom VERSION 3.2-9
 
 OVERVIEW

R/diagram.R

@@ -4,7 +4,7 @@
 ##   Simple objects for the elements of a diagram (text, arrows etc)
 ##    that are compatible with plot.layered and plot.solist
 ##
-##   $Revision: 1.15 $ $Date: 2024/02/04 08:04:51 $
+##   $Revision: 1.18 $ $Date: 2024/06/16 02:03:14 $
 
 # ......... internal class 'diagramobj' supports other classes  .........
 
@@ -25,8 +25,28 @@ diagramobj <- function(X, ...) {
   return(y)
 }
 
-shift.diagramobj <- function(X, ...) {
-  y <- NextMethod("shift")
+# ... geometrical transformations ....
+
+affine.diagramobj <- function(X, ...) {
+  y <- NextMethod("affine")
+  attributes(y) <- attributes(X)
+  return(y)
+}
+
+flipxy.diagramobj <- function(X) {
+  y <- NextMethod("flipxy")
+  attributes(y) <- attributes(X)
+  return(y)
+}
+
+reflect.diagramobj <- function(X) {
+  y <- NextMethod("reflect")
+  attributes(y) <- attributes(X)
+  return(y)
+}
+
+rotate.diagramobj <- function(X, ...) {
+  y <- NextMethod("rotate")
   attributes(y) <- attributes(X)
   return(y)
 }
@@ -37,6 +57,12 @@ scalardilate.diagramobj <- function(X, f, ...) {
   return(y)
 }
 
+shift.diagramobj <- function(X, ...) {
+  y <- NextMethod("shift")
+  attributes(y) <- attributes(X)
+  return(y)
+}
+
 # .............. user-accessible classes ................
 # .........  (these only need a creator and a plot method) ......
 

R/ppp.R

@@ -4,7 +4,7 @@
 #	A class 'ppp' to define point patterns
 #	observed in arbitrary windows in two dimensions.
 #
-#	$Revision: 4.116 $	$Date: 2024/04/19 09:34:39 $
+#	$Revision: 4.118 $	$Date: 2024/06/16 02:03:00 $
 #
 #	A point pattern contains the following entries:	
 #
@@ -636,6 +636,9 @@ print.summary.ppp <- function(x, ..., dp=getOption("digits")) {
 
 identify.ppp <- function(x, ...) {
   verifyclass(x, "ppp")
+  if(dev.cur() == 1 && interactive()) {
+    eval(substitute(plot(X), list(X=substitute(x))))
+  }
   id <- identify(x$x, x$y, ...)
   if(!is.marked(x)) return(id)
   marks <- as.data.frame(x)[id, -(1:2)]

R/psp.R

@@ -1,7 +1,7 @@
 #
 #  psp.R
 #
-#  $Revision: 1.112 $ $Date: 2024/02/04 08:04:51 $
+#  $Revision: 1.116 $ $Date: 2024/06/16 02:06:24 $
 #
 # Class "psp" of planar line segment patterns
 #
@@ -578,27 +578,34 @@ is.empty.psp <- function(x) { return(x$n == 0) }
 
 identify.psp <- function(x, ..., labels=seq_len(nsegments(x)),
                          n=nsegments(x), plot=TRUE) {
+  if(dev.cur() == 1 && interactive()) {
+    eval(substitute(plot(X), list(X=substitute(x))))
+  }
   Y <- x
-  W <- as.owin(Y)
+  B <- Frame(Y)
+  Bplus <- grow.rectangle(B, max(sidelengths(B))/4)
   mids <- midpoints.psp(Y)
-  poz <- c(1, 2,4, 3)[(floor(angles.psp(Y)/(pi/4)) %% 4) + 1L]
+  poz <- c(1, 2, 4, 3)[(floor(angles.psp(Y)/(pi/4)) %% 4) + 1L]
+  gp <- if(plot) graphicsPars("lines") else NULL
   if(!(is.numeric(n) && (length(n) == 1) && (n %% 1 == 0) && (n >= 0)))
     stop("n should be a single integer")
   out <- integer(0)
   while(length(out) < n) {
-    xy <- spatstatLocator(1)
-    # check for interrupt exit
+    xy <- spatstatLocator(1, type="n")
+    ## check for interrupt exit
     if(length(xy$x) == 0)
       return(out)
-    # find nearest segment
-    X <- ppp(xy$x, xy$y, window=W)
+    ## find nearest segment
+    X <- ppp(xy$x, xy$y, window=Bplus)
     ident <- project2segment(X, Y)$mapXY
-    # add to list
-    if(ident %in% out) {
+    if(length(ident) == 0) {
+      cat("Query location is too far away\n")
+    } else if(ident %in% out) {
       cat(paste("Segment", ident, "already selected\n"))
     } else {
+      ## add to list
       if(plot) {
-        # Display
+        ## Display
         mi <- mids[ident]
         li <- labels[ident]
         po <- poz[ident]
@@ -607,15 +614,20 @@ identify.psp <- function(x, ..., labels=seq_len(nsegments(x)),
         dont.complain.about(li, mix, miy)
         do.call.matched(graphics::text.default,
                         resolve.defaults(list(x=quote(mix), 
-					      y=quote(miy), 
-				              labels=quote(li)),
+                                              y=quote(miy), 
+                                              labels=quote(li)),
                                          list(...),
                                          list(pos=po)))
+        do.call.matched(plot.psp,
+                        resolve.defaults(list(x=Y[ident], add=TRUE),
+                                         list(...),
+                                         list(col="blue", lwd=2)),
+                        extrargs=gp)
       }
       out <- c(out, ident)
     }
   }
-  # exit if max n reached
+  ## exit if max n reached
   return(out)
 }
 

R/solist.R

@@ -7,7 +7,7 @@
 ##
 ## plot.solist is defined in plot.solist.R
 ##
-## $Revision: 1.28 $ $Date: 2022/08/27 04:11:07 $
+## $Revision: 1.29 $ $Date: 2024/06/16 02:20:05 $
 
 anylist <- function(...) {
   x <- list(...)
@@ -69,9 +69,9 @@ is.sob <- local({
                       "funxy", "distfun", "nnfun", 
                       "lpp", "linnet", "linfun", "lintess",  
                       "influence.ppm", "leverage.ppm")
-  # Note 'linim' inherits 'im'
-  #      'dfbetas.ppm' inherits 'msr'
-
+  ## Note 'linim' inherits 'im'
+  ##      'dfbetas.ppm' inherits 'msr'
+  ##      diagram objects typically inherit 'ppp'
   is.sob <- function(x) { inherits(x, what=sobjectclasses) }
   is.sob
 })

inst/doc/packagesizes.txt

@@ -26,4 +26,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
 "2023-10-20" "3.2-7" 451 1203 0 35983 15822
 "2024-01-26" "3.2-8" 452 1204 0 36234 15822
 "2024-02-28" "3.2-9" 452 1209 0 36325 15824
-"2024-06-15" "3.2-9.021" 443 1186 0 35690 15596
+"2024-06-16" "3.2-9.022" 443 1189 0 35731 15596