R/eq_maps.R

In dtminnick/earthquake: NOAA Significant Earthquake Analysis

#' Create Interactive Map
#'
#' \code{eq_map} creates an interactive map of earthquakes.  It plots events as
#' circles with their radii proportional to the magnitude of the earthquake.
#' Labels can also be passed that will popup when a user clicks on a given
#' event on the map.
#'
#' @param df A data frame containing earthquake data.  The data frame should
#' include the \code{LATITUDE}, \code{LONGITUDE} and \code{EQ_PRIMARY} variables.
#'
#' @param annot_col Character string containing the name of the column in
#' \code{df} containing a character vector of optional popup text to be shown
#' when a event is clicked on a map.
#'
#' @return An html object.
#'
#' @importFrom leaflet addCircleMarkers addTiles leaflet
#'
#' @importFrom magrittr "%>%"
#'
#' @examples
#' \dontrun{
#' earthquakes %>% eq_filter_data(countries = c("Mexico"),
#'                                minimum_date = "1980-01-01",
#'                                maximum_date = "2018-12-31") %>%
#'       eq_map(annot_col = "POPUP_TEXT")
#' }
#'
#' @export

eq_map <- function(df, annot_col) {

      tryCatch({

            data <- NULL

            data %>%
            leaflet::leaflet() %>%
            leaflet::addTiles() %>%
            leaflet::addCircleMarkers(data = df,
                                      radius = ~ EQ_PRIMARY,
                                      opacity = 0.5,
                                      lng = ~ LONGITUDE,
                                      lat = ~ LATITUDE,
                                      popup = ~ as.character(df[[annot_col]]))

      }, warning = function(w) {

            print(paste("eq_map: ", w, sep = ""))

            return(NULL)

      }, error = function(e) {

            print(paste("eq_map: ", e, sep = ""))

            return(NULL)

      }, finally = {

      })

}

#' Create Earthquake HTML Label
#'
#' \code{eq_create_label} creates a formatted HMTL label for use with
#' \code{eq_map} that shows location, magnitude and total deaths, adjusting
#' the label for any missing values.
#'
#' @param df A data frame containing location names in \code{LOCATION_NAME},
#' earthquake magnitude in \code{EQ_PRIMARY} and total deaths in
#' \code{TOTAL_DEATHS}.
#'
#' @return A character vector of formatted HTML strings to label popups in
#' \code{eq_map}.
#'
#' @examples
#' \dontrun{
#' earthquakes %>% eq_filter_data(countries = c("Mexico"),
#'                                minimum_date = "1980-01-01",
#'                                maximum_date = "2018-12-31") %>%
#'       mutate(POPUP_TEXT = eq_create_label(.)) %>%
#'       eq_map(annot_col = "POPUP_TEXT")
#' }
#'
#' @export

eq_create_label <- function(df) {

      tryCatch({

            popup_info <- ""

            popup_info <- ifelse(!is.na(df$LOCATION_NAME),
                                 paste(popup_info,
                                       "<b>Location: </b>",
                                       df$LOCATION_NAME,
                                       "</br>",
                                       sep = ""),
                                 popup_info)

            popup_info <- ifelse(!is.na(df$EQ_PRIMARY),
                                 paste(popup_info,
                                       "<b>Magnitude: </b>",
                                       df$EQ_PRIMARY,
                                       "</br>",
                                       sep = ""),
                                 popup_info)

            popup_info <- ifelse(!is.na(df$TOTAL_DEATHS),
                                 paste(popup_info,
                                       "<b>Total Deaths: </b>",
                                       df$TOTAL_DEATHS,
                                       "</br>",
                                       sep = ""),
                                 popup_info)

      }, warning = function(w) {

            print(paste("eq_create_label: ", w, sep = ""))

            return(NULL)

      }, error = function(e) {

            print(paste("eq_create_label: ", e, sep = ""))

            return(NULL)

      }, finally = {

      })

      return(popup_info)

}