perceived correlation of rank

image.md

rank correlation.R

library(tidyverse)
library(patchwork)
library(glue)
library(ggtext)

set.seed(2)
N = 200

# scale a vector to be between 0 and 1
unitify = function(a) { (a - min(a)) / (max(a) - min(a)) }

data = tibble(
  X = rnorm(N),
  Y = rnorm(N,0.3*X),
  rank_X = rank(X),
  rank_Y = rank(Y)
)

# plot original
ggplot(data) +
  aes(x=X, y=Y) +
  geom_point(color="red", alpha=0.5, size=2.5) +
  labs(title = glue('Correlation r = {sprintf("%.2f", cor(data$X, data$Y))}')) +
  theme_classic(15) +
# plot ranked
ggplot(data) +
  aes(x=rank_X, y=rank_Y) +
  geom_point(color="red", alpha=0.5, size=2.5) +
  labs(title = glue('Correlation r = {sprintf("%.2f", cor(data$rank_X, data$rank_Y))}')) +
  theme_classic(15) +
# plot both with arrows
ggplot(data) +
  aes(x=unitify(X), y=unitify(Y), xend=unitify(rank_X), yend=unitify(rank_Y)) +
  geom_point(color="blue", alpha=0.5, size=5) +
  geom_point(aes(x=unitify(rank_X), y=unitify(rank_Y)), color="red", alpha=0.5, size=5) +
  geom_segment(linewidth=1, color="#333333", arrow=arrow(length = unit(10, "points"), type="closed")) +
  coord_equal() +
  labs(x="X", y="Y",
       title = glue('From <span style="color:blue; opacity:0.5">Original (r = {sprintf("%.2f", cor(data$X, data$Y))})</span> to <span style="color:red; opacity:0.5">Ranked (r = {sprintf("%.2f", cor(data$rank_X, data$rank_Y))})</span>')) +
  theme_classic(15) +
  # make the title fancy
  theme(plot.title = element_markdown()) +
# layout
patchwork::plot_layout(design = "
12
33
33")