library(ggplot2)
library(dplyr)
library(grid)
library(scales)
#' Geom for creating a timeline from earthquake data
#'
#' This function creates a new geom to create a timeline for a specified data range
#' and plots each earthquake as a point on that timline
#'
#' @param mapping a set of aesthetic mappings
#' @param data data to be displayed
#' @param na.rm specifies how default missing values are approached
#' @param position position adjustment
#' @param stat the statistical transformation of the data
#' @param show.legend inclusion of layer in the legend
#' @param inherit.aes logical specification of whether to inherit the default aes
#' @param ... additional parameters
#'
#' @return no return value
#'
#' @examples \dontrun{ggplot(data = china2, aes(x = date, y = COUNTRY,
#' color = DEATHS, size = EQ_PRIMARY)) + geom_timeline(alpha = 0.2)}
#' @export
geom_timeline <- function(mapping = NULL, data = NULL, na.rm = TRUE,
position = "identity", stat = "identity",
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, ...))
}
#'ggproto timeline object
#'
#'
#' @return no return value
#'
#' @examples \dontrun{ggplot(data = china2, aes(x = date, y = COUNTRY,
#' color = DEATHS, size = EQ_PRIMARY)) + geom_timeline(alpha = 0.2)}
#' @export
GeomTimeline <- ggplot2::ggproto("GeomTimeline", ggplot2::Geom,
required_aes = c("x"),
non_missing_aes = c("size", "shape", "colour","y"),
default_aes = ggplot2::aes(
shape = 19, colour = "black", size = 5, fill = NA,
alpha = 0.2, stroke = 0.5, y = 0.2
),
draw_panel = function(data, panel_params, coord, na.rm = FALSE) {
coords <- coord$transform(data, panel_params)
points = grid::pointsGrob(
coords$x, coords$y,
pch = coords$shape,
gp = grid::gpar(
col = scales::alpha(coords$colour, coords$alpha),
fill = scales::alpha(coords$fill, coords$alpha),
fontsize = coords$size * ggplot2::.pt + coords$stroke * ggplot2::.stroke / 2,
lwd = coords$stroke * ggplot2::.stroke / 2
)
)
lines = lapply(unique(coords$y), FUN = function(x) grid::linesGrob(y = c(x,x)))
grobList = c(list(points), lines)
grid::gTree(children = do.call(grid::gList, grobList))
},
draw_key = ggplot2::draw_key_point
)
#' Eartquake visualisation function
#' The function displays earthquakes on a map with annotation displayed in a popup
#'
#' @importFrom leaflet leaflet addProviderTiles addCircleMarkers
#'
#' @param data Clean NOAA dataset (data.frame)
#' @param annot_col Name of a column to take annotation text from. Default is DATE
#'
#' @examples
#' \dontrun{
#' eq_map(data = data, annot_col = "DATE")
#' }
#'
#' @export
eq_map <- function(data, annot_col = "DATE") {
# Make a leaflet
leaflet::leaflet(data = data) %>%
leaflet::addProviderTiles("OpenStreetMap.Mapnik") %>%
leaflet::addCircleMarkers(
lng = ~ LONGITUDE,
lat = ~ LATITUDE,
radius = ~ EQ_PRIMARY,
popup = ~ data[[annot_col]]
)
}
#' Make up a label for visualization popup
#' To be used with eq_map() function to make more informative popup labe;
#'
#' @param data The NOAA dataset
#'
#' @examples
#' \dontrun{
#' data %>% mutate(popup_text = eq_create_label(.)) %>% eq_map(annot_col = "popup_text")
#' }
#'
#' @export
eq_create_label <- function(data) {
paste0(
"<b>Location:</b> ", data$LOCATION_NAME, "<br>",
"<b>Magnitude:</b> ", data$EQ_PRIMARY, "<br>",
"<b>Total deaths:</b> ", ifelse(is.na(data$TOTAL_DEATHS), "Unknown", data$TOTAL_DEATHS)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.