I am trying to create a new geom that will create a wind radii chart from hurricane data.
The data needed to run this came be generated from the following:
storm_observation <- data_frame(longitude = c(-89.6, -89.6, -89.6),
latitude = c(29.5, 29.5, 29.5),
wind_speed = c("34", "50", "64"),
ne = c(200, 120, 90),
nw = c(100, 75, 60),
se = c(200, 120, 90),
sw = c(150, 75, 60))
My code to create the new Geom is included below, but is throwing a strange error related to fontsize:
Error in check.length(gparname) : 'gpar' element 'fontsize' must not be length 0
I have attempted to include fontsize in the default_aes
and gpar()
functions, but it still resulted in the same error. Any help would be appreciated. NOTE: This requires tidyr
, dplyr
and geosphere
packages.
GeomHurricane <- ggproto("GeomPolygon", Geom,
required_aes = c("x", "y", "r_ne", "r_se", "r_nw", "r_sw",
"fill", "colour"),
default_aes = aes(scale_radii = 0.8, alpha = 0.8, linetype = 1, size = 0.5),
draw_group = function(data, panel_scales, coord) {
## Create function for conditional mutation
mutate_cond <- function(.data, condition, ..., envir = parent.frame()) {
condition <- eval(substitute(condition), .data, envir)
.data[condition, ] <- .data[condition, ] %>% mutate(...)
.data
}
## Create df of bearings for later joining
bearingDF <- tibble::data_frame(bearing = c(360,1:90,90:180,180:270,270:360),
direction = rep(c("r_ne", "r_se", "r_sw", "r_nw"),
each = 91)) %>%
dplyr::bind_rows(tibble::data_frame(bearing = rep(0, 4),
direction = c("r_ne", "r_se", "r_sw", "r_nw")))
## Transform data in tidy format and combine with bearings
data <- data %>%
dplyr::select(x, y, r_ne, r_nw, r_se, r_sw, colour, fill,
PANEL, group, scale_radii, alpha, linetype,
size) %>%
tidyr::gather(direction, distance, -x, -y, -colour, -fill,
-PANEL, -group, -scale_radii, -alpha, -linetype,
-size) %>%
dplyr::mutate(distance = distance * 1852 * scale_radii) %>%
dplyr::left_join(bearingDF, by = "direction") %>%
mutate_cond(bearing == 0, distance = 0)
## Generate correct lat/lon for perimeter of polygons
data <- data %>%
dplyr::bind_cols(as.data.frame(geosphere::destPoint(as.matrix(data[,1:2]),
data$bearing,
data$distance))) %>%
dplyr::select(-x, -y) %>%
dplyr::rename(x = lon, y = lat)
## Coord transform and take first row
coords <- coord$transform(data, panel_scales)
first_row <- coords[1, , drop = FALSE]
grid::polygonGrob(
coords$x, coords$y,
default.units = "native",
gp = grid::gpar(
col = first_row$colour,
fill = scales::alpha(first_row$fill, first_row$alpha),
lwd = first_row$size * .pt,
lty = first_row$linetype
)
)
})
geom_hurricane <- function(mapping = NULL, data = NULL, stat = "identity", position = "identity",
na.rm = FALSE, show.legend = NA, inherit.aes = TRUE, ...) {
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, ...))}
Here is the code to create the map using the new geom:
get_map("Louisiana", zoom = 6, maptype = "toner-background", source = "stamen") %>%
ggmap(extent = "device") +
geom_hurricane(data = storm_observation,
aes(x = longitude, y = latitude,
r_ne = ne, r_se = se, r_nw = nw, r_sw = sw,
fill = wind_speed, color = wind_speed)) +
scale_color_manual(name = "Wind speed (kts)",
values = c("red", "orange", "yellow")) +
scale_fill_manual(name = "Wind speed (kts)",
values = c("red", "orange", "yellow"))
I figured it out. Had somehow forgotten to include draw_key = draw_key_polygon
, once I added that back into the ggproto
function everything worked.
Thanks!
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With