More work on colour/symbol/texture maps

DESCRIPTION

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

NEWS

@@ -1,10 +1,12 @@
-        CHANGES IN spatstat.geom VERSION 3.3-4.004
+        CHANGES IN spatstat.geom VERSION 3.3-4.005
 
 OVERVIEW
 
     o We thank Stephanie Hogg for contributions.
 
     o Improvements to plotting of images, and arrays of images.
+
+    o More control over plotting of colour maps, symbol maps and texture maps.
 
     o Bug fix
 
@@ -28,6 +30,15 @@ SIGNIFICANT USER-VISIBLE CHANGES
 
     o plot.imlist, image.imlist, image.listof
     New argument 'equal.scales'.
+
+    o plot.colourmap
+    New formal argument 'side'.
+
+    o plot.symbolmap
+    New formal argument 'side'.
+
+    o plot.texturemap
+    New formal argument 'side'.
 
 BUG FIXES
 

R/colourtables.R

@@ -3,7 +3,7 @@
 #
 # support for colour maps and other lookup tables
 #
-# $Revision: 1.61 $ $Date: 2024/11/28 01:51:29 $
+# $Revision: 1.62 $ $Date: 2024/11/29 07:41:16 $
 #
 
 colourmap <- function(col, ..., range=NULL, breaks=NULL, inputs=NULL, gamma=1) {
@@ -224,8 +224,9 @@ plot.colourmap <- local({
       stopifnot(side %in% 1:4)
       sidecode <- side
     } else if(is.character(side)) {
-      stopifnot(side %in% c("bottom", "left", "top", "right"))
-      sidecode <- match(side, c("bottom", "left", "top", "right"))
+      nama <- c("bottom", "left", "top", "right")
+      side <- match.arg(side, nama)
+      sidecode <- match(side, nama)
     } else stop("Unrecognised format for 'side'")
     return(sidecode)
   }

R/plot.anylist.R

@@ -633,7 +633,8 @@ plot.imlist <- local({
       ribadorn <- list()
     } else if(equal.scales) {
       ## colour ribbon will be aligned with objects in plot
-      ribadorn <- list(imcolmap)
+      ribadorn <- list(adorn=imcolmap,
+                       adorn.args=append(ribargs, list(labelmap=ribscale)))
       names(ribadorn)[1] <- paste("adorn", ribside, sep=".")
     } else {
       ## colour ribbon will be "free-floating"

R/texture.R

@@ -3,7 +3,7 @@
 ##
 ##     Texture plots and texture maps
 ##
-##  $Revision: 1.17 $ $Date: 2024/02/04 08:04:51 $
+##  $Revision: 1.19 $ $Date: 2024/11/29 07:44:37 $
 
 ### .................. basic graphics .............................
 
@@ -129,10 +129,24 @@ plot.texturemap <- local({
     (if(separate) (n + (n-1)*gap) else 10) * diff(widthrange) 
   }
 
+  sideCode <- function(side) {
+    if(is.numeric(side)) {
+      stopifnot(side %in% 1:4)
+      sidecode <- side
+    } else if(is.character(side)) {
+      nama <- c("bottom", "left", "top", "right")
+      side <- match.arg(side, nama)
+      sidecode <- match(side, nama)
+    } else stop("Unrecognised format for 'side'")
+    return(sidecode)
+  }
+
   plot.texturemap <- function(x, ..., main,
-                             xlim=NULL, ylim=NULL, vertical=FALSE, axis=TRUE,
-                             labelmap=NULL, gap=0.25,
-                             spacing=NULL, add=FALSE) {
+                              xlim=NULL, ylim=NULL,
+                              vertical=FALSE, axis=TRUE,
+                              side = if(vertical) "right" else "bottom",
+                              labelmap=NULL, gap=0.25,
+                              spacing=NULL, add=FALSE) {
     if(missing(main))
       main <- short.deparse(substitute(x))
     df <- attr(x, "df")
@@ -144,6 +158,8 @@ plot.texturemap <- local({
     if(is.null(labelmap)) {
       labelmap <- function(x) x
     } else stopifnot(is.function(labelmap))
+    if(missing(vertical) && !missing(side))
+      vertical <- (sideCode(side) %in% c(2, 4))
     ## determine rectangular window for display
     rr <- c(0, n + (n-1)*gap)
     if(is.null(xlim) && is.null(ylim)) {
@@ -208,27 +224,29 @@ plot.texturemap <- local({
       if(!vertical) {
         ## add horizontal axis/annotation
         at <- lapply(lapply(boxes, centroid.owin), "getElement", name="x")
-        # default axis position is below the ribbon (side=1)
-        sidecode <- resolve.1.default("side", list(...), list(side=1))
+        sidecode <- sideCode(side)
         if(!(sidecode %in% c(1,3)))
-          warning(paste("side =", sidecode,
+          warning(paste("side =",
+                        if(is.character(side)) sQuote(side) else side,
                         "is not consistent with horizontal orientation"))
         pos <- c(ylim[1], xlim[1], ylim[2], xlim[2])[sidecode]
         # don't draw axis lines if plotting separate blocks
         lwd0 <- if(separate) 0 else 1
         # draw axis
         do.call.matched(graphics::axis,
                         resolve.defaults(list(...),
-                                         list(side = 1, pos = pos, at = at),
+                                         list(side = sidecode,
+                                              pos = pos, at = at),
                                          list(labels=la, lwd=lwd0)),
                         extrargs=axisparams)
       } else {
         ## add vertical axis
         at <- lapply(lapply(boxes, centroid.owin), "getElement", name="y")
         # default axis position is to the right of ribbon (side=4)
-        sidecode <- resolve.1.default("side", list(...), list(side=4))
+        sidecode <- sideCode(side)
         if(!(sidecode %in% c(2,4)))
-          warning(paste("side =", sidecode,
+          warning(paste("side =",
+                        if(is.character(side)) sQuote(side) else side,
                         "is not consistent with vertical orientation"))
         pos <- c(ylim[1], xlim[1], ylim[2], xlim[2])[sidecode]
         # don't draw axis lines if plotting separate blocks
@@ -238,7 +256,7 @@ plot.texturemap <- local({
         # draw axis
         do.call.matched(graphics::axis,
                         resolve.defaults(list(...),
-                                         list(side=4, pos=pos, at=at),
+                                         list(side=sidecode, pos=pos, at=at),
                                          list(labels=la, lwd=lwd0, las=las0)),
                         extrargs=axisparams)
       }
@@ -333,8 +351,20 @@ textureplot <- local({
     if(do.plot) {
       ## Plot textures
       if(!add) {
-        plot(bb.all, type="n", main="")
-        fakemaintitle(bb, main, ...)
+        switch(leg.side,
+               left = ,
+               right = {
+                 bb.full <- bb.all
+                 bb.titled <- bb
+               },
+               bottom = ,
+               top = {
+                 bb.full <- grow.rectangle(bb.all, 0,
+                                           c(0, 0.1 * diff(bb.all$yrange)))
+                 bb.titled <- bb.all
+               })
+        plot(bb.full, type="n", main="")
+        fakemaintitle(bb.titled, main, ...)
       }
       if(is.null(spacing)) spacing <- diameter(as.rectangle(x))/50
       areas <- if(is.im(x)) table(x$v) else tile.areas(x)

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-11-28" "3.3-4.004" 444 1190 0 36091 15596
+"2024-11-29" "3.3-4.005" 444 1190 0 36123 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-11-28" "3.3-4.004" 444 1190 0 36091 15596
+"2024-11-29" "3.3-4.005" 444 1190 0 36123 15596

man/plot.imlist.Rd

@@ -89,7 +89,10 @@
  ## bei.extra is a list of pixel images on the same spatial domain
  Y <- solapply(bei.extra, scaletointerval)
  image(Y, equal.ribbon=TRUE, equal.scales=TRUE,
-          main="", col.ticks="red", col.axis="red")
+          main="",
+          mar.panel=0, hsep=1,
+          ribside="bottom",
+          col.ticks="blue", col.axis="blue", cex.axis=1.2)
 }
 \author{
   \spatstatAuthors.

man/plot.texturemap.Rd

@@ -10,6 +10,7 @@
 \usage{
  \method{plot}{texturemap}(x, \dots, main, xlim = NULL, ylim = NULL,
                            vertical = FALSE, axis = TRUE,
+                           side = if(vertical) "right" else "bottom",
                            labelmap = NULL, gap = 0.25,
                            spacing = NULL, add = FALSE)
 }
@@ -34,8 +35,15 @@
     (\code{vertical=FALSE}, the default).
   }
   \item{axis}{
-    Logical value indicating whether to plot an axis line
-    joining the texture boxes.
+    Logical value indicating whether to plot axis-style labels
+    next to the texture boxes.
+  }
+  \item{side}{
+    One of the character strings
+    \code{"bottom"}, \code{"left"}, \code{"top"}  or \code{"right"},
+    or one of the integers from 1 to 4,
+    specifying the position of the axis-style labels,
+    if \code{axis=TRUE}.
   }
   \item{labelmap}{
     Optional. A \code{function} which will be applied to the