R/timelinelabel.R

In blnash508/EarthquakesNOAA: Clean and Visualize NOAA Significant Earthquakes Dataset

#' GeomTimeLineLabel
#'
#' GeomTimeLineLabel class constraction
#'
#' @importFrom ggplot2 ggproto
#' @importFrom ggplot2 Geom
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 draw_key_blank
#' @importFrom grid segmentsGrob
#' @importFrom grid gpar
#' @importFrom grid textGrob
#' @importFrom grid gTree
#' @importFrom grid gList
#' @importFrom dplyr group_by
#' @importFrom dplyr top_n
#' @importFrom dplyr ungroup
#'
#' @export
#'
GeomTimeLineLabel <- ggplot2::ggproto('GeomTimeLineLabel', ggplot2::Geom,
                                      required_aes = c('x', 'label'),
                                      default_aes = ggplot2::aes(y = 0.2,
                                                                 n_max = 3,
                                                                 size = 0,
                                                                 alpha = 0.5,
                                                                 colour = 'black'),
                                      draw_key = ggplot2::draw_key_blank,
                                      draw_panel = function(data, panel_scales, coord) {
                                          data %<>% dplyr::group_by(y) %>%
                                              dplyr::top_n(n = data$n_max[1], wt = size) %>%
                                              dplyr::ungroup()
                                          coords <- coord$transform(data, panel_scales)
                                          segment <- grid::segmentsGrob(
                                              x0 = coords$x,
                                              x1 = coords$x,
                                              y0 = coords$y,
                                              y1 = coords$y + 0.1,
                                              gp = grid::gpar(col = coords$colour,
                                                              alpha = coords$alpha)
                                          )
                                          text <- grid::textGrob(
                                              label = coords$label,
                                              x = coords$x,
                                              y = coords$y + 0.11,
                                              rot = 65,
                                              just = 'left',
                                              gp = grid::gpar(fontsize = 9)
                                          )
                                          grid::gTree(children = grid::gList(segment, text))
                                      }
)


#'
#' Geom Timelinelabel
#'
#' Add annotations to the earthquake data.
#' This geom adds a vertical line to each data point with a text annotation
#' (e.g. the location of the earthquake) attached to each line.
#' We can subset to n_max number of earthquakes, where we take the n_max largest (by magnitude)
#' earthquakes. Aesthetics are x, which is the date of the earthquake and label which takes
#' the column name from which annotations will be obtained.
#'
#' @inheritParams geom_timeline
#'
#' @return A ggplot2 layer
#'
#' @export
#'
#' @examples
#' \dontrun{eq_data <- readr::read_delim('signif.txt', delim = '\t')}
#' \dontrun{
#'     eq_data %>%
#'         eq_clean_data() %>%
#'         dplyr::filter(lubridate::year(DATE) > 2010 & COUNTRY %in% c('CHILE', 'USA')) %>%
#'         eq_location_clean() %>%
#'         ggplot2::ggplot(ggplot2::aes(x = DATE, y = COUNTRY,
#'                                      colour = DEATHS, size = EQ_PRIMARY)) +
#'         geom_timeline(alpha = 0.5) +
#'         geom_timelinelabel(ggplot2::aes(label = LOCATION_NAME, n_max = 3)) +
#'         theme_timeline
#'
#' }
#'
geom_timelinelabel <- function(mapping = NULL, data = NULL, stat = "identity",
                               position = "identity", na.rm = FALSE,
                               show.legend = NA, inherit.aes = TRUE, ...) {
    ggplot2::layer(
        geom = GeomTimeLineLabel, mapping = mapping,
        data = data, stat = stat, position = position,
        show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(na.rm = na.rm, ...)
    )
}