telling-a-story.qmd

# Don't Distract From the Story {#sec-telling-a-story}

```{r setup}
#| echo: false
#| include: false

source("_common.R")
```

The hardest part of data visualization is identifying a story in the first place. This is especially true in natural language processing---since language is such a rich source of information, it is sometimes hard to decide what aspect of it to focus on. The stories are hiding in plain sight. The job of the data visualizer is to find them and bring them out into the open.

## A Small, Compelling Story is Better Than a Big, Confusing One {#sec-simplify-the-story}

@schwartz_etal_2013 collected 15.4 million Facebook status updates from participants who had filled out a variety of questionnaires on the *My Personality* application (discussed in @sec-ethics). They analyzed the frequencies of millions of words, phrases, and topics as they correlate with gender, age, and personality traits of the author. The resulting paper focused on methodology, but @schwartz_etal_2013 nevertheless understood the importance of telling a good story. Here is their figure 5B:

[![Figure from @schwartz_etal_2013](images/schwartz_etal_2013_fig5C.png){fig-alt="The older people are, the more they say 'we' and the less they say 'I'"}](https://journals.plos.org/plosone/article?id=10.1371/journal.pone.0073791)

This is a beautiful data visualization. The story it tells is so clear and simple that it doesn't need a caption: Older people use "I" less and "we" more. The unstated implication is either that people get less individualistic with age, or that the young people of today are self-centered. Both are excellent stories.

How did Schwartz et al. achieve such a clear story? Let's take a closer look at some of their choices:

First, out of millions of words, phrases, and topics in their analysis, they chose to focus this visualization on only two. This is the first step of story-telling with data: remove distractions. A small, compelling story is better than a big, confusing one.

Second, they chose not to show the data points themselves, but to represent the overall trends with regression lines. This is a major sacrifice, since it makes the graph much less informative---any good scientist will wonder about the distributions surrounding these lines: How rare are community-oriented 20-year-olds? What about self-centered 60-year-olds? Nevertheless, Schwartz et al. decided that including a scatter plot behind the lines would make the graph too confusing to look at, and distract from the main story.

Third, they chose to use bendy LOESS regression lines, even though the main analysis of the paper was conducted with linear regression. This was a great choice because it makes the story more convincing. The fact that even LOESS lines show near-linear trends is impressive. Even though there are no data points to be seen, those steady lines give the impression that the underlying data are reliable. Also, the the LOESS lines give the viewer the opportunity to notice nuances in the story without distracting from the big picture (it is fascinating that "we" reaches it's all-time low around the time most people move out of their parents' house, and not before).

Lastly, let's take a look at the y axis: What is "Standardized Frequency"? We have an intuitive idea that higher means using the word more and lower means using it less. But this intuitive simplicity did not come easily---it had to be carefully constructed by the authors of the paper. Actually, "Standardized Frequency" is calculated using this formula:

[![Figure from @schwartz_etal_2013](images/schwartz_etal_2013_equation.png){fig-alt="Complicated Equation"}](https://journals.plos.org/plosone/article?id=10.1371/journal.pone.0073791#s6)

Don't understand any of this? That's OK. We'll cover methods of standardizing word frequencies in @sec-word-counting-improvements. For now, the point is this: **Sometimes you have to do something complicated to make something simple**. If Schwartz et al. had not performed them, "I" would likely be much higher frequency than "we" at all ages, and the story, which requires the viewer to focus on the slopes of the lines, would be much harder to appreciate.

## Engineer Your Aesthetics

We have just seen in Schwartz et al.'s beautiful data visualization (@sec-simplify-the-story) that choosing to map the `frequency` variable to the y position aesthetic was not enough. In order to make the story clear, they carefully engineered the scale on which they measured frequency. In their case, this required some complicated standardization tailored to the particular statistics underlying their data. Often though, the solution is much more straightforward.

The remainder of this chapter outlines some common ways to engineer aesthetics that can help make a story clear and intuitive.

### Nonlinear Axes {#sec-nonlinear-axes}

Often a simple log scale is enough to reveal a much clearer presentation of data. The following graph uses data from @buechel_etal_2018, in which participants read news stories, rated their own empathy and distress after reading them, and then described their thoughts in their own words.

This visualization tells a story about the most and least common words in participant's responses.

```{r}
#| include: false

library(tidytext)

distressed_texts <- read_csv("https://raw.githubusercontent.com/wwbp/empathic_reactions/master/data/responses/data/messages.csv", show_col_types = FALSE) |> 
  select(essay, distress, distress_bin)

distressed_texts_binary <- distressed_texts |> 
  # only texts by distressed participants
  filter(distress_bin == 1) |> 
  mutate(clean_text = tm::removeNumbers(essay),
         clean_text = tm::removePunctuation(clean_text),
         clean_text = tm::stripWhitespace(clean_text)) |>
  # tokenize and count frequencies
  unnest_tokens(word, clean_text, to_lower = TRUE) |>
  count(word, sort = TRUE) |>
  rename(distressed_count = n) |> 
  # keep stop words only
  filter(word %in% stop_words$word)

nondistressed_texts_binary <- distressed_texts |> 
  # only texts by non-distressed participants
  filter(distress_bin == 0) |> 
  mutate(clean_text = tm::removeNumbers(essay),
         clean_text = tm::removePunctuation(clean_text),
         clean_text = tm::stripWhitespace(clean_text)) |>
  # tokenize and count frequencies
  unnest_tokens(word, clean_text, to_lower = TRUE) |>
  count(word, sort = TRUE) |>
  rename(nondistressed_count = n) |> 
  # keep stop words only
  filter(word %in% stop_words$word)


# join the two sets
distressed_texts_binary <- distressed_texts_binary |> 
  inner_join(nondistressed_texts_binary) |> 
  # remove extremely low frequency words
  filter(distressed_count + nondistressed_count > 50) |> 
  # replace na with 0
  replace_na(list(distressed_count = 0, nondistressed_count = 0))
```

```{r}
#| warning: false
#| fig-height: 6
library(ggrepel)
library(patchwork)

distressed_texts_binary_ordered <- distressed_texts_binary |> 
  # ratio of distressed frequency to non-distressed frequency
  mutate(distressed_freq_ratio = distressed_count/nondistressed_count) |> 
  # refactor in descending order
  arrange(distressed_freq_ratio) |> 
  mutate(word = factor(word, levels = word))

set.seed(2023)
badplot1 <- distressed_texts_binary_ordered |> 
  ggplot(aes(word, distressed_freq_ratio, label = word)) +
    geom_point(color = "blue3", 
               size = 1, 
               alpha = .2) +
    geom_text_repel(
      size = 3, 
      data = distressed_texts_binary_ordered |> 
        filter(distressed_freq_ratio > 1.75)) +
    labs(title = "Linear Scale",
         x = "Words, from least to most distressed",
         y = "Distressed frequency / non-distressed frequency") +
    scale_y_continuous(breaks = seq(-.5, 2, .5)) +
    theme_minimal() +
    theme(
      plot.title = element_text(color = "red3", hjust = 1, size = 20),
      panel.grid.major.x = element_blank(),
      axis.text.x = element_blank(),
      axis.ticks.x = element_blank(),
      axis.title.x = element_text(size = 15)
      )

set.seed(2023)
goodplot1 <- distressed_texts_binary_ordered |> 
  ggplot(aes(word, distressed_freq_ratio, 
             label = word, 
             color = distressed_freq_ratio < 1)
         ) +
    geom_point(size = 1, alpha = .2) +
    geom_text_repel(
      size = 3, 
      data = distressed_texts_binary_ordered |> 
        filter(distressed_freq_ratio > 1.75 | distressed_freq_ratio < 1/2),
      max.overlaps = 20) +
    geom_hline(linetype = 2, yintercept = 1) +
    labs(title = "Log Scale",
         x = "Words, from least to most distressed",
         y = "Distressed frequency / non-distressed frequency") +
    scale_y_continuous(
      breaks = c(2^(-6:6)), 
      trans = "log2", 
      labels = ~MASS::fractions(.x)
      ) +
    guides(color = "none") +
    theme_minimal() +
    theme(
      plot.title = element_text(color = "green3", hjust = 1, size = 20),
      panel.grid.major.x = element_blank(),
      axis.text.x = element_blank(),
      axis.ticks.x = element_blank(),
      axis.title.x = element_text(size = 15)
      )

goodplot1 + badplot1
```

When plotting ratios, it is almost always a good idea to use a log scale (left). This way, the viewer can compare the largest and the smallest relative values. Without the log scale (right), the smallest values are squished into oblivion.

### Ordering Categorical Variables {#sec-ordering-categorical-variables}

Take another look at the graph labeled "Log Scale" above, and notice the ordering along the x axis. Words, on their own, are an unordered categorical variable. Nevertheless, **in the context of a story, even unordered variables have an order**. Ordering the categorical variable along the continuous variable of interest calls attention to the distribution and removes confusion.

```{r}
#| warning: false
#| fig-height: 6
library(ggrepel)
library(patchwork)

set.seed(2023)
badplot2 <- distressed_texts_binary |> 
  # ratio of distressed frequency to non-distressed frequency
  mutate(distressed_freq_ratio = distressed_count/nondistressed_count) |> 
  ggplot(
    aes(
      word, distressed_freq_ratio, 
      label = word, 
      color = distressed_freq_ratio < 1
      )
    ) +
    geom_point(size = 1, alpha = .7) +
    geom_text_repel(
      size = 3, 
      data = distressed_texts_binary_ordered |> 
        filter(distressed_freq_ratio > 1.75 | distressed_freq_ratio < .5),
      max.overlaps = 20
      ) +
    geom_hline(linetype = 2, yintercept = 1) +
    labs(
      title = "Unordered",
      x = "Words",
      y = "Distressed frequency / non-distressed frequency"
      ) +
    scale_y_continuous(
      breaks = c(2^(-6:6)), 
      trans = "log2", 
      labels = ~MASS::fractions(.x)
      ) +
    guides(color = "none") +
    theme_minimal() +
    theme(
      plot.title = element_text(color = "red3", hjust = 1, size = 20),
      panel.grid.major.x = element_blank(),
      axis.text.x = element_blank(),
      axis.ticks.x = element_blank(),
      axis.title.x = element_text(size = 15)
      )

goodplot2 <- goodplot1 + labs(title = "Ordered")

goodplot2 + badplot2
```

### Color Scales {#sec-color-scales}

We have already seen how a data visualizer can clarify a story by spatially ordering a categorical variable. A carefully tailored color scale can be an even more powerful communicator than an x or y axis. This is because color, even though it is usually treated as a single aesthetic, actually has many dimensions: luminosity, saturation, redness, blueness, etc.

The first step in choosing a color scale for any variable is to consider whether the thing being measured is diverging, sequential, or qualitative.

**Diverging scales** measure something with a neutral center. This center is often represented by zero, but beware! Sometimes a neutral center is 4 on a seven point Likert scale (see "Agreement" in the figure below). When dealing with fractions, the neutral center is 1 (see "Frequency Ratio" in the figure below).

When applying diverging scales, keep in mind any associations people might have with the colors involved. For example, red should always be *bad* and blue/green *good* (see the plot in @sec-ordering-categorical-variables, in which red = distress = bad).

```{r}
#| echo: false
library(ggnewscale)

# custom function to lighten dark colors and darken light colors 
# (requires hex format)
contrast <- function(col, amount = 0.1) {
  # extract RGB values from hex
  r <- as.numeric(colorspace::coords(colorspace::hex2RGB(col))[,"R"])
  g <- as.numeric(colorspace::coords(colorspace::hex2RGB(col))[,"G"])
  b <- as.numeric(colorspace::coords(colorspace::hex2RGB(col))[,"B"])
  # compute perceived luminosity
  luma <- 0.2126*r + 0.7152*g + 0.0722*b
  # initiate with lightening
  output <- colorspace::lighten(col, amount)
  # add darkening where appropriate
  output[which(luma > .5)] <- colorspace::darken(col, amount)[which(luma > .5)]
  return(output)
}

# simple data
tibble(num = factor(1:7),
       frequency = c("Low Frequency\nRatio", "1/4", 
                     "1/2", "Equal\nFrequency", "2", 
                     "4", "High Frequency\nRatio"),
       agree = c("Strongly\nDisagree", "2", 
                 "3", "Neither Agree\nNor Disagree", "5", 
                 "6", "Strongly\nAgree"),
       correlation = c("-.9", "-.6", "-.3", 
                       "0", ".3", ".6", ".9")) |> 
  ggplot(aes(num)) +
    # Frequency Ratio
    geom_tile(
      aes(
        y = "Frequency\nRatio", 
        fill = num
        ), 
      width = .95, height = .9) +
    geom_text(
      aes(
        y = "Frequency\nRatio", 
        color = num, 
        label = frequency
        ), 
      size = 2.9, hjust = .5) + 
    scale_fill_manual(
      values = hcl.colors(7, "Berlin"), 
      guide = "none"
      ) +
    scale_color_manual(
      values = contrast(hcl.colors(7, "Berlin"),.7),
      guide = "none"
      ) +
    new_scale_fill() +
    new_scale_color() +
    # Agreement
    geom_tile(
      aes(
        y = "Agreement", 
        fill = num
        ), 
      width = .95, height = .9) +
    geom_text(
      aes(
        y = "Agreement", 
        color = num, 
        label = agree
        ), 
      size = 2.9, hjust = .5) +
    scale_fill_manual(
      values = hcl.colors(7, "Purple-Green"), 
      guide = "none"
      ) +
    scale_color_manual(
      values = contrast(hcl.colors(7, "Purple-Green"),.7),
      guide = "none"
      ) +
    new_scale_fill() +
    new_scale_color() +
    # Correlation
    geom_tile(
      aes(
        y = "Correlation", 
        fill = num
        ), 
      width = .95, height = .9) +
    geom_text(
      aes(
        y = "Correlation", 
        color = num, 
        label = correlation
        ), 
      size = 4, hjust = .5) +
    scale_fill_manual(
      values = hcl.colors(7, "Blue-Red", rev = TRUE), 
      guide = "none"
      ) +
    scale_color_manual(
      values = contrast(hcl.colors(7, "Blue-Red", rev = TRUE),.7),
      guide = "none"
      ) +
    labs(
      title = "Diverging Color Scales",
      subtitle = "for ordered variables with a neutral center"
      ) +
    coord_fixed(ratio = .95/.9) + 
    theme_void() +
    theme(
      plot.title = element_text(size = 20, hjust = .5),
      plot.subtitle = element_text(hjust = .5),
      axis.text.y = element_text()
      )
```

**Sequential scales** measure something that has an order, but no neutral center. Often, one side of the scale is at zero, so that the scale goes from nothing to something. In these cases, the appropriate color scale will represent amount with luminosity, where zero is the lightest (see "Frequency" and "Anxiety" in the figure below). This way, the lower amounts have lower contrast against the white background of the plot (if using a non-white plot background, make sure the low end of the scale matches).

Sometimes sequential scales do not measure amount, as in "Weekdays" in the figure below. Weekdays have an order---rom the beginning of the week to the end---ut it would be a mistake to use a scale with one side blending in to the background and the other intensely dark, since that would suggest that Thursday is somehow 'more' than Wednesday. Likewise, there is no neutral center (there's nothing neutral about Wednesday). In such case, the scale should go from one noticeable color to another. The chart below uses a palette reminiscent of sunset to give the impression of time passing.

```{r}
#| echo: false
library(ggnewscale)
library(RColorBrewer)

# simple data
tibble(num = factor(1:7),
       frequency = c("Low Frequency", "", "", 
                     "", "", "", "High Frequency"),
       anxiety = c("Low Anxiety", "", 
                   "", "", "", "", "High Anxiety"),
       weekday = c("Sunday", "Monday", "Tuesday", 
                   "Wednesday", "Thursday", "Friday", "Saturday")) |> 
  ggplot(aes(num)) +
    # Frequency
    geom_tile(aes(y = "Frequency", fill = num), 
              width = .95, height = .9) +
    geom_text(aes(y = "Frequency", color = num, label = frequency), 
              size = 2.9, hjust = .5) +
    scale_fill_brewer(palette = "YlGnBu", guide = "none") +
    scale_color_manual(
      values = contrast(brewer.pal(7, "YlGnBu"),.7),
      guide = "none"
      ) +    
    new_scale_fill() +
    new_scale_color() +
    # Anxiety
    geom_tile(aes(y = "Anxiety", fill = num), 
              width = .95, height = .9) +
    geom_text(aes(y = "Anxiety", color = num, label = anxiety), 
              size = 2.9, hjust = .5) +
    scale_fill_brewer(palette = "OrRd", guide = "none") +
    scale_color_manual(
      values = contrast(brewer.pal(7, "OrRd"),.7),
      guide = "none"
      ) +
    new_scale_fill() +
    new_scale_color() +
    # Weekdays
    geom_tile(aes(y = "Weekdays", fill = num), 
              width = .95, height = .9) +
    geom_text(aes(y = "Weekdays", color = num, label = weekday), 
              size = 2.9, hjust = .5) +
    scale_fill_manual(
      values = hcl.colors(7, "Sunset", rev = TRUE), 
      guide = "none"
      ) +
    scale_color_manual(
      values = contrast(hcl.colors(7, "Sunset", rev = TRUE),.7),
      guide = "none"
      ) +
    labs(title = "Sequential Color Scale",
         subtitle = "for ordered variables without a neutral center") +
    coord_fixed(ratio = .95/.9) + 
    theme_void() +
    theme(plot.title = element_text(size = 20, hjust = .5),
          plot.subtitle = element_text(hjust = .5),
          axis.text.y = element_text())
```

To emphasize the point about weekdays, consider the following two versions of the same graph (data taken from Reddit users associated with subreddits for 9 US cities):

```{r}
#| include: false
#| eval: false

library(RedditExtractoR)

# subreddits for some US cities
# time zones (offset from utc in hours)
# latitude
city_subreddits <- tibble(
  subreddit = c("sanfrancisco", "bayarea", "LosAngeles", "Seattle", "Portland",
                "Denver", 
                "houston", "Austin", "chicago", "ChicagoSuburbs",
                "boston"),
  tz = c("Etc/GMT-8", "Etc/GMT-8", "Etc/GMT-8", "Etc/GMT-8", "Etc/GMT-8",
         "Etc/GMT-7", 
         "Etc/GMT-6", "Etc/GMT-6", "Etc/GMT-6", "Etc/GMT-6",
         "Etc/GMT-5")
  )

# Thread activity during the last month of 2023 (ran on Dec 31)
city_threads <- 
  lapply(city_subreddits$subreddit, 
         function(s) {
             find_thread_urls(subreddit = s, 
                   sort_by = "new", 
                   period = "month")
         }
  ) |> bind_rows()

# Get thread content
set.seed(2023)
city_comments <- get_thread_content(sample(city_threads$url, 250))

# Users by city subreddit
city_users <- full_join(
  select(city_comments$threads, url, subreddit), 
  select(city_comments$comments, url, author)
  ) |>
  select(author, subreddit) |> 
  distinct() |> 
  rename(hometown = subreddit) |> 
  filter(!duplicated(author))

# User content (takes ~20 hours)
city_user_content <- get_user_content(city_users$author)

## Comments
# remove null values
city_user_comments <- city_user_content[unlist(map(city_user_content, ~!is.null(nrow(.x$comments))))]
# make single dataframe
city_user_comments <- bind_rows(
  map(
    city_user_content, 
    ~select(pluck(.,"comments"),
            date_utc:comment, up)
    )
  ) |> 
  rename(author = comment_author) |> 
  left_join(city_users)

## Threads
# remove null values
city_user_threads <- city_user_content[unlist(map(city_user_content, ~!is.null(nrow(.x$threads))))]
# make single dataframe
city_user_threads <- bind_rows(
  map(
    city_user_threads, 
    ~select(pluck(.,"threads"),
            date_utc:text, ups)
    )
  ) |> 
  rename(up = ups) |> 
  left_join(city_users)

## Data for analysis
# city_user_comments <- read_csv("data/city_users/city_user_comments.csv")
# city_user_threads <- read_csv("data/city_users/city_user_threads.csv")
# city_users <- read_csv("data/city_users/city_users.csv")
city_user_content <- city_user_comments |> 
  rename(text = comment) |> 
  select(timestamp, author, text, hometown) |> 
  bind_rows(
    city_user_threads |> 
      select(timestamp, author, text, hometown)
  ) |> 
  left_join(rename(city_subreddits, hometown = subreddit)) |> 
  mutate(timestamp = lubridate::as_datetime(timestamp),
         weekday = factor(weekdays(timestamp)),
         hour = lubridate::hour(lubridate::with_tz(timestamp, tz)),
         minute = lubridate::minute(lubridate::with_tz(timestamp, tz)),
         time = hour + (minute/60)) |> 
  # choose max 100 texts from each user
  drop_na() |> 
  group_by(author) |> 
  slice_sample(n = 100)

library(quanteda)
library(quanteda.dictionaries)

# NRC "sadness" lexicon
sadness_dict <- dictionary(
    list(sadness = quanteda.sentiment::data_dictionary_NRC$sadness)
    )

city_user_corpus <- city_user_content |> 
  # clean data
  mutate(clean_text = tm::removeNumbers(text),
         clean_text = tm::removePunctuation(clean_text),
         clean_text = tm::stripWhitespace(clean_text)) |>
  corpus(text_field = "clean_text")

reddit_sadness <- city_user_corpus |> 
  liwcalike(dictionary = sadness_dict) |> 
  select(sadness) |> 
  bind_cols(city_user_content) |> 
  mutate(hometown = factor(hometown),
         author = factor(author))

# Rolling averages for plotting
reddit_sadness_agg <- reddit_sadness |> 
  # duplicate on both sides for pseudo-circularity
  bind_rows(
    reddit_sadness |> filter(time < 12) |> mutate(time = time + 24),
    reddit_sadness |> filter(time > 12) |> mutate(time = time - 24)
  ) |> 
  # convert time of day to fictive datetime (for timetk)
  mutate(time = lubridate::as_datetime(time*60*60)) |> 
  # rolling average (3 hour window)
    # first by individual user
  group_by(hometown, author, weekday) |> 
  timetk::summarise_by_time(
    time,
    .by = "15minutes",
    sadness = mean(sadness, na.rm = TRUE)
  ) |> 
    # then by hometown and weekday
  group_by(hometown, weekday) |> 
  timetk::summarise_by_time(
    time,
    .by = "15minutes",
    sadness = mean(sadness, na.rm = TRUE)
  ) |> 
  mutate(weekday = factor(weekday, 
                          levels = c("Sunday", "Monday", 
                                     "Tuesday", "Wednesday", 
                                     "Thursday", "Friday", 
                                     "Saturday")
                          )
         )

# save to avoid long render time
# save(reddit_sadness_agg, file = "data/reddit_sadness.RData")
```

```{r}
#| echo: false
#| warning: false
#| fig-height: 10

load("data/reddit_sadness.RData")
library(patchwork)
library(ggborderline)

goodplot3 <- reddit_sadness_agg |> 
  ggplot(aes(time, sadness, color = weekday, group = weekday)) +
    stat_smooth(aes(bordercolor = after_scale(colorspace::darken(color))), 
                geom = "borderline", 
                linewidth = 2, 
                method = "loess", 
                se = FALSE) +
    scale_color_discrete(type = hcl.colors(7, "Sunset", rev = TRUE)) +
    scale_x_datetime(date_labels = "%R", date_breaks = "4 hours") +
    scale_y_continuous(labels = scales::label_percent(scale = 1)) +
    labs(title = "Sequential Color Scale",
         x = "Time of Day",
         y = "Sadness-Related Words",
         color = "") +
    theme_minimal() +
    theme(plot.title = element_text(color = "green3", hjust = 1, size = 15),
          panel.grid.major.x = element_line(linewidth = .2),
          panel.grid.minor.x = element_line(linewidth = .8)) +
    coord_cartesian(xlim = c(lubridate::as_datetime(0), 
                             lubridate::as_datetime(24*60*60)))

badplot3 <- reddit_sadness_agg |> 
  ggplot(aes(time, sadness, color = weekday, group = weekday)) +
    stat_smooth(aes(bordercolor = after_scale(colorspace::darken(color))), 
                geom = "borderline", 
                linewidth = 2, 
                method = "loess", 
                se = FALSE) +
    scale_x_datetime(date_labels = "%R", date_breaks = "4 hours") +
    scale_y_continuous(labels = scales::label_percent(scale = 1)) +
    labs(title = "Qualitative Color Scale",
         x = "Time of Day",
         y = "Sadness-Related Words",
         color = "") +
    theme_minimal() +
    theme(plot.title = element_text(color = "red3", hjust = 1, size = 15),
          panel.grid.major.x = element_line(linewidth = .2),
          panel.grid.minor.x = element_line(linewidth = .8)) +
    coord_cartesian(xlim = c(lubridate::as_datetime(0), 
                             lubridate::as_datetime(24*60*60)))

goodplot3 / badplot3
```

Both versions are confusing to look at (these data might be better represented as a heat map), but the one with the sequential color scale is much better. Whereas the qualitative scale requires the viewer to look constantly back and forth between the legend and the plot, the sequential scale maps to an intuitive understanding of beginning-of-week vs. end-of-week.

We have seen that many seemingly unordered variables should be ordered in the context of a story. Nevertheless, some variables are truly **qualitative**. In these cases, the color scale should maximize contrast between neighboring values without accidentally suggesting an order. For example, "Parts of Speech" in the figure below are all soft pastel colors. If some were darker or more saturated, it might suggest that there is an important difference between the groups.

Again, keep in mind any associations people might have with colors involved. For example, countries should be represented by colors that appear in their flags. This is of course sometimes difficult---all of the countries in the figure below have red in their flag, and all but China have blue and white. Nevertheless, try your best. The [Wikipedia page for national colors](https://en.wikipedia.org/wiki/National_colours) was helpful in making the chart below.

```{r}
#| echo: false
# custom colors for countries
country_colors <- c("#b32134", "#679267", "#ffb200", "#4b9ed1", "#00247d")
# simple data
tibble(num = factor(1:5),
       components = c("Verbal\nComprehension", "Visual-Spatial", 
                      "Fluid Reasoning", "Working Memory", "Processing Speed"),
       countries = c("U.S.A.", "Russia", "China", "France", "U.K."),
       speech_parts = c("Nouns", "Verbs", "Adjectives", "Articles", "Pronouns")) |> 
  ggplot(aes(num)) +
    # Intellingence Component
    geom_tile(aes(y = "Intelligence\nComponent", fill = num), width = .95, height = .9) +
    geom_text(aes(y = "Intelligence\nComponent", color = num, label = components), 
              size = 3.5, hjust = .5) +
    scale_fill_brewer(palette = "Set1", guide = "none") +
    scale_color_manual(values = contrast(brewer.pal(5, "Set1"),.9),
                       guide = "none") +    
    new_scale_fill() +
    new_scale_color() +
    # Country
    geom_tile(aes(y = "Country", fill = num), width = .95, height = .9) +
    geom_text(aes(y = "Country", color = num, label = countries), 
              size = 3.5, hjust = .5) +
    scale_fill_manual(values = country_colors, guide = "none") +
    scale_color_manual(values = contrast(country_colors,.7),
                       guide = "none") +
    new_scale_fill() +
    new_scale_color() +
    # Parts of Speech
    geom_tile(aes(y = "Parts of\nSpeech", fill = num), width = .95, height = .9) +
    geom_text(aes(y = "Parts of\nSpeech", color = num, label = speech_parts), 
              size = 3.5, hjust = .5) +
    scale_fill_manual(
      values = hcl.colors(5, "Pastel 1", rev = TRUE), guide = "none"
      ) +
    scale_color_manual(
      values = contrast(hcl.colors(5, "Pastel 1", rev = TRUE),.7),
      guide = "none"
      ) +
    labs(title = "Qualitative Color Scales",
         subtitle = "for variables with no order") +
    coord_fixed(ratio = .95/.9) + 
    theme_void() +
    theme(plot.title = element_text(size = 20, hjust = .5),
          plot.subtitle = element_text(hjust = .5),
          axis.text.y = element_text())
```

### Accent colors {#sec-accent-colors}

Because color has many dimensions, it can sometimes be used to represent two scales at the same time. One common tactic is to use luminosity or saturation to emphasize certain values and de-emphasize others. Below, we have redrawn the frequency ratio plot from earlier in this chapter (@sec-nonlinear-axes) to tell a story about two words in particular. By using accent colors to emphasize the two words of interest, we remove distractors while maintaining the broader context of the story.[^telling-a-story-1]

[^telling-a-story-1]: In the example here, we used `ggnewscale` to control the accented an non-accented color scales separately. If you'd like a simpler method for accenting values without using layered geoms, we recommend the `gghighlight` package.

```{r}
#| fig-width: 6
#| fig-height: 6
library(ggnewscale)

set.seed(2023)
distressed_texts_binary_ordered |> 
  ggplot(aes(word, distressed_freq_ratio, 
             label = word, 
             color = distressed_freq_ratio < 1)) +
    geom_point() +
    geom_hline(linetype = 2, yintercept = 1) +
    scale_color_discrete(
      type = colorspace::lighten(c("#F8766D", "#00BFC4"), .7)) +
    geom_text_repel(
      size = 3, 
      data = distressed_texts_binary_ordered |> 
        filter(distressed_freq_ratio > 3.6 
               | distressed_freq_ratio < .2),
      max.overlaps = 20) +
    guides(color = "none") +
    new_scale_color() +
    geom_point(
      aes(color = distressed_freq_ratio < 1), 
      size = 3,
      data = distressed_texts_binary_ordered |> 
        filter(word %in% c("i", "we"))) +
    geom_text_repel(
      size = 4, 
      data = distressed_texts_binary_ordered |> 
        filter(word %in% c("i", "we")),
      max.overlaps = 20) +
    labs(title = '"We" is a Sign of Distress',
         x = "Words, from least to most distressed",
         y = "Distressed frequency / non-distressed frequency") +
    scale_y_continuous(breaks = c(2^(-6:6)), 
                       trans = "log2", 
                       labels = ~MASS::fractions(.x)) +
    guides(color = "none") +
    theme_minimal() +
    theme(plot.title = element_text(hjust = .5, size = 18),
          panel.grid.major.x = element_blank(),
          axis.text.x = element_blank(),
          axis.ticks.x = element_blank())
```

### Aspect Ratios {#sec-aspect-ratios}

@simchon_etal_2021 investigated whether COVID-19 concern among New Yorkers resulted in higher or lower levels of certainty, as expressed in language on Twitter. Their story: Higher concern leads to greater expressions of certainty, since people use certainty as a coping mechanism. Here is their Figure 3, reproduced in three different aspect ratios:

```{r}
#| include: false
covid <- read_csv("https://osf.io/download/mvhzg/") # takes a little while to download

covid_agg <- covid |> 
  mutate(created_at = as.POSIXct(created_at, format = "%m/%d/%Y %H:%M"),
         date = as.Date(created_at)) |> 
  group_by(date) |> 
  summarise(cert = mean(certain, na.rm = TRUE),
            tent = mean(tentat, na.rm = TRUE),
            anx = mean(anx, na.rm = TRUE),
            anger = mean(anger, na.rm = TRUE),
            negemo = mean(negemo, na.rm = TRUE)
            )

covid_concern <- read_csv("https://osf.io/download/846dp/") |> 
  mutate(date = as.Date(date, format = "%m/%d/%Y")) |> 
  left_join(covid_agg)
```

```{r}
#| warning: false
#| fig-width: 10
#| fig-height: 8
library(patchwork)

plot <- covid_concern |> 
  mutate(z_cert = as.numeric(scale(cert)),
         z_concern = as.numeric(scale(ny_net_concern))) |> 
  pivot_longer(cols = c(z_cert, z_concern)) |> 
  mutate(name = if_else(name=="z_cert", "Certainty", "NY Net Concern")) |> 
  ggplot() +
    geom_smooth(aes(date, value, 
                    linetype = name), 
                se = FALSE, method = "loess", 
                color = "black", span = 1/3, 
                method.args = list(degree=1)) +
    ylab("Z-score") + 
    xlab("Date") + 
    scale_colour_grey() +
    cowplot::theme_cowplot() + 
    labs(linetype =c(""))

plot_squished <- plot + 
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

(plot_squished + plot_squished +  
    plot_layout(widths = c(1, 2))) / 
  plot + plot_layout(heights = c(2, 1)) +
  plot_annotation(tag_levels = 'A')
```

Which aspect ratio is the right one? A good aspect ratio is one that communicates the meaning of the variables in question. Since months are spread out over time (by definition), it makes sense to make the x-axis longer so that viewers have the feeling of time passing as they scan it. But it shouldn't be too wide, since the aspect ratio should also emphasize important differences in position (here, the positive slope of both lines). Something in between B and C seems appropriate. Indeed, this is the figure printed in the final paper:

![](images/simchon_etal_2021_fig3.png)

------------------------------------------------------------------------

As always, press the "View Source" button below to see the hidden code blocks in this chapter.

------------------------------------------------------------------------