R/geom_timelinelabel.R

In avidclam/msdr5: Visualization of NOAA's Significant Earthquake Database

#' @importFrom ggplot2 ggproto Geom aes
#' @importFrom grid segmentsGrob textGrob unit gpar grobTree
#' @importFrom dplyr %>% group_by filter min_rank ungroup
GeomTimelineLabel <-
  ggplot2::ggproto("GeomTimelineLabel", ggplot2::Geom,
                   required_aes = c("x", "y", "mag", "label"),
                   default_aes = ggplot2::aes(shape = 3, colour = "white", alpha = 0.1),
                   draw_panel = function(data, panel_params, coord, n_max) {

                     label_data <-
                       data %>%
                       dplyr::group_by(group) %>%
                       dplyr::filter(dplyr::min_rank(-mag) <= n_max) %>%
                       dplyr::ungroup()

                     coords <- coord$transform(data, panel_params)
                     label_coords <- coord$transform(label_data, panel_params)

                     vline_len <- (1 - max(coords$y)) * 0.3

                     grob_segment <-
                       grid::segmentsGrob(
                         label_coords$x, label_coords$y,
                         label_coords$x, label_coords$y + vline_len,
                         gp = grid::gpar(col = "darkgray")
                       )

                     grob_text <-
                       grid::textGrob(
                         label = label_coords$label,
                         x = label_coords$x, y = label_coords$y + vline_len * 1.1,
                         just = "left", rot = 45,
                         gp = grid::gpar(fontsize = 10)
                       )

                     grid::grobTree(grob_segment, grob_text)
                   }
  )

#' Add annotations to earthquakes timeline Geom
#'
#' This geom adds annotations of a vertical line and a location text
#' of the earthquake to the top powerful earthquakes.
#' Aesthetics are x, which is the date of the earthquake and label which takes the column name
#' from which annotations will be obtained.
#'
#' @param n_max Maximum number of annotations for each level of `y` (starting from the most powerful earthquake down)
#' @param mag Magnitude of the earthquake, used to find top n_max entries
#'
#' @inherit ggplot2::geom_point
#'
#' @examples
#' \dontrun{
#' earthquakes %>%
#'   eq_clean_data() %>%
#'   eq_location_clean() %>%
#'   filter(YEAR >= 2000) %>%
#'   filter(COUNTRY %in% c("USA", "MEXICO")) %>%
#'   ggplot(aes(x = DATE, y = COUNTRY, color = DEATHS, size = EQ_PRIMARY)) +
#'   geom_timeline_label(aes(mag = EQ_PRIMARY, label = LOCATION_NAME), n_max = 5) +
#'   geom_timeline() +
#'   scale_size_continuous(name = 'Richter scale value', guide = guide_legend(order = 1)) +
#'   scale_color_continuous(name = '# of Deaths', guide = guide_colorbar(order = 2)) +
#'   theme_eq_custom()
#' }
#'
#' @importFrom ggplot2 layer
#'
#' @export
geom_timeline_label <- function(mapping = NULL, data = NULL, stat = "identity",
                                position = "identity", na.rm = FALSE, show.legend = NA,
                                inherit.aes = TRUE, n_max = Inf, ...) {
  ggplot2::layer(
    geom = GeomTimelineLabel, mapping = mapping,  data = data, stat = stat,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(n_max = n_max, na.rm = na.rm, ...)
  )
}