diff --git a/R/plot_legend.R b/R/plot_legend.R index 8811be4d8..019e5da9d 100644 --- a/R/plot_legend.R +++ b/R/plot_legend.R @@ -1,14 +1,25 @@ .get_breaks <- function(x, n, method, r=NULL) { #x <- x[!is.na(x)] + if (is.function(method)) { if (!is.null(r)) { - x[(xr[2])] <- NA + if (!is.na(r[1])) { + x[ x < r[1] ] <- NA + } + if (!is.na(r[2])) { + x[ x > r[2] ] <- NA + } } breaks <- method(x) } else if (method[1]=="cases") { if (!is.null(r)) { - x[(xr[2])] <- NA + if (!is.na(r[1])) { + x[ x < r[1] ] <- NA + } + if (!is.na(r[2])) { + x[ x > r[2] ] <- NA + } } n <- n+1 i <- seq(0, 1, length.out=n) @@ -23,6 +34,9 @@ } else { # if (method=="eqint") { if (is.null(r)) { r <- c(min(x, na.rm=TRUE), max(x, na.rm=TRUE)) + } else if (any(is.na(r))) { + if (is.na(r[1])) r[1] <- min(x, na.rm=TRUE) + if (is.na(r[2])) r[2] <- max(x, na.rm=TRUE) } small <- 1e-16 if ((r[1] %% 1) != 0) { r[1] <- r[1] - small } @@ -322,6 +336,10 @@ retro_labels <- function(x, lat=TRUE) { zztxt <- x$leg$labels if (is.null(zztxt)) { zztxt <- formatC(zz, digits=x$leg$digits, format = "f") + if (x$fill_range) { + if (isTRUE(x$range_filled[1])) zztxt[1] <- paste0("< ", zztxt[1]) + if (isTRUE(x$range_filled[2])) zztxt[length(zztxt)] <- paste0("> ", zztxt[length(zztxt)]) + } } e <- x$leg$ext if (x$leg$x %in% c("left", "right")) { diff --git a/R/plot_raster.R b/R/plot_raster.R index 10684fc95..0a15437af 100644 --- a/R/plot_raster.R +++ b/R/plot_raster.R @@ -117,11 +117,35 @@ # out$fill_range <- FALSE } else { stopifnot(length(out$range) == 2) - stopifnot(out$range[2] > out$range[1]) if (out$fill_range) { - Z[ Z < out$range[1] ] <- out$range[1] - Z[ Z > out$range[2] ] <- out$range[2] + out$range_filled <- c(FALSE, FALSE) + if (!is.na(out$range[1])) { + if (out$range[1] > min(z)) { + out$range_filled[1] <- TRUE + Z[ Z < out$range[1] ] <- out$range[1] + } + } else { + out$range[1] <- min(z, na.rm=TRUE) + } + if (!is.na(out$range[2])) { + if (out$range[2] < max(z)) { + Z[ Z > out$range[2] ] <- out$range[2] + out$range_filled[2] <- TRUE + } + } else { + out$range[2] <- max(z, na.rm=TRUE) + } + } else { + if (all(is.na(out$range))) { + out$range <- range(z) + } else if (is.na(out$range[1])) { + out$range[1] <- min(z) + } else if (is.na(out$range[2])) { + out$range[2] <- max(z) + } } + + if (!any(out$range_filled)) out$fill_range <- FALSE } breaks <- .get_breaks(z, length(out$cols), "eqint", out$range) diff --git a/R/plot_vector.R b/R/plot_vector.R index 02ba5e98f..d4d556270 100644 --- a/R/plot_vector.R +++ b/R/plot_vector.R @@ -433,7 +433,7 @@ setMethod("dots", signature(x="SpatVector"), .prep.vect.data <- function(x, y, type=NULL, cols=NULL, mar=NULL, legend=TRUE, - legend.only=FALSE, levels=NULL, add=FALSE, range=NULL, breaks=NULL, breakby="eqint", + legend.only=FALSE, levels=NULL, add=FALSE, range=NULL, fill_range=FALSE, breaks=NULL, breakby="eqint", xlim=NULL, ylim=NULL, colNA=NA, alpha=NULL, axes=TRUE, buffer=TRUE, background=NULL, pax=list(), plg=list(), ext=NULL, grid=FALSE, las=0, sort=TRUE, decreasing=FALSE, values=NULL, box=TRUE, xlab="", ylab="", cex.lab=0.8, line.lab=1.5, yaxs="i", xaxs="i", main="", cex.main=1.2, line.main=0.5, font.main=graphics::par()$font.main, col.main = graphics::par()$col.main, @@ -573,6 +573,7 @@ setMethod("dots", signature(x="SpatVector"), out$range <- range } out$range_set <- TRUE + out$fill_range <- fill_range } else { if (!is.null(v)) { out$range <- range(v, na.rm=TRUE)