Intro Thoughts

This is a

A nudge x, nudge y strategy to labeling, with after_stat() for segment linkages

library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.1.5
## ✔ forcats   1.0.0     ✔ stringr   1.5.1
## ✔ ggplot2   3.5.1     ✔ tibble    3.2.1
## ✔ lubridate 1.9.3     ✔ tidyr     1.3.1
## ✔ purrr     1.0.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
nudge_x = -1
nudge_y = 12
pad_x = 0
pad_y = 0

ggplot(cars) + 
  aes(x = speed, y = dist) + 
  geom_point() + 
  geom_text(data = . %>% slice(15),
            label = "my insight",
            nudge_x = nudge_x,
            nudge_y = nudge_y, 
            vjust = -sign(nudge_y),
            hjust = -sign(nudge_x),
            ) +
     geom_segment(data = . %>% slice(15),
               aes(xend = after_stat(x) + nudge_x + pad_x,
                   yend = after_stat(y) + nudge_y + pad_y,
                   # x = after_scale(x) 
                   ))

Make it a list layer function add_callout

add_callout <- function(data = data, 
                        label = "Hello World!", 
                        nudge_x = .00001, # no zero length allowed for curves.
                        nudge_y = .00001, 
                        prop_pad_x = .1, 
                        prop_pad_y = .1, 
                        curvature = 0, 
                        hjust = NULL, 
                        vjust = NULL, ... ){

  if(is.null(hjust)){hjust = -sign(nudge_x) == 1}
  if(is.null(vjust)){vjust = -sign(nudge_y) == 1}

  
  list(
    geom_text(data = data,
            label = label,
            nudge_x = nudge_x,
            nudge_y = nudge_y, 
            vjust = vjust,
            hjust = hjust,
            ...
            ),
    geom_curve(data = data,
               aes(xend = after_stat(x) + nudge_x - prop_pad_x*nudge_x,
                   yend = after_stat(y) + nudge_y - prop_pad_y*nudge_y,
                   # x = after_scale(x) + prop_pad_x*nudge_x,
                   # y = after_scale(y) + prop_pad_y*nudge_y
                   ),
               curvature = curvature),
    ...
  )
    
}

Try it out…

ggplot(cars) +
  aes(speed, dist) + 
  geom_point() + 
  add_callout(data = . %>% slice(3), 
              nudge_y = -10)

gapminder::gapminder %>% 
  filter(year == 2002) %>% 
  ggplot() + 
  aes(x = gdpPercap, y = lifeExp) + 
  geom_point() + 
  add_callout(data = . %>% 
                filter(country == "Japan"),
              nudge_x = 1000,
              nudge_y = 2,
              label = "Japan" 
              ) + 
  add_callout(data = . %>% 
                filter(country == "Australia"),
              nudge_x = 1500,
              nudge_y = -10,
              label = "Here we have Australia",
              hjust = .25,
              curvature = -.2)

last_plot() + 
  aes(color = lifeExp)

gapminder::gapminder %>% 
  filter(year == 2002) %>% 
  ggplot() + 
  aes(x = gdpPercap, y = lifeExp, color = gdpPercap) + 
  geom_point() + 
  add_callout(data = . %>% 
                filter(country == "United States"),
              label = "US has high GDP per capita,\nbut low life expectancy compared with peers")

Notes: point padding not available in this iteration.

Check out geom_spoke

But depricated… so…

df <- expand.grid(x = 1:10, y=1:10)

set.seed(1)
df$angle <- runif(100, 0, 2*pi)
df$speed <- runif(100, 0, sqrt(0.1 * df$x))

ggplot(df, aes(x, y)) +
  geom_point() +
  geom_spoke(aes(angle = angle, radius = speed))

ggplot(cars) + 
  aes(speed, dist) +
  geom_point() + 
  geom_spoke(data = . %>% slice(1),
             aes(angle = pi/2, radius = 9)) + 
  theme(aspect.ratio = 1)

stat_spoke  
## function (...) 
## {
##     deprecate_warn0("2.0.0", "stat_spoke()", "geom_spoke()")
##     geom_spoke(...)
## }
## <bytecode: 0x7fa253e032b0>
## <environment: namespace:ggplot2>

Next, a native plots coordinate approach - text label will be at specified npc location.

npc_end_x <- .2
npc_end_y <- .4 

ggplot(cars) + 
  aes(x = speed, y = dist) + 
  geom_point(color = "grey") + 
  geom_point(data = . %>% slice(1)) + 
  geom_text(data = . %>% slice(1),
            aes(x = I(npc_end_x), y = I(npc_end_y)),
            label = "This is the first\nexperimental outcome\nin the correlation study",
            vjust = 0) +
  geom_segment(data = . %>% slice(1),
            aes(xend = I(npc_end_x - .025), 
                yend = I(npc_end_y - .025),
                # x = speed + I(.025), DAE
                ))

Put it in a function…

add_npc_callout <- function(data, npc_end_x = .5, npc_end_y = .5, label = "Hello World!"){
  
  list( 

  geom_segment(data = data,
            aes(xend = I(npc_end_x - .025), 
                yend = I(npc_end_y - .025),
                # x = speed + I(.025), 
                )),
     geom_label(data = data,
            aes(x = I(npc_end_x), y = I(npc_end_y)),
            label = label) 
  )
  
  
}

Seems nice for call outs that apply to multiple observations.

my_lab <- "This is the first\nexperimental outcome\nin the correlation study"

ggplot(cars) +
  aes(speed, dist) + 
  geom_point() + 
  add_npc_callout(data = . %>% slice(1),
                  npc_end_x = .2,
                  label = my_lab)

ggplot(cars) +
  aes(speed, dist) + 
  geom_point() + 
  add_npc_callout(data = . %>% tibble())
## Warning in geom_label(data = data, aes(x = I(npc_end_x), y = I(npc_end_y)), : All aesthetics have length 1, but the data has 50 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

ggplot(cars) +
  aes(speed, dist) + 
  geom_point() + 
  add_npc_callout(data = . %>% filter(dist > 50, speed > 20),
                  npc_end_x = .8, npc_end_y = .2,
                  label = "These guys\nare interesting")
## Warning in geom_label(data = data, aes(x = I(npc_end_x), y = I(npc_end_y)), : All aesthetics have length 1, but the data has 7 rows.
## ℹ Please consider using `annotate()` or provide this layer with data containing
##   a single row.

?labeller

Nudge by Native plot coordinates? So aes(x = speed + I(.2))??!?

I don’t think I’ve seen this mixing and matching and this naive approach doesn’t seem to do much that’s interesting or predictable.

ggplot(cars) + 
  aes(speed, dist) +
  geom_point() + 
  geom_text(mapping = aes(x = speed + I(.1)), 
            label = "A wild idea")

ggplot(cars) + 
  aes(speed, dist) +
  geom_point() + 
    geom_text(data = . %>% slice(15),
              mapping = aes(x = speed + I(.1)), 
              label = "A wild idea")

or geom_spoke StatSpoke w/ I()… Seems like it’s incompatable

ggplot(cars) + 
  aes(speed, dist) +
  geom_point() + 
  geom_spoke(data = . %>% slice(1),
             aes(angle = pi/2, radius = I(.01)))

gapminder::gapminder |>
  filter(year == 2002) |>
  ggplot() +
  aes(gdpPercap, lifeExp) +
  geom_point(colour = "darkgrey") +
  aes(label = country) +
  ggrepel::geom_text_repel(data = . %>% filter(country == "Norway"),
                           nudge_y = -8,
                           nudge_x = -3000,
                           label = "Norway is a\ncountry of interest")

p1 <- ggplot(mtcars, aes(x = mpg, y = wt)) + geom_point()

# You can assign different labellers to variables:
p1 + facet_grid(
  vs + am ~ gear,
  labeller = labeller(vs = label_both, am = label_value)
)

# Or whole margins:
p1 + facet_grid(
  vs + am ~ gear,
  labeller = labeller(.rows = label_both, .cols = label_value)
)

# You can supply functions operating on strings:
capitalize <- function(string) {
  substr(string, 1, 1) <- toupper(substr(string, 1, 1))
  string
}
p2 <- ggplot(msleep, aes(x = sleep_total, y = awake)) + geom_point()
p2 + facet_grid(vore ~ conservation, labeller = labeller(vore = capitalize))

# Or use character vectors as lookup tables:
conservation_status <- c(
  cd = "Conservation Dependent",
  en = "Endangered",
  lc = "Least concern",
  nt = "Near Threatened",
  vu = "Vulnerable",
  domesticated = "Domesticated"
)
## Source: http://en.wikipedia.org/wiki/Wikipedia:Conservation_status

p2 + facet_grid(vore ~ conservation, labeller = labeller(
  .default = capitalize,
  conservation = conservation_status
))

# In the following example, we rename the levels to the long form,
# then apply a wrap labeller to the columns to prevent cropped text
idx <- match(msleep$conservation, names(conservation_status))
msleep$conservation2 <- conservation_status[idx]

p3 <- ggplot(msleep, aes(x = sleep_total, y = awake)) + geom_point()
p3 +
  facet_grid(vore ~ conservation2,
    labeller = labeller(conservation2 = label_wrap_gen(10))
  )

# labeller() is especially useful to act as a global labeller. You
# can set it up once and use it on a range of different plots with
# different facet specifications.