R/GeomTimelineLabel.R

In ekawabata/TheCapstoneProject: Title: Useful functions for studying and visualising data from the U.S. National Oceanographic and Atmospheric Administration (NOAA)

#' Create a ggproto object GeomTimelineLabel
#'
#' This functionc reates a new ggproto object for geom_timeline_label
#'
#' @return GeomTimelineLabel returns a ggproto object.
#'
#' @importFrom dplyr filter
#' @importFrom dplyr group_by
#' @importFrom dplyr mutate
#' @importFrom dplyr top_n
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 draw_key_point
#' @importFrom ggplot2 Geom
#' @importFrom ggplot2 ggproto
#' @importFrom grid circleGrob
#' @importFrom grid gList
#' @importFrom grid gpar
#' @importFrom grid gTree
#' @importFrom grid segmentsGrob
#' @importFrom grid textGrob
#' @importFrom magrittr "%>%"
#' @importFrom scales alpha
#'
#' @details see geom_timeline_label for details
#'
#' @export
GeomTimelineLabel <- ggplot2::ggproto(`_class` = "GeomTimelineLabel", `_inherit` = ggplot2::Geom, required_aes = c("x", 'xmin', 'xmax'), optional_aes = c('label', 'y', 'color', 'size', 'mag', 'n_max', 'alpha'), default_aes = ggplot2::aes(mag = 1, shape = 21, color = "black", size = 15.0, y = 0.5, n_max = 5, fill = 'black', alpha = 0.4, stroke = 2), draw_key = ggplot2::draw_key_point, draw_panel = function(Data, panel_params, coord)
{
  #Points to plot
  Data <- Data %>%
    dplyr::filter(x>=xmin, x<=xmax) %>%
    dplyr::mutate(size = size/max(size, na.rm = TRUE)*0.02) %>%
    stats::na.omit()
  #transform the coordinates for plotting
  Points2Plot <- coord$transform(Data, panel_params)
  #create a function to draw circles
  circles <- grid::circleGrob(Points2Plot$x, Points2Plot$y, r = Points2Plot$size, gp = grid::gpar(col = scales::alpha(Points2Plot$colour, Points2Plot$alpha), fill = scales::alpha(Points2Plot$colour, Points2Plot$alpha), alpha = Points2Plot$alpha, fontsize = Points2Plot$size, lwd = Points2Plot$stroke))

  #Annotations to plot
  Data <- Data %>%
    dplyr::mutate(y_fac = factor(y)) %>%
    dplyr::group_by(y_fac) %>%
    dplyr::top_n(n = n_max[1], wt = mag)
  #transform the coordinates for plotting
  Text2Plot <- coord$transform(Data, panel_params)
  Text2Plot$size[is.na(Text2Plot$size)] <- 5
  #create a function to display annotatations
  texts <- grid::textGrob(label = Text2Plot$label, x = Text2Plot$x, y = Text2Plot$y+0.05, just = "left", rot = 45, check.overlap = TRUE, default.units = "npc", gp = grid::gpar(col = Text2Plot$colour, fontsize = Text2Plot$size*7, lwd = Text2Plot$stroke))
  #create a function to lines connecting cricles and annotations
  lines <- grid::segmentsGrob(x0 = Text2Plot$x, y0 = Text2Plot$y, x1 = Text2Plot$x, y1 = Text2Plot$y+0.05, default.units = "npc", gp = grid::gpar(col = Text2Plot$colour, alpha = Text2Plot$alpha, fontsize = Text2Plot$size, wd = Text2Plot$stroke))

  #create a Grob
  grid::gTree(children = grid::gList(circles, lines, texts))
})