Braid new
gapminder |>
filter(country %in% c("Belgium", "Denmark")) |>
ggplot() +
aes(x = year, y = lifeExp, color = country) +
geom_line()
gapminder |>
filter(country %in% c("Belgium", "Denmark")) ->
df_long
df_wide <- pivot_wider(df_long |> select(country, year, lifeExp), names_from = country, values_from = lifeExp)
gapminder |>
filter(country %in% c("Belgium", "Denmark")) |>
ggplot() +
aes(x = year) +
geom_line(aes(y = lifeExp, color = country)) +
geom_braid(data = df_wide, alpha = 0.6,
aes(ymin = Belgium, ymax = Denmark,
fill = Belgium < Denmark))
## `geom_braid()` using method = 'line'
StatBraidNew
interpolate
interpolate <- function(data, n = 80){
interps <- data_frame(between = 1:n)
data |>
mutate(diff_y = lead(y) - y,
diff_x = lead(x) - x) |>
remove_missing() |>
crossing(interps) |>
mutate(interp_y = y + between/n * diff_y,
interp_x = x + between/n * diff_x)
}
cars |>
head(2) ->
cars2
cars2 |>
select(x = speed, y = dist) |>
interpolate(2)
## Warning: `data_frame()` was deprecated in tibble 1.1.0.
## ℹ Please use `tibble()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Removed 1 row containing missing values or values outside the scale
## range.
## # A tibble: 2 × 7
## x y diff_y diff_x between interp_y interp_x
## <dbl> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 4 2 8 0 1 6 4
## 2 4 2 8 0 2 10 4
compute_panel_braid
compute_panel_braid <- function(data, scales, n = 5){
strands <- data |>
# arrange(x)
mutate(minmax = strand |> as.character() |> as.factor() |> as.numeric()) |>
pivot_wider(names_from = minmax, values_from = y, names_prefix = "strand_", id_cols = c(PANEL, group, x)) |>
mutate(ymin = strand_1,
ymax = strand_2)
strands |>
select(y = ymin, x, PANEL, group) |>
interpolate(n = n) |>
select(x = interp_x, ymin = interp_y, PANEL, group) ->
strands_min
strands |>
select(y = ymax, x) |>
interpolate(n = n) |>
mutate(ymax = interp_y) |>
select(ymax) ->
strands_max
bind_cols(strands_min,
strands_max) |>
mutate(xend = x,
yend = ymax,
y = ymin) |>
mutate(row_number = row_number())
}
gapminder |>
filter(country %in% c("Belgium", "Denmark")) |>
select(x = year, y = lifeExp, strand = country) |>
mutate(PANEL = 1, group = 1) |>
compute_panel_braid(n = 3)
## Warning: Removed 1 row containing missing values or values outside the scale range.
## Removed 1 row containing missing values or values outside the scale range.
## # A tibble: 33 × 9
## x ymin PANEL group ymax xend yend y row_number
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <int>
## 1 1954. 68.4 1 1 71.1 1954. 71.1 68.4 1
## 2 1955. 68.8 1 1 71.5 1955. 71.5 68.8 2
## 3 1957 69.2 1 1 71.8 1957 71.8 69.2 3
## 4 1959. 69.6 1 1 72.0 1959. 72.0 69.6 4
## 5 1960. 69.9 1 1 72.2 1960. 72.2 69.9 5
## 6 1962 70.2 1 1 72.4 1962 72.4 70.2 6
## 7 1964. 70.5 1 1 72.6 1964. 72.6 70.5 7
## 8 1965. 70.7 1 1 72.8 1965. 72.8 70.7 8
## 9 1967 70.9 1 1 73.0 1967 73.0 70.9 9
## 10 1969. 71.1 1 1 73.1 1969. 73.1 71.1 10
## # ℹ 23 more rows
gapminder |>
filter(country %in% c("Belgium", "Denmark")) |>
select(x = year, y = lifeExp, strand = country) |>
mutate(PANEL = 1, group = 1) |>
compute_panel_braid(n = 10) |>
ggplot() +
aes(x = x, ymin = ymin,
ymax = ymax,
color = ymin > ymax,
fill = ymin > ymax, y = y, yend = yend,
xend = xend) +
geom_ribbon(alpha = .2) +
geom_segment()
## Warning: Removed 1 row containing missing values or values outside the scale range.
## Removed 1 row containing missing values or values outside the scale range.
last_plot() +
geom_point(data = df_long, aes(x = year, y = lifeExp), inherit.aes = F)
StatBraid2
StatBraid2 <- ggproto("StatBraid2", Stat,
compute_panel = compute_panel_braid,
default_aes = aes(fill =
after_stat(ymin < ymax),
label = after_stat(row_number)
)
)
gapminder |>
filter(country %in% c("Belgium", "Denmark")) |>
ggplot() +
aes(x = year, y = lifeExp,
color = country,
strand = country) +
geom_line() +
geom_ribbon(stat = StatBraid2, alpha = .2, n = 1) +
geom_text(stat = StatBraid2) +
geom_segment(stat = StatBraid2)
## Warning: Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
layer_data(i = 2) |> head()
## Warning: Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## Removed 13 rows containing missing values or values outside the scale range.
## x ymin PANEL group ymax xend yend y row_number fill label
## 1 1957 69.24 1 1 71.81 1957 71.81 69.24 1 #00BFC4 1
## 2 1962 70.25 1 1 72.35 1962 72.35 70.25 2 #00BFC4 2
## 3 1967 70.94 1 1 72.96 1967 72.96 70.94 3 #00BFC4 3
## 4 1972 71.44 1 1 73.47 1972 73.47 71.44 4 #00BFC4 4
## 5 1977 72.80 1 1 74.69 1977 74.69 72.80 5 #00BFC4 5
## 6 1982 73.93 1 1 74.80 1982 74.80 73.93 6 #00BFC4 6
## flipped_aes colour linewidth linetype alpha
## 1 FALSE NA 0.5 1 0.2
## 2 FALSE NA 0.5 1 0.2
## 3 FALSE NA 0.5 1 0.2
## 4 FALSE NA 0.5 1 0.2
## 5 FALSE NA 0.5 1 0.2
## 6 FALSE NA 0.5 1 0.2
last_plot() +
ggplyr::data_filter(year > 1970) +
ggplyr::data_filter(year < 1993)
## Warning: Removed 6 rows containing missing values or values outside the scale
## range.
## Warning: Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
layer_data(i = 2)
## Warning: Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
## Removed 6 rows containing missing values or values outside the scale range.
## x ymin PANEL group ymax xend yend y row_number fill label
## 1 1977 72.80 1 1 74.69 1977 74.69 72.80 1 #00BFC4 1
## 2 1982 73.93 1 1 74.80 1982 74.80 73.93 2 #00BFC4 2
## 3 1987 75.35 1 1 74.63 1987 74.63 75.35 3 #F8766D 3
## 4 1992 76.46 1 1 75.33 1992 75.33 76.46 4 #F8766D 4
## flipped_aes colour linewidth linetype alpha
## 1 FALSE NA 0.5 1 0.2
## 2 FALSE NA 0.5 1 0.2
## 3 FALSE NA 0.5 1 0.2
## 4 FALSE NA 0.5 1 0.2
GeomRibbon$setup_data
## <ggproto method>
## <Wrapper function>
## function (...)
## setup_data(...)
##
## <Inner function (f)>
## function (data, params)
## {
## data$flipped_aes <- params$flipped_aes
## data <- flip_data(data, params$flipped_aes)
## if (is.null(data$ymin) && is.null(data$ymax)) {
## cli::cli_abort("Either {.field {flipped_names(params$flipped_aes)$ymin}} or {.field {flipped_names(params$flipped_aes)$ymax}} must be given as an aesthetic.")
## }
## data <- data[order(data$PANEL, data$group, data$x), , drop = FALSE]
## data$y <- data$ymin %||% data$ymax
## flip_data(data, params$flipped_aes)
## }
GeomRibbon$setup_param
## NULL
data.frame(x = 0:1 |> rep(2),
type = c("A", "A", "B", "B"),
y = c(0:1, 1:0)) |>
ggplot() +
aes(x = x, y = y, color = type, strand = type) +
geom_line() +
geom_ribbon(stat = StatBraid2, alpha = .5, n = 80)
## Warning: Removed 3 rows containing missing values or values outside the scale
## range.
## Warning: Removed 3 rows containing missing values or values outside the scale
## range.
