Eric Green
Eric Green

Reputation: 7735

Add row and column totals to figure

I would like to add column and row % to the following figure. For instance, across the top of the plot (outside) it would be 1%, 6%, 17%, and 76%, representing the distribution for Coder 1. Down the right (outside) would be the row distributions.

Maybe this is better as a table, but it feels like it wants to be a figure.

enter image description here

library(tidyverse)
library(ggtext)

x <- structure(c(0L, 1L, 0L, 0L, 1L, 3L, 2L, 0L, 0L, 3L, 11L, 4L, 
0L, 6L, 9L, 62L), .Dim = c(4L, 4L), .Dimnames = list(Prediction = c("0", 
"1", "2", "3"), Truth = c("0", "1", "2", "3")), class = "table")

as_tibble(x) %>%
  rename("Coder 1" = "Truth",
         "Coder 2" = "Prediction") %>%
  mutate(`Coder 1` = as.numeric(`Coder 1`),
         `Coder 2` = as.numeric(`Coder 2`)) %>%
  mutate(diff = factor(abs(`Coder 1` - `Coder 2`)),
         p = (n/sum(n))*100,
         p_ = paste0(round(p, 0), "%")) %>%
  {. ->> cm_actinteract} %>%
  ggplot(aes(x=`Coder 1`, y=`Coder 2`, color=diff)) + 
  geom_tile(color="black", fill=NA) +
  geom_point(aes(size = n)) +
  scale_size(range = c(0, 15)) +
  geom_text(aes(label=p_), alpha=1, color="black") +
  scale_color_manual(values = c(
    "#32B878",
    "#eaed39",
    "#f0a31f",
    "#B8324F"
  )) + 
  theme_minimal() +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        legend.position = "none",
        plot.title.position = "plot",
        plot.title = element_text(face="bold"),
        plot.subtitle = element_markdown()) +
  labs(title="Act/Interact",
       subtitle = paste0("Weighted Kappa = 0.56<br>",
                         "<span style='color:#32B878'>Percent agreement:</span> ", 
                         round(
                           cm_actinteract %>% 
                             filter(diff==0) %>%
                             summarize(sum = sum(p)) %>%
                             pull(sum), 0),
                         "%<br>",
                         "<span style='color:#eaed39'>Off by 1:</span> ",
                         round(
                           cm_actinteract %>% 
                             filter(diff==1) %>%
                             summarize(sum = sum(p)) %>%
                             pull(sum), 0),
                         "%<br>",
                         "<span style='color:#f0a31f'>Off by 2:</span> ",
                         round(
                           cm_actinteract %>% 
                             filter(diff==2) %>%
                             summarize(sum = sum(p)) %>%
                             pull(sum), 0),
                         "%<br>",
                         "<span style='color:#B8324F'>Off by 3:</span> ",
                         round(
                           cm_actinteract %>% 
                             filter(diff==3) %>%
                             summarize(sum = sum(p)) %>%
                             pull(sum), 0),
                         "%")) 

Upvotes: 2

Views: 184

Answers (1)

stefan
stefan

Reputation: 125338

Making use of the secondary axis trick by Claus Wilke you could do:

  1. Aggregate your data by row and column.
  2. Add secondary axes to your plot via dup_axis and set the labels equal to the row or column totals:
library(tidyverse)
library(ggtext)
  
col_total <- cm_actinteract %>% 
  count(`Coder 1`, wt = n) %>% 
  mutate(p = (n/sum(n))*100,
         p_ = paste0(round(p, 0), "%"))

row_total <- cm_actinteract %>% 
  count(`Coder 2`, wt = n) %>% 
  mutate(p = (n/sum(n))*100,
         p_ = paste0(round(p, 0), "%"))

ggplot(cm_actinteract, aes(x=`Coder 1`, y=`Coder 2`, color=diff)) + 
  geom_tile(color="black", fill=NA) +
  geom_point(aes(size = n)) +
  scale_size(range = c(0, 15)) +
  geom_text(aes(label=p_), alpha=1, color="black") +
  scale_x_continuous(sec.axis = dup_axis(breaks = col_total$`Coder 1`, labels = col_total$p_, name = NULL)) +
  scale_y_continuous(sec.axis = dup_axis(breaks = row_total$`Coder 2`, labels = row_total$p_, name = NULL)) +
  scale_color_manual(values = c(
    "#32B878",
    "#eaed39",
    "#f0a31f",
    "#B8324F"
  )) + 
  theme_minimal() +
  theme(panel.grid.major = element_blank(), 
        panel.grid.minor = element_blank(),
        legend.position = "none",
        plot.title.position = "plot",
        plot.title = element_text(face="bold"),
        plot.subtitle = element_markdown()) +
  labs(title="Act/Interact",
       subtitle = paste0("Weighted Kappa = 0.56<br>",
                         "<span style='color:#32B878'>Percent agreement:</span> ", 
                         round(
                           cm_actinteract %>% 
                             filter(diff==0) %>%
                             summarize(sum = sum(p)) %>%
                             pull(sum), 0),
                         "%<br>",
                         "<span style='color:#eaed39'>Off by 1:</span> ",
                         round(
                           cm_actinteract %>% 
                             filter(diff==1) %>%
                             summarize(sum = sum(p)) %>%
                             pull(sum), 0),
                         "%<br>",
                         "<span style='color:#f0a31f'>Off by 2:</span> ",
                         round(
                           cm_actinteract %>% 
                             filter(diff==2) %>%
                             summarize(sum = sum(p)) %>%
                             pull(sum), 0),
                         "%<br>",
                         "<span style='color:#B8324F'>Off by 3:</span> ",
                         round(
                           cm_actinteract %>% 
                             filter(diff==3) %>%
                             summarize(sum = sum(p)) %>%
                             pull(sum), 0),
                         "%")) 

Created on 2021-06-08 by the reprex package (v2.0.0)

Upvotes: 2

Related Questions