R/geom_hurricane.R

In Davidovich4/hurricane: Plot Hurricane Data

quadrant_order <- c("r_ne", "r_se", "r_sw", "r_nw")

#' Hurricane
#'
#' @description The hurricane geom is used to map hurricane data.
#'
#' @importFrom ggplot2 layer
#' @export
geom_hurricane <- function(mapping = NULL, data = NULL, stat = "identity",
													 position = "identity", na.rm = FALSE,
													 show.legend = NA, inherit.aes = TRUE, ...){
	ggplot2::layer(
		geom = GeomHurricane, mapping = mapping,
		data = data, stat = stat, position = position,
		show.legend = show.legend, inherit.aes = inherit.aes,
		params = list(na.rm = na.rm,...)
	)
}

#' Hurricane proto
#'
#' @description Creates a prototype for \code{\link{geom_hurricane}}.
#'
#' @import ggplot2
#' @importFrom dplyr mutate
#' @importFrom geosphere destPoint
#' @importFrom grid polygonGrob
#' @importFrom magrittr %>%
#'
#' @export
GeomHurricane <- ggplot2::ggproto("GeomHurricane", ggplot2::Geom,
	required_aes = c("x", "y", "r_ne", "r_se", "r_sw", "r_nw"),
	default_aes = ggplot2::aes(colour = NA, fill = NA, size = 0.5, alpha = 0.7, scale_radii = 1),
	draw_key = ggplot2::draw_key_polygon,
	draw_group = function(data, panel_scales, coord) {
		#Convert to scale_radii
		data <- data %>%
			mutate(
				r_ne = r_ne * 1852 * scale_radii,
				r_se = r_se * 1852 * scale_radii,
				r_nw = r_nw * 1852 * scale_radii,
				r_sw = r_sw * 1852 * scale_radii
			)
		#Grab the first row for attributes
		first_row <- data[1, , drop = FALSE]
		xy = c(first_row$x, first_row$y)

		#Create the polygons
		polygons <- list()
		for(i in 1:4) {
			plg <- geosphere::destPoint(
				p = xy,
				b = ((i-1)*90) : (i*90),
				d = first_row[, quadrant_order[i]]
			)

			polygons[[i]] <- data.frame(
				x = c(plg[, 1], first_row$x),
				y = c(plg[, 2], first_row$y)
			)
		}

		polygons <- do.call(rbind, polygons)
		coords <- coord$transform(polygons, panel_scales)

		#Create a grob
		grid::polygonGrob(
			x = coords$x,
			y = coords$y,
			gp = grid::gpar(
				col = first_row$colour,
				fill = first_row$fill,
				alpha = first_row$alpha
			)
		)
	}
)