rggplot2choroplethgeom-textchoroplethr

Is there a way in R to move all my labels off the map (into the margins)?


I am working on creating a choropleth map in R with certain cities and certain providers plotted as points on top of the map. I'm stuck with getting the names of the providers to move off the map into the margins (either at the top, to the right, or at the bottom).

When keeping all the providers in one data frame, I cannot figure out how to move some of the labels to the top, to the left, and to the bottom. I can move them all to the top via:

Choropleth +
  geom_polygon(data=map, aes(x=long, y=lat, group= group), alpha=0, 
               color="black", size=1) + 
  geom_point(data=provider, aes(x=Longitude, y=Latitude, group=County), 
             color='red', 
             alpha=4, 
             size=3) +
  geom_point(data=city, aes(x=Longitude, y=Latitude, group=Name),
             color='yellow', 
             alpha=2, 
             size=2.5, 
             shape=8) +
  geom_text_repel(data=city, aes(x=Longitude, y=Latitude, group=Name, label=Name), 
                  min.segment.length = unit(0, 'lines')) +
  geom_label_repel(data=provider, aes(x=Longitude, y=Latitude, group=Name, label=Name), 
                  min.segment.length = unit(0, 'lines'), 
                  nudge_y = 40)

But it comes out looking like this with all the labels on top of each other: enter image description here Or all to the bottom:

Choropleth +
  geom_polygon(data=map, aes(x=long, y=lat, group= group), alpha=0, 
               color="black", size=1) + 
  geom_point(data=provider, aes(x=Longitude, y=Latitude, group=County), 
             color='red', 
             alpha=4, 
             size=3) +
  geom_point(data=city, aes(x=Longitude, y=Latitude, group=Name),
             color='yellow', 
             alpha=2, 
             size=2.5, 
             shape=8) +
  geom_text_repel(data=city, aes(x=Longitude, y=Latitude, group=Name, label=Name), 
                  min.segment.length = unit(0, 'lines')) +
  geom_label_repel(data=provider, aes(x=Longitude, y=Latitude, group=Name, label=Name), 
                  min.segment.length = unit(0, 'lines'), 
                  nudge_y = -40)

But it comes out looking like this with all the labels on top of each other: enter image description here

Then, I tried separating out the providers into their own data frames and tried manually moving the positions, but I'm stuck moving left to right and some of the labels still overlap with each other.

Choropleth +
  geom_polygon(data=map, aes(x=long, y=lat, group= group), alpha=0, 
               color="black", size=1) + 
  geom_point(data=provider, aes(x=Longitude, y=Latitude, group=County), 
             color='red', 
             alpha=4, 
             size=3) +
  geom_point(data=city, aes(x=Longitude, y=Latitude, group=Name),
             color='yellow', 
             alpha=2, 
             size=2.5, 
             shape=8) +
  geom_text_repel(data=city, aes(x=Longitude, y=Latitude, group=Name, label=Name), 
                  min.segment.length = unit(0, 'lines')) +
  geom_label_repel(data=North, aes(x=Longitude, y=Latitude, group=Name, label=Name), 
                   min.segment.length = unit(0, 'lines'), 
                   nudge_y = 40) +
  geom_label_repel(data=Central, aes(x=Longitude, y=Latitude, group=Name, label=Name), 
                   min.segment.length = unit(0, 'lines'), 
                   nudge_x = -40) +
  geom_label_repel(data=South, aes(x=Longitude, y=Latitude, group=Name, label=Name), 
                   min.segment.length = unit(0, 'lines'), 
                   nudge_y  = -40)

But the northern labels are overlapping and I cannot get the labels any more to the left. I tried adding xlim but that zooms out the graph and I want to keep it zoomed in like I have it. Here is what that code above looks like: enter image description here

I'm really stuck with these labels. I still need to clean up the map so ignore the other parts.

I just need help figuring out how to get the labels how I want them.

The choropleth data comes from zip_choropleth + a dataframe that I got from the U.S. Census Bureau that include ZCTA's with total population 60+.


Here is a reproducible example.

library(maps)
library(tidyverse)
library(ggrepel)

ohiocounty_map <- 
  map_data("county") %>%
  subset(region == "ohio") %>%
  mutate(County = str_to_sentence(subregion)) %>%
  group_by(County) %>% 
  filter(County %in% c("Butler", "Clermont", "Clinton", "Hamilton", "Warren"))

## make the name longer, so you can reproduce the problem.
Provider_Name <- sapply(letters[1:8], function(x) {
  paste(rep(x, each = 20), collapse = "")
}, USE.NAMES = F)
## change to numeric
Latitude_P <- as.numeric(c("39.18268", "39.09723", "39.06838", "39.13517", "39.243835", "39.323032", "39.445957", "39.505478"))
Longitude_P <- as.numeric(c("-84.48057", "-84.64043", "-84.10078", "-84.612465", "-84.463478", "-84.504646", "-84.27858", "-84.739334"))

provider <- data.frame(Provider_Name, Latitude_P, Longitude_P)

ggplot() +
  geom_polygon(data = ohiocounty_map, aes(x = long, y = lat, group = group), fill = NA, color = "black") +
  geom_point(data = provider, aes(x = Longitude_P, y = Latitude_P), color = "red", size = 3) +
  geom_label_repel(
    data = provider, aes(x = Longitude_P, y = Latitude_P, label = Provider_Name),
    nudge_y = 40
  )

Created on 2022-07-13 by the reprex package (v2.0.1)


Solution

  • A rather straight forward workaround is to semi-manually define the label position and use geom_label, and add segments instead. In order to avoid overlap, add a nudge to every second label. Based on the example (further important comments in the code):

    library(maps)
    library(tidyverse)
    
    ohiocounty_map <-
      map_data("county") %>%
      subset(region == "ohio") %>%
      mutate(County = str_to_sentence(subregion)) %>%
      group_by(County) %>%
      filter(County %in% c("Butler", "Clermont", "Clinton", "Hamilton", "Warren"))
    
    Provider_Name <- sapply(letters[1:8], function(x) {
      paste(rep(x, each = 20), collapse = "")
    }, USE.NAMES = F)
    Latitude_P <- as.numeric(c("39.18268", "39.09723", "39.06838", "39.13517", "39.243835", "39.323032", "39.445957", "39.505478"))
    Longitude_P <- as.numeric(c("-84.48057", "-84.64043", "-84.10078", "-84.612465", "-84.463478", "-84.504646", "-84.27858", "-84.739334"))
    
    provider <- data.frame(Provider_Name, Latitude_P, Longitude_P)
    ## first define your absolute plot limits based on latitude range of your OHIO map.
    y_lim <- range(ohiocounty_map$lat)
    ## you should also define an x, ideally evenly distributed across the x range
    x_lim <- range(ohiocounty_map$long)
    ## now create x and y coordinates for the labels
    ## I am first defining a constant which will help adjusting the position
    y_cons <- .1
    provider <- provider %>%
      mutate(
        smaller_mean = Latitude_P < mean(y_lim),
        ## now create the positions for geom_label relativ to range of y
        ## points below or above the midpoint will be place below or above the plot, resp.
        lab_y = ifelse(smaller_mean, y_lim[1] - 3.5 * y_cons * diff(y_lim),
          y_lim[2] + y_cons * diff(y_lim)
        )
      ) %>%
      ## then nudge every second label higher or lower - per side
      ## also create x position relativ to number of labels per side
      ## in order to get the labels in a meaningful order, sort the data frame
      arrange(Longitude_P) %>%
      group_by(smaller_mean) %>%
      mutate(
        nudge_y = y_cons * diff(y_lim) * seq_along(Provider_Name) %% 2,
        lab_x = seq(x_lim[1], x_lim[2], len = n())
      )
    
    ggplot() +
      geom_polygon(data = ohiocounty_map, aes(x = long, y = lat, group = group), fill = NA, color = "black") +
      ## you will need connecting lines between the labels and your points, draw them first
      geom_segment(
        data = provider, aes(
          x = Longitude_P, xend = lab_x,
          y = Latitude_P, yend = lab_y + nudge_y),
        ## dashed line for aesthetic reasons
        size = .3
      ) +
      geom_label(
        ## use the new label coordinates for the labels
        data = provider, aes(x = lab_x, y = lab_y, label = Provider_Name),
        ## add nudge_y - this requires the data frame to have unique rows for each label
        nudge_y = provider$nudge_y
      ) +
      ## I draw the points last for aesthetic reasons
      geom_point(data = provider, aes(x = Longitude_P, y = Latitude_P), color = "red", size = 3) +
      ## remove clipping, and add y limits so to allow labels to be outside the plot area
      coord_cartesian(clip = "off", ylim = y_lim) +
      ## adjust plot margins
      theme(plot.margin = margin(r = .8, l = .5, t = .6, b = .8, unit = "in"))
    

    Created on 2022-07-14 by the reprex package (v2.0.1)

    A similar approach would apply to push the labels to the right or left of the plot.