Building a new geom

I have been meaning to create a new geom for a data set that has been tidied in the following form:

> Ike
# A tibble: 3 x 9
  storm_id date                latitude longitude wind_speed    ne    se    sw    nw
  <chr>    <dttm>                 <dbl>     <dbl> <chr>      <dbl> <dbl> <dbl> <dbl>
1 IKE-2008 2008-09-04 00:00:00     21.8     -53.5 34           120   100    75   120
2 IKE-2008 2008-09-04 00:00:00     21.8     -53.5 50            75    50    40    50
3 IKE-2008 2008-09-04 00:00:00     21.8     -53.5 64            30    25    20    25

I first defined the class and then the actual geom function, however, my output plot turns out to be a yellow box instead of diagram, So I would appreciate it if you could tell me where I possibly go wrong with the scales.

GeomHurricane <- ggplot2::ggproto("GeomHurricane", Geom, 
                                  required_aes = c("x", "y",
                                                   "r_ne", "r_se", "r_sw", "r_nw"
                                  ),
                                  default_aes = aes(fill = 1, colour = 1, 
                                                    alpha = 1, scale_radii = 1),
                                  draw_key = draw_key_polygon,
                                  
                                  draw_group = function(data, panel_scales, coord) {
                                    
                                    data <- data %>% 
                                      dplyr::mutate(r_ne = r_ne * 1852 * scale_radii, 
                                                    r_se = r_se * 1852 * scale_radii, 
                                                    r_sw = r_sw * 1852 * scale_radii,
                                                    r_nw = r_nw * 1852 * scale_radii
                                      )
                                    
                                    # Creating quadrants 
                                    for(i in 1:nrow(data)) {
                                      
                                      # Creating the northeast quadrants
                                      data_ne <- data.frame(colour = data[i, ]$colour,
                                                            fill = data[i, ]$fill,
                                                            geosphere::destPoint(p = c(data[i, ]$x, data[i, ]$y),
                                                                                 b = 0:90,
                                                                                 d = data[i, ]$r_ne),
                                                            group = data[i, ]$group,
                                                            PANEL = data[i, ]$PANEL,
                                                            alpha = data[i, ]$alpha
                                      )
                                      
                                      # Creating the southeast quadrants
                                      data_se <- data.frame(colour = data[i,]$colour, 
                                                            fill = data[i,]$fill,
                                                            geosphere::destPoint(p = c(data[i,]$x, data[i,]$y),
                                                                                 b = 90:180,
                                                                                 d = data[i,]$r_se),
                                                            group = data[i,]$group,
                                                            PANEL = data[i,]$PANEL,
                                                            alpha = data[i,]$alpha
                                      )
                                      
                                      # Creating the southwest quadrants
                                      data_sw <- data.frame(colour = data[i,]$colour, 
                                                            fill = data[i,]$fill,
                                                            geosphere::destPoint(p = c(data[i,]$x, data[i,]$y),
                                                                                 b = 180:270,
                                                                                 d = data[i,]$r_sw),
                                                            group = data[i,]$group,
                                                            PANEL = data[i,]$PANEL,
                                                            alpha = data[i,]$alpha
                                      )
                                      
                                      # Creating the northwest quadrants
                                      data_nw <- data.frame(colour = data[i,]$colour,
                                                            fill = data[i,]$fill, 
                                                            geosphere::destPoint(p = c(data[i,]$x, data[i,]$y),
                                                                                 b = 270:360,
                                                                                 d = data[i,]$r_nw),
                                                            group = data[i,]$group,
                                                            PANEL = data[i,]$PANEL,
                                                            alpha = data[i,]$alpha
                                      )
                                      
                                      data_quadrants <- dplyr::bind_rows(list(
                                        data_ne, data_se, data_sw, data_nw
                                      )) 
                                      
                                    }
                                    
                                    data_quadrants <- data_quadrants %>% dplyr::rename(
                                      x = lon,
                                      y = lat
                                    )
                                    
                                    data_quadrants$colour <- as.character(data_quadrants$colour)
                                    data_quadrants$fill <- as.character(data_quadrants$fill)
                                    
                                    coords_data <- coord$transform(data_quadrants, panel_scales)
                                    
                                    grid::polygonGrob(
                                      x = coords_data$x,
                                      y = coords_data$y,
                                      gp = grid::gpar(
                                        col = coords_data$colour, 
                                        fill = coords_data$fill,
                                        alpha = coords_data$alpha
                                      )
                                    )
                                  }
)

and the actual geom function definition:

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

So I went on to plot the following:

ggplot(data = Katrina) + 
  geom_hurricane(aes(x = longitude, y = latitude, 
                     r_ne = ne, r_se = se, r_sw = sw, r_nw = nw,
                     fill = wind_speed, colour = wind_speed)) + 
  scale_colour_manual(name = "Wind speed (kts)",
                      values = c("red", "orange", "yellow")) +
  scale_fill_manual(name = "Wind speed (kts)",
                    values = c("red", "orange", "yellow"))

The data for this purpose can be found here as Atlantic basin data set 1988 - 2018:
https://rammb.cira.colostate.edu/research/tropical_cyclones/tc_extended_best_track_dataset/

For your consideration I used the following codes to tidy the data:

ext_tracks_widths <- c(7, 10, 2, 2, 3, 5, 5, 6, 4, 5, 4, 4, 5, 3, 4, 3, 3, 3,
                       4, 3, 3, 3, 4, 3, 3, 3, 2, 6, 1)


ext_tracks_colnames <- c("storm_id", "storm_name", "month", "day",
                         "hour", "year", "latitude", "longitude",
                         "max_wind", "min_pressure", "rad_max_wind",
                         "eye_diameter", "pressure_1", "pressure_2",
                         paste("radius_34", c("ne", "se", "sw", "nw"), sep = "_"),
                         paste("radius_50", c("ne", "se", "sw", "nw"), sep = "_"),
                         paste("radius_64", c("ne", "se", "sw", "nw"), sep = "_"),
                         "storm_type", "distance_to_land", "final")

ext_tracks <- read_fwf("ebtrk_atlc_1988_2015.txt",
                       fwf_widths(ext_tracks_widths, ext_tracks_colnames), 
                       na = "-99")

storm_observation <- ext_tracks %>%
  unite("storm_id", c("storm_name", "year"), sep = "-", 
        na.rm = TRUE, remove = FALSE) %>%
  mutate(longitude = -longitude) %>%
  unite(date, year, month, day, hour) %>%
  mutate(date = ymd_h(date)) %>%
  select(storm_id, date, latitude, longitude, radius_34_ne:radius_64_nw) %>%
  pivot_longer(cols = contains("radius"), names_to = "wind_speed", 
               values_to = "value") %>%
  separate(wind_speed, c(NA, "wind_speed", "direction"), sep = "_") %>%
  pivot_wider(names_from = "direction", values_from = "value") %>%
  mutate(wind_speed = as.factor(wind_speed))


Katrina <- storm_observation %>%
  filter(storm_id == "KATRINA-2005", date == ymd_h("2005-08-29-12"))

zsKWk

I have attached the picture of the desired diagram. This was part of my Coursera's building data visualization tools assignment and a very nice lad once came up with a solution in the form of defining a setup_data for this class of Geom. It sometimes works but I've been searching all over internet and everyone had seemingly come up with some similar codes, however mine's output is just a solid box. I would be grateful if someone could tell me what could I possibly do to fix it, since it has become nightmare problem for me.
Thank you very much indeed in advance.

I have been meaning to create a new geom for a data set that has been tidied in the following form:

> Ike
# A tibble: 3 x 9
  storm_id date                latitude longitude wind_speed    ne    se    sw    nw
  <chr>    <dttm>                 <dbl>     <dbl> <chr>      <dbl> <dbl> <dbl> <dbl>
1 IKE-2008 2008-09-04 00:00:00     21.8     -53.5 34           120   100    75   120
2 IKE-2008 2008-09-04 00:00:00     21.8     -53.5 50            75    50    40    50
3 IKE-2008 2008-09-04 00:00:00     21.8     -53.5 64            30    25    20    25

I first defined the class and then the actual geom function, however, my output plot turns out to be a yellow box instead of diagram, So I would appreciate it if you could tell me where I possibly go wrong with the scales.

GeomHurricane <- ggplot2::ggproto("GeomHurricane", Geom, 
                                  required_aes = c("x", "y",
                                                   "r_ne", "r_se", "r_sw", "r_nw"
                                  ),
                                  default_aes = aes(fill = 1, colour = 1, 
                                                    alpha = 1, scale_radii = 1),
                                  draw_key = draw_key_polygon,
                                  
                                  draw_group = function(data, panel_scales, coord) {
                                    
                                    data <- data %>% 
                                      dplyr::mutate(r_ne = r_ne * 1852 * scale_radii, 
                                                    r_se = r_se * 1852 * scale_radii, 
                                                    r_sw = r_sw * 1852 * scale_radii,
                                                    r_nw = r_nw * 1852 * scale_radii
                                      )
                                    
                                    # Creating quadrants 
                                    for(i in 1:nrow(data)) {
                                      
                                      # Creating the northeast quadrants
                                      data_ne <- data.frame(colour = data[i, ]$colour,
                                                            fill = data[i, ]$fill,
                                                            geosphere::destPoint(p = c(data[i, ]$x, data[i, ]$y),
                                                                                 b = 0:90,
                                                                                 d = data[i, ]$r_ne),
                                                            group = data[i, ]$group,
                                                            PANEL = data[i, ]$PANEL,
                                                            alpha = data[i, ]$alpha
                                      )
                                      
                                      # Creating the southeast quadrants
                                      data_se <- data.frame(colour = data[i,]$colour, 
                                                            fill = data[i,]$fill,
                                                            geosphere::destPoint(p = c(data[i,]$x, data[i,]$y),
                                                                                 b = 90:180,
                                                                                 d = data[i,]$r_se),
                                                            group = data[i,]$group,
                                                            PANEL = data[i,]$PANEL,
                                                            alpha = data[i,]$alpha
                                      )
                                      
                                      # Creating the southwest quadrants
                                      data_sw <- data.frame(colour = data[i,]$colour, 
                                                            fill = data[i,]$fill,
                                                            geosphere::destPoint(p = c(data[i,]$x, data[i,]$y),
                                                                                 b = 180:270,
                                                                                 d = data[i,]$r_sw),
                                                            group = data[i,]$group,
                                                            PANEL = data[i,]$PANEL,
                                                            alpha = data[i,]$alpha
                                      )
                                      
                                      # Creating the northwest quadrants
                                      data_nw <- data.frame(colour = data[i,]$colour,
                                                            fill = data[i,]$fill, 
                                                            geosphere::destPoint(p = c(data[i,]$x, data[i,]$y),
                                                                                 b = 270:360,
                                                                                 d = data[i,]$r_nw),
                                                            group = data[i,]$group,
                                                            PANEL = data[i,]$PANEL,
                                                            alpha = data[i,]$alpha
                                      )
                                      
                                      data_quadrants <- dplyr::bind_rows(list(
                                        data_ne, data_se, data_sw, data_nw
                                      )) 
                                      
                                    }
                                    
                                    data_quadrants <- data_quadrants %>% dplyr::rename(
                                      x = lon,
                                      y = lat
                                    )
                                    
                                    data_quadrants$colour <- as.character(data_quadrants$colour)
                                    data_quadrants$fill <- as.character(data_quadrants$fill)
                                    
                                    coords_data <- coord$transform(data_quadrants, panel_scales)
                                    
                                    grid::polygonGrob(
                                      x = coords_data$x,
                                      y = coords_data$y,
                                      gp = grid::gpar(
                                        col = coords_data$colour, 
                                        fill = coords_data$fill,
                                        alpha = coords_data$alpha
                                      )
                                    )
                                  }
)

and the actual geom function definition:

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

So I went on to plot the following:

ggplot(data = Katrina) + 
  geom_hurricane(aes(x = longitude, y = latitude, 
                     r_ne = ne, r_se = se, r_sw = sw, r_nw = nw,
                     fill = wind_speed, colour = wind_speed)) + 
  scale_colour_manual(name = "Wind speed (kts)",
                      values = c("red", "orange", "yellow")) +
  scale_fill_manual(name = "Wind speed (kts)",
                    values = c("red", "orange", "yellow"))

The data for this purpose can be found here as Atlantic basin data set 1988 - 2018:
https://rammb.cira.colostate.edu/research/tropical_cyclones/tc_extended_best_track_dataset/

For your consideration I used the following codes to tidy the data:

ext_tracks_widths <- c(7, 10, 2, 2, 3, 5, 5, 6, 4, 5, 4, 4, 5, 3, 4, 3, 3, 3,
                       4, 3, 3, 3, 4, 3, 3, 3, 2, 6, 1)


ext_tracks_colnames <- c("storm_id", "storm_name", "month", "day",
                         "hour", "year", "latitude", "longitude",
                         "max_wind", "min_pressure", "rad_max_wind",
                         "eye_diameter", "pressure_1", "pressure_2",
                         paste("radius_34", c("ne", "se", "sw", "nw"), sep = "_"),
                         paste("radius_50", c("ne", "se", "sw", "nw"), sep = "_"),
                         paste("radius_64", c("ne", "se", "sw", "nw"), sep = "_"),
                         "storm_type", "distance_to_land", "final")

ext_tracks <- read_fwf("ebtrk_atlc_1988_2015.txt",
                       fwf_widths(ext_tracks_widths, ext_tracks_colnames), 
                       na = "-99")

storm_observation <- ext_tracks %>%
  unite("storm_id", c("storm_name", "year"), sep = "-", 
        na.rm = TRUE, remove = FALSE) %>%
  mutate(longitude = -longitude) %>%
  unite(date, year, month, day, hour) %>%
  mutate(date = ymd_h(date)) %>%
  select(storm_id, date, latitude, longitude, radius_34_ne:radius_64_nw) %>%
  pivot_longer(cols = contains("radius"), names_to = "wind_speed", 
               values_to = "value") %>%
  separate(wind_speed, c(NA, "wind_speed", "direction"), sep = "_") %>%
  pivot_wider(names_from = "direction", values_from = "value") %>%
  mutate(wind_speed = as.factor(wind_speed))


Katrina <- storm_observation %>%
  filter(storm_id == "KATRINA-2005", date == ymd_h("2005-08-29-12"))

zsKWk

I have attached the picture of the desired diagram. This was part of my Coursera's building data visualization tools assignment and a very nice lad once came up with a solution in the form of defining a setup_data for this class of Geom. It sometimes works but I've been searching all over internet and everyone had seemingly come up with some similar codes, however mine's output is just a solid box. I would be grateful if someone could tell me what could I possibly do to fix it, since it has become nightmare problem for me.
Thank you very much indeed in advance.

This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.