R/geom-arch-label.R

In houyunhuang/archncov: Visualize the Confirmed Cases of 'nCov' Through a Spiral

#' Special layer function for spiral plot
#' @description A set of custom layer functions that quickly draw spiral.
#' @param mapping aesthetic mappings parameters.
#' @param data NULL or a arch_tbl object that create by \code{tidy_arch_ncov()}.
#' @param use.shadowtext logical, if TRUE (default) will use \code{shadowtext::geom_shadowtext()} for labels.
#' @param angle,vertical angle of labels.
#' @param ... extra parameters passing to layer function.
#' @return a geom layer.
#' @importFrom ggplot2 aes_string geom_text
#' @importFrom shadowtext geom_shadowtext
#' @importFrom dplyr filter
#' @importFrom ggvwline geom_vwline
#' @rdname geom_arch_label
#' @author Houyun Huang
#' @export
geom_arch_label <- function(mapping = NULL,
                            data = NULL,
                            use.shadowtext = FALSE,
                            ...)
{
  if(!is.null(data) && !inherits(data, "arch_tbl")) {
    stop("Need a arch_tbl object.", call. = FALSE)
  }
  data <- if(is.null(data)) {
    get_label_data()
  } else {
    get_label_data()(data)
  }
  mapping <- aes_modify(
    aes_string(x = "label.x", y = "label.y", label = "label", angle = "label.angle",
               colour = "colour", size = "size"), mapping
  )
  if(use.shadowtext) {
    shadowtext::geom_shadowtext(mapping = mapping, data = data, colour = "white", ...)
  } else {
    ggplot2::geom_text(mapping = mapping, data = data, ...)
  }
}

#' @rdname geom_arch_label
#' @export
geom_arch <- function(mapping = NULL,
                      data = NULL,
                      ...)
{
  if(!is.null(data) && !inherits(data, "arch_tbl")) {
    stop("Need a arch_tbl object.", call. = FALSE)
  }
  mapping <- aes_modify(
    aes_string(x = "x", y = "y", fill = "name", width = "width"), mapping
  )
  geom_vwline(mapping = mapping, data = data, ..., width_units = "mm")
}

#' @rdname geom_arch_label
#' @export
label_angle <- function(angle, vertical) {
  angle <- angle %% 360
  idx <- angle > 90 & angle < 270
  angle[idx] <- (angle[idx] + 180) %% 360
  verti_idx <- vertical & (angle < 90 | angle > 270)
  angle[verti_idx] <- (angle[verti_idx] + 180) %% 360
  angle
}

#' @importFrom utils modifyList
#' @noRd
aes_modify <- function(aes1, aes2) {
  aes <- modifyList(as.list(aes1), as.list(aes2))
  class(aes) <- "uneval"
  aes
}

#' @noRd
get_label_data <- function() {
  function(data) {
    dplyr::filter(data, label.filter)
  }
}