R/calcOffsetGridText.R

In Orcs: Omnidirectional R Code Snippets

# Calculate Offset Coordinates for Grid-Based Text Annotations
# 
# @description
# Calculate offset coordinates for (**grid** based) text drawing functions, e.g.
# [grid::grid.text()].
# 
# @param x A `numeric` vector containing x coordinates, or a 2-column `matrix` 
#   containing x and y coordinates.
# @param y A `numeric` vector containing y coordinates, or `NULL` if 'x' is a 
#   two-column `matrix`.
# @param offset A `numeric` offset in normalized parent coordinates (`"npc"`, 
#   see [grid::unit()]).
# @param pos Text position specifier(s) as `integer` used by [graphics::text()].
#   If not supplied, optimal text positions will be determined with respect to 
#   neighboring locations using [plotrix::thigmophobe()].
# @param xlim,ylim X and Y-axis limits (`c(min, max)`) of the current plot. If 
#   not supplied, limits are automatically calculated from supplied x and y 
#   coordinates.
# @param ... Currently not used. 
# 
# @return
# A `numeric` `matrix` containing offset coordinates.
# 
# @author
# Florian Detsch
# 
# @examples
# \dontrun{
# stopifnot(
#   require(mapview)
#   , require(lattice)
#   , require(grid)
# )
# 
# ## calculate offsets for breweries with more than 3 different types of beer
# brw = as(subset(breweries, number.of.types > 3), "Spatial")
# loc = calcOffsetGridText(coordinates(brw), offset = .025)
# 
# ## create plot
# p = spplot(brw, zcol = "number.of.types", auto.key = FALSE)
# 
# plot.new()
# print(p, newpage = FALSE)
# 
# ## add text labels
# downViewport(trellis.vpname(name = "figure"))
# for (i in 1:length(brw)) {
#   grid.text(label = brw$number.of.types[i], x = loc[i, 1], y = loc[i, 2])
# }
# }
#               
# @export
calcOffsetGridText <- function(x, y = NULL, offset = 0.02, pos = NULL, 
                               xlim = NULL, ylim = NULL, ...) {
  
  if (is.matrix(x)) {
    y <- x[, 2]
    x <- x[, 1]
  }
  
  # relative ("npc") pointcoordinates
  num_xmin <- if (is.null(xlim)) min(x) - .04 * (max(x) - min(x)) else xlim[1]
  num_xmax <- if (is.null(xlim)) max(x) + .04 * (max(x) - min(x)) else xlim[2]
  num_xrng <- num_xmax - num_xmin
  num_x_rel <- (x-num_xmin) / num_xrng
  
  num_ymin <- if (is.null(ylim)) min(y) - .04 * (max(y) - min(y)) else ylim[1]
  num_ymax <- if (is.null(ylim)) max(y) + .04 * (max(y) - min(y)) else ylim[2]
  num_yrng <- num_ymax - num_ymin
  num_y_rel <- (y-num_ymin) / num_yrng
    
  # best label locations (if 'pos' is not supplied)
  int_loc_lbl <- if (is.null(pos)) plotrix::thigmophobe(num_x_rel, num_y_rel) else pos
  ch_loc_lbl <- pos2just(int_loc_lbl)
  
  # apply offset to point coordinates
  ls_off <- lapply(1:length(num_x_rel), function(tmp_cnt) {

    tmp_x <- num_x_rel[tmp_cnt]
    tmp_y <- num_y_rel[tmp_cnt]
    
    ch_jst <- ch_loc_lbl[tmp_cnt]
    
    if (ch_jst %in% c("left", "right")) {
      if (ch_jst == "left") {tmp_x <- tmp_x+offset} else {tmp_x <- tmp_x-offset}
    } else {
      if (ch_jst == "top") {tmp_y <- tmp_y-offset} else {tmp_y <- tmp_y+offset*1.5}
    }
    
    tmp_mat <- matrix(c(tmp_x, tmp_y), byrow = TRUE, ncol = 2)

    return(tmp_mat)
  })

  mat_off <- do.call("rbind", ls_off)
  return(mat_off)
}


### pos2just(): convert integer text position to string ----

# Convert integer text position specifier to string
# 
# @description
# Convert integer position specifiers as supported by
# [graphics::text()] to character position specifiers as supported by
# \strong{grid}-based text drawing functions (e.g. [grid::grid.text()]).
# 
# @param pos Integer. A position specifier for text annotations as used by
# [graphics::text()].
# @param ... Currently not in use.
# 
# @return
# A character vector used as input for text justification in \strong{grid}-based text
# drawing functions.
# 
# @author
# Florian Detsch
# 
# @seealso
# [graphics::text()], [grid::grid.text()]
# 
# @examples
# set.seed(100)
# pos <- sample(1:4, 5, replace = TRUE)
# 
# pos2just(pos)
# 
# @export pos2just
# @aliases pos2just
pos2just <- function(pos, ...) {
  
  sapply(pos, function(x) {
    if (x == 1) {
      return("top")
    } else if (x == 2) {
      return("right")
    } else if (x == 3) {
      return("bottom")
    } else if (x == 4) {
      return("left")
    } else {
      stop("Invalid position specifier supplied: ", x)
    }
  })
  
}