Visualizing Covariance

Correlation? I get it. I have a gut-level sense of what it is. Covariance? Somehow it just eludes me. I mean, I know the formulas, and I can give you a conceptual definition of it—but its meaning never really sunk in.

One thing about covariance that always seemed counterintuitive to me is that covariance between two variables of unequal variance can sometimes be larger than the variance of the variable with less variance. For example, if X has a variance of 9, Y has a variance of 64 and the correlation between X and Y is 0.5, the covariance between X and Y is 12. How can X have a larger covariance with Y than its own variance (i.e., its covariance with itself)? Never made sense to me.

To figure it out, I created a little web app that allows the user to change the standard deviations of variables x and y, as well as the correlation between the two variables.

#| '!! shinylive warning !!': |
#|   shinylive does not work in self-contained HTML documents.
#|   Please set `embed-resources: false` in your metadata.
#| standalone: true
#| viewerHeight: 650
library(shiny)
library(glue)
library(dplyr)
library(tibble)
library(ggplot2)
library(ggtext) 
# ?geom_rect

prob_label <- function (p, accuracy = 0.01, digits = NULL, max_digits = NULL, 
    remove_leading_zero = TRUE, round_zero_one = TRUE) 
{
    if (is.null(digits)) {
        l <- scales::number(p, accuracy = accuracy)
    }
    else {
        sig_digits <- abs(ceiling(log10(p + p/1e+09)) - digits)
        pgt99 <- p > 0.99
        sig_digits[pgt99] <- abs(ceiling(log10(1 - p[pgt99])) - 
            digits + 1)
        sig_digits[ceiling(log10(p)) == log10(p) & (-log10(p) >= 
            digits)] <- sig_digits[ceiling(log10(p)) == log10(p) & 
            (-log10(p) >= digits)] - 1
        sig_digits[is.infinite(sig_digits)] <- 0
        l <- purrr::map2_chr(p, sig_digits, formatC, format = "f", 
            flag = "#")
    }
    if (remove_leading_zero) 
        l <- sub("^-0", "-", sub("^0", "", l))
    if (round_zero_one) {
        l[p == 0] <- "0"
        l[p == 1] <- "1"
        l[p == -1] <- "-1"
    }
    if (!is.null(max_digits)) {
        if (round_zero_one) {
            l[round(p, digits = max_digits) == 0] <- "0"
            l[round(p, digits = max_digits) == 1] <- "1"
            l[round(p, digits = max_digits) == -1] <- "-1"
        }
        else {
            l[round(p, digits = max_digits) == 0] <- paste0(".", 
                paste0(rep("0", max_digits), collapse = ""))
            l[round(p, digits = max_digits) == 1] <- paste0("1.", 
                paste0(rep("0", max_digits), collapse = ""))
            l[round(p, digits = max_digits) == -1] <- paste0("-1.", 
                paste0(rep("0", max_digits), collapse = ""))
        }
    }
    l <- sub(pattern = "-", replacement = "−", x = l)
    Encoding(l) <- "UTF-8"
    dim(l) <- dim(p)
    l
}
ui <- fluidPage(
  sidebarLayout(
      mainPanel(
      plotOutput(outputId = "distPlot",width = "400px", height = "400px")
    ),
    sidebarPanel(
      div(style="display: inline-block; width: 200px;",
      sliderInput(
        inputId = "sd_blue",
        label = "SD for x:",
        min = 1,
        max = 10,
        value = 10
      )),
      div(style="display: inline-block; width: 200px;",
      sliderInput(
        inputId = "sd_red",
        label = "SD for y:",
        min = 1,
        max = 10,
        value = 10
      )),
      div(style="display: inline-block; width: 200px;",
      sliderInput(
        inputId = "r",
        label = "Correlation (r)",
        min = 0,
        max = 1,
        value = .5, step = .01
      ))
    )
    
  )
)
server <- function(input, output) {
  output$distPlot <- renderPlot({
    sd_blue <- input$sd_blue
    sd_red <- input$sd_red
    r <- input$r
    x_red <- sd_red / 2
    y_red <- x_red + sd_blue
    x_blue <- sd_red + sd_blue / 2
    y_blue <- sd_blue / 2
    x_pink <- x_blue
    y_pink <- y_red
    x_purple <- x_blue
    y_purple <- sd_blue + r * sd_red / 2
    tibble(
      x = c(x_red, x_blue, x_pink, x_purple),
      y = c(y_red, y_blue, y_pink, y_purple),
      width =  c(sd_red, sd_blue, sd_blue, sd_blue),
      height = c(sd_red, sd_blue, sd_red, sd_red  * r),
      color = c("firebrick4", "dodgerblue4", "orchid", "orchid4"),
      label = c(
        glue("Var(*y*) = {sd_red ^ 2}"),
        glue("Var(*x*) = {sd_blue ^ 2}"),
        "",
        glue("Cov(*xy*) = {round(sd_blue * sd_red * r, 2)}")
      )
    ) %>%
      ggplot(aes(x, y)) +
      geom_tile((aes(
        width = width,
        height = height,
        fill = I(color)
      ))) +
      geom_richtext(
        aes(label = label),
        color = "white",
        size = 4,
        fill = NA,
        label.color = NA
      ) +
      geom_segment(
        data = tibble(
          x = c(sd_red, sd_red, sd_red + sd_blue),
          y = c(sd_blue, sd_blue, sd_blue),
          xend = c(sd_red + sd_blue, sd_red, sd_red + sd_blue),
          yend = c(sd_blue, sd_red + sd_blue, r * sd_red + sd_blue)
        ),
        aes(xend = xend, yend = yend),
        color = "white",
        arrow = arrow(
          15,
          length = unit(10, "pt"),
          ends = "both",
          type = "closed"
        )
      ) +
      geom_richtext(
        data = tibble(
          x = c(x_blue, sd_red, sd_red + sd_blue),
          y = c(sd_blue, x_pink, y_purple),
          label = c(
            glue("SD~*x*~ = {sd_blue}"),
            glue("SD~*y*~ = {sd_red}"),
            glue("*r*~*xy*~ = {prob_label(r)}")
          ),
          angle = c(0, 90, 90),
          vjust = c(.5, .5, 1.1)
        ),
        aes(
          label = label,
          angle = angle,
          vjust = vjust
        )
      ) +
      scale_x_continuous(NULL, 
                         expand = expansion(add = 1), 
                         limits = c(0, 20)) +
      scale_y_continuous(NULL, 
                         expand = expansion(add = 1), 
                         limits = c(0, 20))+
      coord_equal(clip = "off") +
      theme_void() +
      theme(panel.background = element_rect("black"))
  })
}
shinyApp(ui = ui, server = server)

The area of the blue square is equal to the variance of X. The area of the red square is equal to the variance of Y. The pink rectangle (which is partially occluded by the purple rectangle) is how large covariance could be if X and Y were perfectly correlated. The area of the purple square is equal to the covariance between X and Y. The ratio of the area of the purple rectangle to the area of the pink rectangle is equal to the correlation between X and Y.

I’m not sure why but this visualization has made me feel better about covariance. It’s like were friends now. 😉

Note

Originally posted 2012-09-13 on AssessingPsyche. The original article had a web app created with Mathematica’s computatable document format. Because link to the app is now dead, I recreated the app in Shinylive.