R/map.R

In frenkg/coursera.eq: Clean and Plot NOAA's Earthquakes Database Information

#' Function to draw an intercative leaflet map showing the location of earthquakes.
#'
#' The function generate a leaflet map and add a circle markers for every
#'   earthquake in the data set provided.
#'   The size of the markers is proportional to the magnitude of the earthquake.
#'   One variable of the data frame can be passed to the function to be displayed
#'   as a popup.
#'   If the intensity is not specified (often the case for old earthquakes), the
#'   marker is displayed in grey with fix radius = 1.
#'   If any of the required variable is not present in the data frama, the
#'   function stops nd no map will be plotted.
#'
#' @param data a data frame containing the data to be plotted on the map:
#'   it should contain columns with LONGITUDE, LATITUDE, EQ_PRIMARY.
#' @param annot_col a character string specifying which column should be displayed
#'   as annotation in the popups. Default = \code{DATE}
#'
#' @return a leaflet map whowing the earthquake's location and magnitude
#'
#' @importFrom leaflet leaflet
#' @importFrom leaflet addTiles
#' @importFrom leaflet addCircleMarkers
#'
#' @examples
#' \dontrun {
#'   eq_map(data)
#'
#'   data %>%
#'   dplyr::filter(COUNTRY == "ITALY" & lubridate::year(DATE) >= 1000) %>%
#'   eq_map(annot_col = "DATE")
#' }
#'
#' @export
eq_map <- function(data, annot_col = "DATE") {

  # check that all reuqired variables are present, if not stop
  vars <- colnames(data)
  if("DATE" %in% vars * "LONGITUDE" %in% vars *
     "LATITUDE" %in% vars * "EQ_PRIMARY" %in% vars == 0) {
    stop("Map cannot be plotted. The data frame does not contain some of the
         required variables.") }

  # call leaflet function
  leaflet::leaflet(data) %>%
    leaflet::addTiles() %>%
    leaflet::addCircleMarkers(
      radius = ifelse(is.na(data[["EQ_PRIMARY"]]), 1, data[["EQ_PRIMARY"]]),
      color = ifelse(is.na(data[["EQ_PRIMARY"]]), "grey", "blue"),
      stroke = TRUE,
      fillOpacity = 0.5,
      lng = ~ LONGITUDE,
      lat = ~ LATITUDE,
      popup = data[[annot_col]]
    )
  }


#' Create HTML code to be showed in the marker's popup
#'
#' This function generates an HTML code that can be dispalyed in the popup of
#'   a leaflet map. Four items are displayed, each on a separate line:
#'   date, location, magnitude and total deaths.
#'   If any of the variables is NA, the entire line is not included.
#'   If none of the variables are present in the data frame, the annotation would
#'   be empty.
#'
#' @param data a data frame from which extracting the required information to be
#'   showed as popup
#'
#' @return character vector containing HTML code
#'
#' @examples
#' \dontrun{
#' annot <- eq_create_label(data)
#'
#' data %>%
#'   dplyr::filter(COUNTRY == "ITALY" & lubridate::year(DATE) >= 1000) %>%
#'   dplyr::mutate(popup_text = eq_create_label(.))
#'
#' }
#'
#' @export
eq_create_label <- function(data) {

  vars <- colnames(data)

  # generate the HTML code string
  # NOTE: Date was added wrt to exercise requirement
  # if any of the variables is NA, the entire line is not included
  annotation <- paste(
    ifelse("DATE" %in% vars & !is.na(data$DATE), paste("<b>Date: </b>", data$DATE, "<br/>"), ""),
    ifelse("LOCATION_NAME_debug" %in% vars & !is.na(data$LOCATION_NAME), paste("<b>Location: </b>", data$LOCATION_NAME, "<br/>"), ""),
    ifelse("EQ_PRIMARY" %in% vars & !is.na(data$EQ_PRIMARY), paste("<b>Magnitude: </b>", data$EQ_PRIMARY, "<br/>"), ""),
    ifelse("DEATHS" %in% vars & !is.na(data$DEATHS), paste("<b>Total deaths: </b>", data$DEATHS, "<br/>"), ""))

  # check that all reuqired variables are present, if not perint a warning message
  if("DATE" %in% vars + "LOCATION_NAME_debug" %in% vars +
     "DEATHS" %in% vars + "EQ_PRIMARY" %in% vars == 0) {
    warnings("The data frame does not contain any of the required variables:
            annotation will be empty.") }

  return(annotation)
}