## function: geom_hurricane (building the layer) --------------------------------
## quite generic
## builds the layer based on the geom specifications
## geom specification is defined in the next function
geom_hurricane <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
ggplot2::layer(
geom = hurricane_proto_class, mapping = mapping,
data = data, stat = stat, position = position,
show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
## function: draw_panel_function ------------------------------------------------
## function within ggproto
## I outsourced due to its length
draw_panel_function <- function(data, panel_scales, coord) {
## Transform the data first
## see book chapter 4.7.2
##
coords <- coord$transform(data, panel_scales)
## Transform to meters and add the scale_radii
## wind radii in data are reported in nautical miles
## reference:
## https://en.wikipedia.org/wiki/Nautical_mile
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
)
## geosphere::destPoint(p, b, d, a=6378137, f=1/298.257223563, ...)
## Based on starting point (p), direction (b)
## and distance (d), it gives back: destination point
## along shortest path on an ellipsoid (the geodesic)
##
## good example - chapter 4:
## https://cran.r-project.org/web/packages/geosphere/vignettes/geosphere.pdf
df_points <- data.frame()
for (i in 1:nrow(data)) {
## NE / NorthEast Sector
data_ne <- data.frame(colour = data[i, ]$colour,
fill = data[i, ]$fill,
geosphere::destPoint(p = c(data[i, ]$x, data[i, ]$y),
## points along 90° segment
## 1 point each degree (°)
## NE: 0° --> 90°
b = 0:90,
d = data[i, ]$r_ne),
group = data[i, ]$group,
PANEL = data[i, ]$PANEL,
alpha = data[i, ]$alpha
)
## SE / SouthEast Sector
data_se <- data.frame(colour = data[i, ]$colour,
fill = data[i, ]$fill,
geosphere::destPoint(p = c(data[i, ]$x, data[i, ]$y),
## points along 90° segment
## 1 point each degree (°)
## SE: 90° --> 180°
b = 90:180,
d = data[i, ]$r_se),
group = data[i, ]$group,
PANEL = data[i, ]$PANEL,
alpha = data[i, ]$alpha
)
## NW / NorthWest Sector
data_nw <- data.frame(colour = data[i, ]$colour,
fill = data[i, ]$fill,
geosphere::destPoint(p = c(data[i, ]$x, data[i, ]$y),
## points along 90° segment
## 1 point each degree (°)
## NW: 270° --> 360°
b = 270:360,
d = data[i, ]$r_nw),
group = data[i, ]$group,
PANEL = data[i, ]$PANEL,
alpha = data[i, ]$alpha
)
## SW / SouthWest Sector
data_sw <- data.frame(colour = data[i, ]$colour,
fill = data[i, ]$fill,
geosphere::destPoint(p = c(data[i, ]$x, data[i, ]$y),
## points along 90° segment
## 1 point each degree (°)
## SW: 180° --> 270°
b = 180:270,
d = data[i, ]$r_sw),
group = data[i, ]$group,
PANEL = data[i, ]$PANEL,
alpha = data[i, ]$alpha
)
df_points <- dplyr::bind_rows(list(df_points, data_nw, data_ne, data_se, data_sw))
} ## for-loop END
## New names: x and y (old: long and lat)
df_points <- df_points %>%
dplyr::rename(x = lon,
y = lat
)
## Convert to character
## or else: doesn't read colour correctly
## (it remains black)
df_points$colour <- base::as.character(df_points$colour)
df_points$fill <- base::as.character(df_points$fill)
coords_df <- coord$transform(df_points, panel_scales)
grid::polygonGrob(
x = coords_df$x,
y = coords_df$y,
gp = grid::gpar(col = coords_df$colour, fill = coords_df$fill, alpha = coords_df$alpha)
)
} # END draw_panel_function
## function: hurricane_proto_class -----------------------------------------------
## ggproto() creates new class corresponding to new geom (geom_hurricane)
## Chapter 4.7.1 in the book: buildinga geom
##
hurricane_proto_class <- ggplot2::ggproto("hurricane_proto_class", Geom,
# required_aes = <a character vector of required aesthetics>,
# default_aes = aes(<default values for certain aesthetics>),
# draw_key = <a function used to draw the key in the legend>,
# draw_panel = function(data, panel_scales, coord) {
# ## Function that returns a grid grob that will
# ## be plotted (this is where the real work occurs)
# }
required_aes = c("x", "y", "r_ne", "r_se", "r_nw", "r_sw"),
default_aes = aes(fill = 1, colour = 1, alpha = 1, scale_radii = 1),
draw_key = draw_key_polygon,
## function: draw_panel_function
## is outsourced
## due to its length
## (!!) draw_panel only takes one colour
## (!!) draw_group takes all colours (same shape)
draw_group = draw_panel_function
)
