Reputation: 7735
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.
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
Reputation: 125338
Making use of the secondary axis trick by Claus Wilke you could do:
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