R/timeline.R

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

#' GeomTimeLine
#'
#' GeomTimeLine class constraction
#'
#' @importFrom ggplot2 ggproto
#' @importFrom ggplot2 Geom
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 draw_key_point
#' @importFrom grid segmentsGrob
#' @importFrom grid gpar
#' @importFrom grid pointsGrob
#' @importFrom grid unit
#' @importFrom grid gTree
#' @importFrom grid gList
#'
#' @export
#'
GeomTimeLine <- ggplot2::ggproto('GeomTimeLine', ggplot2::Geom,
                                 required_aes = 'x',
                                 default_aes = ggplot2::aes(colour = 'gray',
                                                            fill = NA,
                                                            shape = 19,
                                                            size = 5,
                                                            stroke = 1,
                                                            alpha = 0.5,
                                                            y = 0.2),
                                 draw_key = ggplot2::draw_key_point,
                                 draw_panel = function(data, panel_scales, coord) {
                                     coords <- coord$transform(data, panel_scales)
                                     segment <- grid::segmentsGrob(
                                         x0 = coords$x[which.min(coords$x)],
                                         y0 = coords$y,
                                         x1 = coords$x[which.max(coords$x)],
                                         y1 = coords$y,
                                         gp = grid::gpar(col = coords$colour)
                                     )
                                     points <- grid::pointsGrob(
                                         x = grid::unit(coords$x, 'native'),
                                         y = grid::unit(coords$y, 'native'),
                                         pch = 19,
                                         size = grid::unit(coords$size, 'mm'),
                                         gp = grid::gpar(
                                             col = coords$colour,
                                             fill = coords$fill,
                                             alpha = coords$alpha
                                         )
                                     )
                                     grid::gTree(children = grid::gList(segment, points))
                                 }
)


#' Geom Timeline
#'
#' Plotting a time line of earthquakes. Each point represents an earthquake.
#' Optional aesthetics include color, size, and alpha (for transparency).
#' The x aesthetic is a date and an optional y aesthetic is a factor indicating some
#' stratification in which case multiple time lines will be plotted for each level
#' of the factor (e.g. country)
#'
#' @param mapping Set of aesthetic mappings.
#' @param data The data to be displayed in this layer.
#' @param stat The statistical transformation to use on the data for this layer, as a string.
#' @param position Position adjustment, either as a string, or the result of a call to
#'                 a position adjustment function.
#' @param na.rm If FALSE, the default, missing values are removed with a warning.
#'              If TRUE, missing values are silently removed.
#' @param show.legend Logical. Should this layer be included in the legends?
#' @param inherit.aes If FALSE, overrides the default aesthetics.
#' @param ... Other arguments passed on to layer.
#'
#' @return A ggplot2 layer
#'
#' @importFrom 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')) %>%
#'         ggplot2::ggplot(ggplot2::aes(x = DATE, y = COUNTRY,
#'                                      colour = DEATHS, size = EQ_PRIMARY)) +
#'         geom_timeline(alpha = 0.5) +
#'         theme_timeline
#'
#' }
#'
geom_timeline <- function(mapping = NULL, data = NULL, stat = "identity",
                          position = "identity", na.rm = FALSE,
                          show.legend = NA, inherit.aes = TRUE, ...) {
    ggplot2::layer(
        geom = GeomTimeLine, mapping = mapping,
        data = data, stat = stat, position = position,
        show.legend = show.legend, inherit.aes = inherit.aes,
        params = list(na.rm = na.rm, ...)
    )
}


#' Theme Timeline
#'
#' A new theme for geom_timeline
#'
#' @importFrom ggplot2 theme_classic
#' @importFrom ggplot2 theme
#' @importFrom ggplot2 element_blank
#'
#' @export
#'
theme_timeline <- ggplot2::theme_classic() +
    ggplot2::theme(axis.line.y = ggplot2::element_blank(),
                   axis.ticks.y = ggplot2::element_blank(),
                   axis.title.y = ggplot2::element_blank()
    )