Experiment
pos_branching_x <- function(x0 = 0, n = 6, width = 2*sqrt(.75)){
x_pos <- c()
for (i in 1:n){
x_pos <- c(x_pos, 1:i*width - i*width/2 - .5 * width)
}
x_pos[1:n] + x0
}
pos_branching_y <- function(y0 = 0, n = 12, height = 2*sqrt(.75)){
-(rep(1:n, 1:n)[1:n] - 1 ) * height + y0
}
pos_branching <- function(x0 = 0, y0 = 0, n = 5, ncol = 3, width = 2*sqrt(.75),
height = width * .75/sqrt(.75)){
data.frame(x0 = pos_branching_x(x0 = x0, n = n, width = width),
y0 = pos_branching_y(y0 = y0, n = n, height = height))
}
x0y0tree <- pos_branching(n = 21, y0 = 5, height = 2, ncol = 6)
# talks <- read_csv("https://raw.githubusercontent.com/teunbrand/ggplot-extension-club/refs/heads/main/meetings.csv")[2:22, ]
ggcanvas <- function(x = 0, y = 0){
ggplot2::ggplot(mapping = aes(x = x, y = y)) +
ggplot2::coord_equal(clip = "off")
}
stamp_polygon <- function(x0 = 0,
y0 = 0,
n_vertices = 6,
radius = 1,
size = 1.5,
alpha = 1,
rotation = -.5,
linetype = "solid",
fill = "grey35",
color = "black",
x0y0 = NULL){
if(!is.null(x0y0)){
x0 = x0y0[,1]
y0 = x0y0[,2]
}
groups <- max(c(length(x0), length(y0)))
tibble::tibble(x0, y0, group = 1:groups) %>%
tidyr::crossing(the_n = 1:n_vertices) %>%
dplyr::mutate(
x = x0 + radius * cos(-2*pi*0:(n_vertices-1)/n_vertices - rotation * pi),
y = y0 + radius * sin(-2*pi*0:(n_vertices-1)/n_vertices - rotation * pi)
) ->
df
annotate(geom = "polygon",
x = df$x,
y = df$y,
size = size,
fill = fill,
alpha = alpha,
linetype = linetype,
color = color,
group = df$group
)
}
event <- c("Teun van den Brand - {legendry} - January",
"Mitch O'Hara-Wild - {ggtime} - February & August",
"Winston Chang - Cookbook, ggproto - March",
"Jan Broder Engler - {tidyplots} - April",
"Spring ASA-COWY - {ggprop.test} - November",
"Hassan Kibirige - {plotnine} - May",
"June Choe - shiny internals explorer - May",
"Thomas Lin Pedersen - {marquee} - June",
"Matthew Kay - {ggdist} - June & August",
"Gina Reynolds - updating 'Recipes' for v4.0 - July",
"ASA-JSM - Who are the ggplot2 extenders - JSM August",
"Cory Brunson - {ggalluvial} - August",
"June Choe - {ggtrace} - August",
"Joyce Robbins - Extension history and typology - September",
"Posit PBC/Conf - Who are the extenders - Sept",
"Teun van den Brand - 4.0.0 release party - Oct",
"David Gohels - {ggiraph} - Oct",
"Kyle Walker* - AIxR - October",
"Barret Schloerke - {GGally} - November",
"Fall ASA-COWY - {ggdims} - November",
"Frank Hull - {ggpal2} - December")
df_events <- data_frame(event) |>
separate(event, into = c("name", "topic", "month"), sep = " - ")
#> 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.
library(ggcirclepack)
ggplot(df_events) +
aes(id = event |> str_wrap(15)) +
geom_circlepack() +
geom_circlepack_text()
#> Warning: Unknown or uninitialised column: `area`.
#> Warning: Unknown or uninitialised column: `wt`.
#> Warning: Unknown or uninitialised column: `within`.
#> Warning: Unknown or uninitialised column: `area`.
#> Warning: Unknown or uninitialised column: `wt`.
#> Warning: Unknown or uninitialised column: `within`.
#' Stamp some text
#'
#' This function adds a text annotation layer
#'
#' @inheritParams stamp_label
#'
#' @return
#' @export
#'
#' @examples
#' # stamping text on a plot
#' library(ggplot2)
#' ggcanvas() +
#' stamp_text_parse()
#'
stamp_text <- function(x = 0,
y = 0,
label = 'bold(italic(p)*"-value"<"0.01")',
text_wrap = FALSE,
char_width = 40,
alpha = 1,
angle = 0,
color = "black",
family = "Times",
fontface = "bold",
hjust = .5,
lineheight = .85,
size = 8,
vjust = .5,
xy = NULL,
parse = FALSE,
nudge_x = 0,
nudge_y = 0){
if(!is.null(xy)){
x = xy[,1]
y = xy[,2]
}
if(text_wrap){
label <- stringr::str_wrap(label, width = char_width)
}
annotate(geom = "text",
x = x + nudge_x,
y = y + nudge_y,
label = label,
alpha = alpha,
angle = angle,
lineheight = lineheight,
size = size,
color = color,
family = family,
fontface = fontface,
vjust = vjust,
hjust = hjust,
parse = parse)
}
star_out_y <- sin(2*pi * 1:5/5 + pi/2) * rep(c(1, .45), 5)
star_out_x <- cos(2*pi * 1:5/5 + pi/2) * rep(c(1, .45), 5)
star_out_x |> data.frame(star_out_y)
#> star_out_x star_out_y
#> 1 -9.510565e-01 0.3090170
#> 2 -2.645034e-01 -0.3640576
#> 3 5.877853e-01 -0.8090170
#> 4 4.279754e-01 0.1390576
#> 5 3.061617e-16 1.0000000
#> 6 -4.279754e-01 0.1390576
#> 7 -5.877853e-01 -0.8090170
#> 8 2.645034e-01 -0.3640576
#> 9 9.510565e-01 0.3090170
#> 10 1.377728e-16 0.4500000
ggcanvas() +
annotate(geom = "polygon",
x = star_out_x,
y = star_out_y)
ggcanvas() +
stamp_polygon(x0y0 = x0y0tree,
alpha = .5,
fill = "darkolivegreen" |> alpha(.4),
color = "goldenrod3",
size = .75) |>
ggfx::with_outer_glow() +
#topic
stamp_text(label = df_events$topic |> str_wrap(12),
xy = x0y0tree,
size = case_when(nchar(df_events$topic)<= 9 ~ 3,
nchar(df_events$topic)<= 12 ~ 2.5,
TRUE ~ 2),
color = "lavender", nudge_y = .07,
vjust = 0, alpha = .8) |>
ggfx::with_outer_glow() +
# Names
stamp_text(label = df_events$name |> str_wrap(width = 8),
xy = x0y0tree,
size = case_when(nchar(df_events$name)<= 9 ~ 2.5,
nchar(df_events$name)<= 15 ~ 2.25,
TRUE ~ 2),
color = "lavender",
alpha = .7, lineheight = .7, nudge_y = -.02,
vjust = 1) |>
ggfx::with_outer_glow() +
annotate("text", label = "Thank You \n and Happy Holidays!",
size = 7, x = I(.5), y = -8.5,
color = "violetred4",
vjust = 0,
family = "Zapfino"
) |>
ggfx::with_outer_glow("white",sigma = 20) +
annotate("text", label = "For the past year of\nextenders meetups...",
size = 5, x = I(.5), y = 8.7,
color = "violetred4",
vjust = 1,
family = "Zapfino"
) |>
ggfx::with_outer_glow("white") +
# stamp_polygon(y = 6.5 + 1:5) +
annotate(geom = "polygon",
x = star_out_x * .5,
y = star_out_y * .5 + 6.5,
color = "goldenrod1",
fill = "goldenrod1") +
# stamp_text(label = "🌟", y = 6.5, color = "goldenrod3") |>
# ggfx::with_outer_glow(colour = "goldenrod1") +
theme(axis.ticks = element_blank()) +
theme(axis.text = element_blank()) +
# stamp_text(label = "❅", color = "white",
# x = runif(n = 200, max = 11) - 5.5,
# y = runif(n = 200, max = 14) - 7.5,
# size = runif(n = 200, min = 2, max = 12),
# alpha = .15) |>
# ggfx::with_outer_glow(colour = "white") +
# geom_hline(yintercept = 7, linewidth = 10, alpha = .2,
# color = "violetred4") +
coord_cartesian(clip = "off", ratio = 1) +
theme(plot.background =
element_rect(color = "violetred4", linewidth = 4) #,
# panel.background = element_rect(fill = "grey" |>
# alpha(.6))
)# +
#> Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
#> ℹ Please use `linewidth` instead.
#> This warning is displayed once every 8 hours.
#> Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
#> generated.
#> Coordinate system already present.
#> ℹ Adding new coordinate system, which will replace the existing one.
# annotate(geom = "rect", xmin = -6.5 , xmax = 6.5,
# ymin = -9, ymax = 7, fill = "transparent",
# color = "violetred4")