r - 在ggplot2中创建新的Geom时出现字体大小错误

Question

我正在尝试创建一个新的几何图形，它将根据飓风数据创建风半径图表。

运行此程序所需的数据由以下内容生成:

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))

下面包含我创建新 Geom 的代码，但抛出了一个与字体大小相关的奇怪错误:

Error in check.length(gparname) : 'gpar' element 'fontsize' must not be length 0

我尝试在 default_aes 和 gpar() 函数中包含 fontsize，但仍然导致相同的错误。任何帮助，将不胜感激。注意:这需要 tidyr、dplyr 和 geosphere 软件包。

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, ...))}

以下是使用新的 geom 创建 map 的代码:

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"))

Answer 1

我明白了。不知何故忘记包含 draw_key = draw_key_polygon，一旦我将其添加回 ggproto 函数，一切正常。谢谢!