diff --git a/DESCRIPTION b/DESCRIPTION index 2a80cec..f43af9d 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: spatstat.geom -Version: 3.3-4 -Date: 2024-11-18 +Version: 3.3-4.001 +Date: 2024-11-21 Title: Geometrical Functionality of the 'spatstat' Family Authors@R: c(person("Adrian", "Baddeley", role = c("aut", "cre", "cph"), diff --git a/NEWS b/NEWS index e965364..76473d5 100644 --- a/NEWS +++ b/NEWS @@ -1,3 +1,17 @@ + CHANGES IN spatstat.geom VERSION 3.3-4.001 + +OVERVIEW + + o Tweaks to plot.im + +SIGNIFICANT USER-VISIBLE CHANGES + + o plot.im + New argument 'drop.ribbon' determines whether a ribbon will be displayed + in the case where the pixel values are all equal. + Default behaviour has changed. + + CHANGES IN spatstat.geom VERSION 3.3-4 OVERVIEW @@ -7,12 +21,14 @@ OVERVIEW o More control over default colours. o Minor improvements. - -SIGNIFICANT USER-VISIBLE CHANGES + +NEW FUNCTIONS o default.image.colours, reset.default.image.colours Control the default colours used for plotting images in spatstat. - + +SIGNIFICANT USER-VISIBLE CHANGES + o tess, marks<-.tess A tessellation can now have any kind of marks (vector, list, data frame or hyperframe). diff --git a/R/plot.im.R b/R/plot.im.R index cd4103c..d8797ef 100644 --- a/R/plot.im.R +++ b/R/plot.im.R @@ -1,7 +1,7 @@ # # plot.im.R # -# $Revision: 1.158 $ $Date: 2024/02/04 08:04:51 $ +# $Revision: 1.159 $ $Date: 2024/11/21 07:44:45 $ # # Plotting code for pixel images # @@ -222,7 +222,7 @@ plot.im <- local({ zlimits <- if(log) 10^usr else usr z <- z[inside.range(z, zlimits)] } - return(z) + return(unique(z)) } numericalRange <- function(x, zlim=NULL) { @@ -246,6 +246,7 @@ plot.im <- local({ col=NULL, valuesAreColours=NULL, log=FALSE, ncolours=256, gamma=1, ribbon=show.all, show.all=!add, + drop.ribbon=FALSE, ribside=c("right", "left", "bottom", "top"), ribsep=0.15, ribwid=0.05, ribn=1024, ribscale=1, ribargs=list(), riblab=NULL, colargs=list(), @@ -417,57 +418,55 @@ plot.im <- local({ col <- s$outputs } trivial <- (diff(vrange) <= zap * .Machine$double.eps) - #' ribbonvalues: domain of colour map (pixel values) - #' ribbonrange: (min, max) of pixel values in image - #' nominalrange: range of values shown on ribbon - #' nominalmarks: values shown on ribbon at tick marks - #' ribbonticks: pixel values of tick marks + #' ribbonvalues: a sequence of pixel values, mapped to colours + #' ribbonrange: (min, max) of pixel values mapped by ribbon + #' nominalrange: range of (scaled) values shown on ribbon + #' nominalmarks: (scaled) values shown on ribbon at tick marks + #' ribbonticks: pixel values corresponding to tick marks #' ribbonlabels: text displayed at tick marks - ribbonvalues <- if(trivial) vrange[1] else - seq(from=vrange[1], to=vrange[2], length.out=ribn) - ribbonrange <- vrange - nominalrange <- Log(ribscale * Exp(ribbonrange)) - nominalmarks <- if(trivial) nominalrange[1] else - (user.ticks %orifnull% Ticks(nominalrange, + if(trivial) { + ribbonvalues <- mean(vrange) + nominalmarks <- Log(ribscale * Exp(ribbonvalues)) + } else { + ribbonvalues <- seq(from=vrange[1L], to=vrange[2L], + length.out=ribn) + ribbonrange <- vrange + nominalrange <- Log(ribscale * Exp(ribbonrange)) + nominalmarks <- user.ticks %orifnull% Ticks(nominalrange, log=do.log, - nint=user.nint)) + nint=user.nint) + } ribbonticks <- Log(nominalmarks/ribscale) ribbonlabels <- user.ribbonlabels %orifnull% paste(nominalmarks) }, integer = { - values <- as.vector(x$v) - values <- values[!is.na(values)] - uv <- unique(values) - vrange <- numericalRange(uv, zlim) - nvalues <- length(uv) - trivial <- (nvalues < 2) - if(!trivial){ - nominalrange <- Log(ribscale * Exp(vrange)) - if(!is.null(user.ticks)) { - nominalmarks <- user.ticks - } else { - nominalmarks <- Ticks(nominalrange, - log=do.log, - nint = user.nint) - nominalmarks <- nominalmarks[nominalmarks %% 1 == 0] - } - ribbonticks <- Log(nominalmarks/ribscale) - ribbonlabels <- user.ribbonlabels %orifnull% paste(nominalmarks) - if(!do.log && isTRUE(all.equal(ribbonticks, - vrange[1]:vrange[2]))) { - # each possible pixel value will appear in ribbon - ribbonvalues <- vrange[1]:vrange[2] - imagebreaks <- c(ribbonvalues - 0.5, vrange[2] + 0.5) - ribbonrange <- range(imagebreaks) - ribbonticks <- ribbonvalues - ribbonlabels <- user.ribbonlabels %orifnull% paste(ribbonticks * ribscale) - } else { - # not all possible values will appear in ribbon - ribn <- min(ribn, diff(vrange)+1) - ribbonvalues <- seq(from=vrange[1], to=vrange[2], - length.out=ribn) - ribbonrange <- vrange - } + vrange <- numericalRange(x, zlim) + trivial <- (diff(vrange) < 1) + nominalrange <- Log(ribscale * Exp(vrange)) + if(!is.null(user.ticks)) { + nominalmarks <- user.ticks + } else { + nominalmarks <- Ticks(nominalrange, + log=do.log, + nint = user.nint) + nominalmarks <- nominalmarks[nominalmarks %% 1 == 0] + } + ribbonticks <- Log(nominalmarks/ribscale) + ribbonlabels <- user.ribbonlabels %orifnull% paste(nominalmarks) + if(!do.log && isTRUE(all.equal(ribbonticks, + vrange[1]:vrange[2]))) { + #' each possible pixel value will appear in ribbon + ribbonvalues <- vrange[1]:vrange[2] + imagebreaks <- c(ribbonvalues - 0.5, vrange[2] + 0.5) + ribbonrange <- range(imagebreaks) + ribbonticks <- ribbonvalues + ribbonlabels <- user.ribbonlabels %orifnull% paste(ribbonticks * ribscale) + } else { + ## not all possible values will appear in ribbon + ribn <- min(ribn, diff(vrange)+1) + ribbonvalues <- seq(from=vrange[1], to=vrange[2], + length.out=ribn) + ribbonrange <- vrange } if(!is.null(colmap)) { # explicit colour map @@ -479,11 +478,8 @@ plot.im <- local({ } }, logical = { - values <- as.integer(as.vector(x$v)) - values <- values[!is.na(values)] - uv <- unique(values) - trivial <- (length(uv) < 2) vrange <- c(0,1) + trivial <- FALSE imagebreaks <- c(-0.5, 0.5, 1.5) ribbonvalues <- c(0,1) ribbonrange <- range(imagebreaks) @@ -620,7 +616,7 @@ plot.im <- local({ ## ........ start plotting ................. - if(!identical(ribbon, TRUE) || trivial) { + if(!isTRUE(ribbon) || (trivial && isTRUE(drop.ribbon))) { ## no ribbon wanted attr(output.colmap, "bbox") <- as.rectangle(x) @@ -792,29 +788,45 @@ plot.im <- local({ axisargs <- list(side=ribaxis.iside, labels=ribbonlabels) switch(ribside, right={ - scal <- diff(bb.rib$yrange)/diff(ribbonrange) - at <- bb.rib$yrange[1] + scal * (ribbonticks - ribbonrange[1]) + if(trivial) { + at <- mean(bb.rib$yrange) + } else { + scal <- diff(bb.rib$yrange)/diff(ribbonrange) + at <- bb.rib$yrange[1] + scal * (ribbonticks - ribbonrange[1]) + } axisargs <- append(axisargs, list(at=at)) posargs <- list(pos=bb.rib$xrange[2], yaxp=c(bb.rib$yrange, length(ribbonticks))) }, left={ - scal <- diff(bb.rib$yrange)/diff(ribbonrange) - at <- bb.rib$yrange[1] + scal * (ribbonticks - ribbonrange[1]) + if(trivial) { + at <- mean(bb.rib$yrange) + } else { + scal <- diff(bb.rib$yrange)/diff(ribbonrange) + at <- bb.rib$yrange[1] + scal * (ribbonticks - ribbonrange[1]) + } axisargs <- append(axisargs, list(at=at)) posargs <- list(pos=bb.rib$xrange[1], yaxp=c(bb.rib$yrange, length(ribbonticks))) }, top={ - scal <- diff(bb.rib$xrange)/diff(ribbonrange) - at <- bb.rib$xrange[1] + scal * (ribbonticks - ribbonrange[1]) + if(trivial) { + at <- mean(bb.rib$xrange) + } else { + scal <- diff(bb.rib$xrange)/diff(ribbonrange) + at <- bb.rib$xrange[1] + scal * (ribbonticks - ribbonrange[1]) + } axisargs <- append(axisargs, list(at=at)) posargs <- list(pos=bb.rib$yrange[2], xaxp=c(bb.rib$xrange, length(ribbonticks))) }, bottom={ - scal <- diff(bb.rib$xrange)/diff(ribbonrange) - at <- bb.rib$xrange[1] + scal * (ribbonticks - ribbonrange[1]) + if(trivial) { + at <- mean(bb.rib$xrange) + } else { + scal <- diff(bb.rib$xrange)/diff(ribbonrange) + at <- bb.rib$xrange[1] + scal * (ribbonticks - ribbonrange[1]) + } axisargs <- append(axisargs, list(at=at)) posargs <- list(pos=bb.rib$yrange[1], xaxp=c(bb.rib$xrange, length(ribbonticks))) diff --git a/inst/doc/packagesizes.txt b/inst/doc/packagesizes.txt index 5dd3d5f..f0fe81e 100755 --- a/inst/doc/packagesizes.txt +++ b/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-18" "3.3-4" 444 1190 0 35978 15596 +"2024-11-21" "3.3-4.001" 444 1190 0 35990 15596 diff --git a/inst/info/packagesizes.txt b/inst/info/packagesizes.txt index 5dd3d5f..f0fe81e 100755 --- a/inst/info/packagesizes.txt +++ b/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-18" "3.3-4" 444 1190 0 35978 15596 +"2024-11-21" "3.3-4.001" 444 1190 0 35990 15596 diff --git a/man/plot.im.Rd b/man/plot.im.Rd index 887274d..5d8b746 100644 --- a/man/plot.im.Rd +++ b/man/plot.im.Rd @@ -12,6 +12,7 @@ col=NULL, valuesAreColours=NULL, log=FALSE, ncolours=256, gamma=1, ribbon=show.all, show.all=!add, + drop.ribbon=FALSE, ribside=c("right", "left", "bottom", "top"), ribsep=0.15, ribwid=0.05, ribn=1024, ribscale=1, ribargs=list(), riblab=NULL, colargs=list(), @@ -25,6 +26,7 @@ col=NULL, valuesAreColours=NULL, log=FALSE, ncolours=256, gamma=1, ribbon=show.all, show.all=!add, + drop.ribbon=FALSE, ribside=c("right", "left", "bottom", "top"), ribsep=0.15, ribwid=0.05, ribn=1024, ribscale=1, ribargs=list(), riblab=NULL, colargs=list(), @@ -83,6 +85,10 @@ including the main title and colour ribbon. Default is \code{TRUE} for new plots and \code{FALSE} for added plots. } + \item{drop.ribbon}{ + Logical value. If \code{TRUE}, then a ribbon will not be displayed + if all pixel values are equal. + } \item{ribside}{ Character string indicating where to display the ribbon relative to the main image.