Improvements to persp.ppp

DESCRIPTION

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

NEWS

@@ -1,4 +1,4 @@
-        CHANGES IN spatstat.geom VERSION 3.3-3.003
+        CHANGES IN spatstat.geom VERSION 3.3-3.004
 
 OVERVIEW
 
@@ -17,6 +17,10 @@ SIGNIFICANT USER-VISIBLE CHANGES
 
     o pixelquad
     Now accepts arguments passed to 'as.mask' to control the pixel resolution.
+
+    o persp.ppp
+    Now draws a reference scale bar for the vertical scale.
+    New arguments 'legend', 'legendpos', 'leg.args', 'leg.col'.
 
         CHANGES IN spatstat.geom VERSION 3.3-3
 

R/persp.ppp.R

@@ -5,7 +5,7 @@
 #'  Copyright (C) Adrian Baddeley 2024
 #'  GPL Public Licence >= 2.0
 #'
-#' $Revision: 1.3 $ $Date: 2024/09/07 01:34:04 $
+#' $Revision: 1.4 $ $Date: 2024/10/24 03:32:24 $
 
 persp.ppp <- local({
 
@@ -15,7 +15,10 @@ persp.ppp <- local({
                         spike.args=list(),
                         neg.args=list(), which.marks=1,
                         zlab=NULL, zlim=NULL,
-                        zadjust=1) {
+                        zadjust=1,
+                        legend=TRUE, legendpos="bottomleft",
+                        leg.args=list(lwd=4),
+                        leg.col=c("black", "orange")) {
     if(missing(main)) main <- short.deparse(substitute(x))
     W <- Window(x)
     R <- Frame(x)
@@ -50,24 +53,29 @@ persp.ppp <- local({
            stop("marks should be a vector or a data frame", call.=FALSE)
            )
     marx <- as.numeric(marx)
+    if(is.null(zlim)) zlim <- range(marx, 0)
     #' rescale marks to a scale commensurate with window
     #'  (to achieve appropriate default scale in persp.default)
     maxmark <- max(abs(marx))
     if(maxmark > .Machine$double.eps) {
-      marx <- marx * (max(sidelengths(R))/maxmark)
+      scal <- max(sidelengths(R))/maxmark
+      scaled.marx <- scal * marx
+      scaled.zlim <- scal * zlim
+    } else {
+      scaled.marx <- marx
+      scaled.zlim <- zlim
     }
     #' set up perspective transformation and plot horizontal plane
     Rplus <- grow.rectangle(R, fraction=1/(2*ngrid))
     Z <- as.im(0, W=Rplus, dimyx=rev(ngrid)+1)
-    if(is.null(zlim)) zlim <- range(marx, 0)
     check.range(zlim)
     col.grid.used <- if(grid && (zlim[1] >= 0)) col.grid else NA
     argh <- resolve.defaults(list(x=Z, main=main,
                                   border=col.grid.used,
                                   col=col.base),
                              dotargs,
                              list(axes=FALSE, box=FALSE,
-                                  zlim=zlim, zlab=zlab,
+                                  zlim=scaled.zlim, zlab=zlab,
                                   #' do not independently rescale x & y
                                   scale=FALSE,
                                   #' expand=0.1 is default in persp.default
@@ -76,11 +84,11 @@ persp.ppp <- local({
                          funargs=graphicsPars("persp"))
     #' create spikes
     S <- xyzsegmentdata(x$x, x$y, 0,
-                        x$x, x$y, marx)
+                        x$x, x$y, scaled.marx)
     if(grid) {
-      if(zlim[1] < 0) {
+      if(scaled.zlim[1] < 0) {
         #' first draw downward spikes
-        downward <- (marx < 0)
+        downward <- (scaled.marx < 0)
         if(any(downward)) {
           SD <- S[downward, , drop=FALSE]
           spectiveSegments(SD, neg.args, spike.args, ..., M=M)
@@ -98,7 +106,38 @@ persp.ppp <- local({
     if(nrow(S) > 0) {
       spectiveSegments(S, spike.args, dotargs, M=M)
     }
-    #'   
+    #'
+    if(legend) {
+      #' draw a reference scale as another spike
+      #' determine spike position
+      if(is.character(legendpos)) {
+        legendpos <- match.arg(legendpos, c("bottomleft", "bottomright",
+                                            "topleft", "topright",
+                                            "bottom", "left", "top", "right"))
+        B <- Frame(x)
+        xr <- B$xrange
+        yr <- B$yrange
+        legxy <- switch(legendpos,
+                        bottomleft = c(xr[1], yr[1]),
+                        bottomright = c(xr[2], yr[1]),
+                        topleft = c(xr[1], yr[2]),
+                        topright = c(xr[2], yr[2]),
+                        bottom = c(mean(xr), yr[1]),
+                        left = c(xr[1], mean(yr)),
+                        top = c(mean(xr), yr[2]),
+                        right = c(xr[2], mean(yr)))
+      } else legxy <- ensure2vector(unlist(legendpos))
+      #' determine tickmarks
+      tix <- unique(sort(c(zlim, prettyinside(zlim))))
+      ntix <- length(tix)
+      scaled.tix <- scal * tix
+      tixseg <- xyzsegmentdata(legxy[1], legxy[2], scaled.tix[-ntix],
+                               legxy[1], legxy[2], scaled.tix[-1])
+      tixcol <- rep(leg.col, ntix)[1:ntix]
+      spectiveSegments(tixseg, list(col=tixcol), leg.args, spike.args, M=M)
+      spectiveText(legxy[1], legxy[2], scaled.tix[-c(1,ntix)],
+                   labels=tix[-c(1,ntix)], pos=4, M=M)
+    }
     invisible(M)
   }
 
@@ -156,6 +195,11 @@ persp.ppp <- local({
     invisible(NULL)
   }
 
+  spectiveText <- function(x,y,z, ..., M) {
+    p <- trans3dz(x, y, z, M)
+    text(p$x, p$y, ...)
+  }
+
   persp.ppp
 })
 

inst/doc/packagesizes.txt

@@ -29,4 +29,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
 "2024-07-05" "3.3-0" 442 1186 0 35638 15596
 "2024-07-09" "3.3-2" 442 1186 0 35638 15596
 "2024-09-18" "3.3-3" 443 1187 0 35818 15596
-"2024-10-17" "3.3-3.003" 443 1188 0 35892 15596
+"2024-10-24" "3.3-3.004" 443 1188 0 35936 15596

inst/info/packagesizes.txt

@@ -29,4 +29,4 @@ date version nhelpfiles nobjects ndatasets Rlines srclines
 "2024-07-05" "3.3-0" 442 1186 0 35638 15596
 "2024-07-09" "3.3-2" 442 1186 0 35638 15596
 "2024-09-18" "3.3-3" 443 1187 0 35818 15596
-"2024-10-17" "3.3-3.003" 443 1188 0 35892 15596
+"2024-10-24" "3.3-3.004" 443 1188 0 35936 15596

man/persp.ppp.Rd

@@ -12,7 +12,9 @@
   \method{persp}{ppp}(x, \dots, main, grid = TRUE, ngrid = 10,
             col.grid = "grey", col.base = "white",
             win.args=list(), spike.args = list(), neg.args = list(),
-            which.marks = 1, zlab = NULL, zlim = NULL, zadjust = 1)
+            which.marks = 1, zlab = NULL, zlim = NULL, zadjust = 1,
+            legend=TRUE, legendpos="bottomleft",
+            leg.args=list(lwd=4), leg.col=c("black", "orange"))
 }
 \arguments{
   \item{x}{
@@ -74,6 +76,29 @@
   \item{zadjust}{
     Scale adjustment factor controlling the height of spikes.
   }
+  \item{legend}{
+    Logical value specifying whether to draw a reference scale bar for the
+    vertical axis.
+  }
+  \item{legendpos}{
+    Position of the reference scale bar. Either a character string
+    matching one of the options
+    \code{"bottomleft"}, \code{"bottomright"},
+    \code{"topleft"}, \code{"topright"},
+    \code{"bottom"}, \code{"left"}, \code{"top"} or \code{"right"},
+    or a numeric vector of length 2 specifing the coordinate position
+    of the base of the reference scale bar.
+  }
+  \item{leg.args}{
+    Additional arguments passed to \code{\link[graphics]{segments}}
+    to control the drawing of the reference scale bar.
+  }
+  \item{leg.col}{
+    A vector (usually of length 2) of colour values
+    for successive intervals in the reference scale.
+    The default is a reference scale consisting of
+    black and orange stripes.
+  }
 }
 \details{
   The function \code{\link[graphics]{persp}} is generic. This is the