Я имел в виду создать новую геометрию для набора данных, который был приведен в порядок в следующей форме:
Katrina
# A tibble: 3 x 9
storm_id date latitude longitude wind_speed ne se sw nw
<chr> <dttm> <dbl> <dbl> <fct> <dbl> <dbl> <dbl> <dbl>
1 KATRINA-2005 2005-08-29 12:00:00 29.5 -89.6 34 200 200 150 100
2 KATRINA-2005 2005-08-29 12:00:00 29.5 -89.6 50 120 120 75 75
3 KATRINA-2005 2005-08-29 12:00:00 29.5 -89.6 64 90 90 60 60
Сначала я определил класс, а затем фактическую функцию geom, однако мой выходной график оказывается настолько миниатюрным, поэтому я был бы признателен, если бы вы сказали мне, где я могу ошибиться с масштабами.
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) {
coords <- coord$transform(data, panel_scales) %>%
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 = 1: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,
default.units = "native",
gp = grid::gpar(
col = coords_data$colour,
fill = coords_data$fill,
alpha = coords_data$alpha
)
)
}
)
и фактическое определение функции geom:
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, ...)
)
}
Итак, я построил следующее:
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"))
Данные для этой цели можно найти здесь в виде набора данных по Атлантическому бассейну за 1988–2018 гг .: https://rammb.cira.colostate.edu/research/tropical_cyclones/tc_extended_best_track_dataset/
На ваш взгляд, я использовал следующие коды, чтобы привести данные в порядок:
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"))
