key width issues

NAMESPACE

@@ -193,6 +193,7 @@ importFrom(graphics,plot)
 importFrom(graphics,plot.new)
 importFrom(graphics,plot.window)
 importFrom(graphics,rasterImage)
+importFrom(graphics,strwidth)
 importFrom(graphics,text)
 importFrom(graphics,title)
 importFrom(methods,as)

R/init.R

@@ -1,4 +1,4 @@
-#' @importFrom graphics image.default image par plot title box text axis plot.new plot.window rasterImage layout lcm contour hist
+#' @importFrom graphics image.default image par plot title box text axis plot.new plot.window rasterImage layout lcm contour hist strwidth
 #' @importFrom grDevices dev.capabilities dev.size grey rgb col2rgb
 #' @importFrom utils head tail setTxtProgressBar txtProgressBar packageVersion methods modifyList
 #' @importFrom stats na.omit runif aggregate setNames predict quantile var complete.cases na.pass time

R/plot.R

@@ -6,6 +6,16 @@ make_label = function(x, i = 1) {
 		names(x)[i]
 }
 
+kw_dflt = function(x, key.pos) {
+	if (is.null(key.pos) || key.pos <= 0)
+		lcm(0)
+	else if (key.pos %in% c(2,4) && is.factor(x[[1]]))
+		lcm(max(strwidth(levels(x[[1]]), "inches")) * 2.54 * 1.1 + par("ps")/12) # cm
+	else
+		lcm(1.8 * par("ps")/12)
+}
+
+
 #' plot stars object, with subplots for each level of first non-spatial dimension
 #'
 #' plot stars object, with subplots for each level of first non-spatial dimension, and customization of legend key
@@ -51,12 +61,13 @@ make_label = function(x, i = 1) {
 #' }
 #' plot(x, hook = hook2, col = grey(c(.2,.25,.3,.35)))
 #' if (isTRUE(dev.capabilities()$rasterImage == "yes")) {
-#'   lc = system.file("tif/lc.tif", package = "stars")
-#'   plot(read_stars(lc), key.pos=4, key.width=lcm(5))
+#'   lc = read_stars(system.file("tif/lc.tif", package = "stars"))
+#'   levels(lc[[1]]) = abbreviate(levels(lc[[1]]), 6) # so it's not only legend
+#'   plot(lc, key.pos=4)
 #' }
 plot.stars = function(x, y, ..., join_zlim = TRUE, main = make_label(x, 1), axes = FALSE,
 		downsample = TRUE, nbreaks = 11, breaks = "quantile", col = grey(1:(nbreaks-1)/nbreaks),
-		key.pos = get_key_pos(x, ...), key.width = lcm(1.8 * par("ps")/12), key.length = 0.618, 
+		key.pos = get_key_pos(x, ...), key.width = kw_dflt(x, key.pos), key.length = 0.618, 
 		key.lab = main, reset = TRUE, box_col = grey(.8), center_time = FALSE, hook = NULL, 
 		mfrow = NULL) {
 
@@ -301,7 +312,7 @@ image.stars = function(x, ..., band = 1, attr = 1, asp = NULL, rgb = NULL,
 		xlim = st_bbox(extent)$xlim, ylim = st_bbox(extent)$ylim, text_values = FALSE,
 		text_color = 'black', axes = FALSE,
 		interpolate = FALSE, as_points = FALSE, key.pos = NULL, logz = FALSE,
-		key.width = lcm(1.8 * par("ps")/12), key.length = 0.618, add.geom = NULL, border = NA,
+		key.width = kw_dflt(x, key.pos), key.length = 0.618, add.geom = NULL, border = NA,
 		useRaster = isTRUE(dev.capabilities()$rasterImage == "yes"), extent = x) {
 
 	dots = list(...)

vignettes/stars1.Rmd

@@ -339,10 +339,11 @@ two circular polygons:
 ```{r}
 s = system.file("tif/lc.tif", package = "stars")
 r = read_stars(s, proxy = FALSE) |> droplevels()
+levels(r[[1]]) = abbreviate(levels(r[[1]]), 10) # shorten text labels
 st_point(c(3190631, 3125)) |> st_sfc(crs = st_crs(r)) |> st_buffer(25000) -> pol1
 st_point(c(3233847, 21027)) |> st_sfc(crs = st_crs(r)) |> st_buffer(10000) -> pol2
 if (isTRUE(dev.capabilities()$rasterImage == "yes")) {
-  plot(r, key.width = lcm(4), reset = FALSE, key.pos = 4)
+  plot(r, reset = FALSE, key.pos = 4)
   plot(c(pol1, pol2), col = NA, border = c('yellow', 'green'), lwd = 2, add = TRUE)
 }
 ```

vignettes/stars7.Rmd

@@ -281,7 +281,7 @@ train = as.data.frame(train)
 train$x = NULL # remove geometry
 rf = randomForest(use ~ ., train) # ~ . : use all other attributes
 pr = predict(r, rf)
-plot(pr, key.width = lcm(5), reset = FALSE, key.pos = 4)
+plot(pr, reset = FALSE, key.pos = 1)
 # add country outline:
 plot(m, add = TRUE)
 ```