R/geom_timeline_label.R

In jennychungpy/earthquakes: Cleaning, visualising and mapping a NOAA (earthquake) file

#' Labelling the timeline(s) of the earthquakes
#'
#' @description The 'geom_timeline_label' function labels the timelines generated by the 'geom_timeline' function.
#'
#' @details The 'geom_time_label' function works with ggplot2 and the 'geom_timeline' function. This function visualises the locations of the
#'          earthquakes, indicated by a line above each earthquake event.
#'
#' @note warning - A warning appears when the no data is available to plot.
#'
#' @importFrom ggplot2 ggproto draw_key_point layer
#' @importFrom dplyr filter
#' @importFrom grid polylineGrob gpar gList
#' @importFrom magrittr %>%
#'
#' @param x - The time parameter (as.Date object)
#' @param label - The location names parameter (character)
#' @param n_maxVar - The parameter that represents the magnitude of the earthquakes. This works together with the n_max parameter
#' @param n_max - Earthquakes beneath this value of magnitude will be shown on the map. The parameter of the magnitude needs to be
#'                given in n_maxvar parameter.
#'
#' @inheritParams ggplot2::geom_text
#'
#' @return A geom visualising the locations of each earthquake event, indicated by a line.
#'
#' @examples
#' \dontrun{
#' library(magrittr)
#' data <- eq_clean_data(file) %>%
#'   filter(COUNTRY == c("China", "Usa", "Japan"),
#'          DATE >= "1999-01-01",
#'          DATE <= "2012-12-31")
#' ggplot() +
#'   geom_timeline(data, aes(x = DATE, y = COUNTRY, size = richterScaleValue, fill = DEATHS)) +
#'   theme(legend.position = "bottom") +
#'   geom_timeline_label(data, aes(x=DATE, label = locations, n_maxVar = EQ_PRIMARY, n_max=10)) +
#'   labs(x = "Date", y = "Country", fill = "# deaths", size = "Richter scale value")
#' }
#'
#' @export
geom_timeline_label <- function(mapping = NULL,
                                data = NULL,
                                stat = 'identity',
                                position = 'identity',
                                na.rm = FALSE,
                                show.legend = NA,
                                inherit.aes = TRUE,
                                ...) {
  ggplot2::layer(geom = Geom_Timeline_Label,
                 mapping = mapping,
                 data = data,
                 stat = stat,
                 position = position,
                 show.legend = show.legend,
                 inherit.aes = inherit.aes,
                 params = list()
  )
}

Geom_Timeline_Label <- ggplot2::ggproto("Geom_Timeline_Label",
                                        ggplot2::Geom,
                                        required_aes = c("x", "label", "n_maxVar", "n_max"),
                                        default_aes = ggplot2::aes(col = "grey60"),
                                        draw_key = ggplot2::draw_key_point,

                                        draw_group = function(data, panel_scales, coord) {
                                          data <- data %>%
                                            dplyr::filter(n_maxVar <= n_max)

                                          if(nrow(data) == 0){
                                            return(print("No data available to plot"))
                                          }

                                          coords <- coord$transform(data, panel_scales)
                                          locations_lines <- grid::polylineGrob(
                                            x = unit(c(coords$x, coords$x), "npc"),
                                            y = unit(c(coords$y, coords$y+0.05), "npc"),
                                            id = rep(1:dim(coords)[1], 2),
                                            gp = grid::gpar(
                                              col = "grey75",
                                              lwd = .pt
                                            )
                                          )

                                          locations_names <- grid::textGrob(
                                            label = coords$label,
                                            x = unit(coords$x, "npc"),
                                            y = unit(coords$y+0.05, "npc"),
                                            just = c("left", "bottom"),
                                            rot = 45,
                                            gp = grid::gpar(
                                              col = "grey20"
                                            )
                                          )

                                          grid::gList(locations_lines, locations_names)

                                        }
)