Code to make a gif demonstrating varying degrees of reliability, and the amount of measurement error relative to the true variation in the data. This comes from trying to explain concepts in my preprint here: https://www.biorxiv.org/content/early/2018/06/05/274894

reliability_gif.R

library(tidyverse)
library(magick)

# devtools::install_github("thomasp85/patchwork")
library(patchwork)

colours = c("#85d4e3",
            "#e39f85")

set.seed(40)

error_sd <- function(icc) {
  
  # From the reliability formula: rel = sigmaTrue^2 / sigmaTot^2 = sigmaTrue^2 / (sigmaTrue^2 + sigmaError^2)
  
  sqrt(1/icc - 1)  
}


special_dnorm <- function(negative=FALSE, x, mean, sd) {
  
  # This makes a density plot that has the same height, regardless of the variance
  # Also, the negative argument was for another plot to have them facing left and right
  
  maxval <- dnorm(0, mean, sd)
  out <- dnorm(x, mean, sd) / maxval

  out <- out+0.08  # 0.08 is a little offset for aesthetics

  if(negative) {
    out <- out*-1
  }

  return(out)
}


# Make some points

reliability <- tibble(True = rnorm(40)) %>%
  arrange(True) %>%
  mutate(Subject = 1:n())


dir.create("gif_figs")

make_measplot <- function(icc, n=1) {

  # Add measurement error
  
  errorsd <- error_sd(icc)
  reliability$Measured = reliability$True + rnorm(length(reliability$True), sd = errorsd)
  
  
  # And error bars
  
  reliability$Error_upper <- reliability$True + 1.96*errorsd
  reliability$Error_lower <- reliability$True - 1.96*errorsd

  # Make the distribution plot
  
  distroplot <- ggplot(data.frame(x = c(-5, 5)), aes(x)) +   # The data is meaningless - not used
    stat_function(fun = special_dnorm, colour = colours[1],
                  size = 1.5, args = list(negative=F, mean=0, sd=1),
                  geom = "line") +
    annotate("segment", x = 1.96, xend = -1.96, y = 0.03, yend = 0.03,
             colour = colours[1], size=1) +
    stat_function(fun = special_dnorm, colour = colours[2],
                  size = 1.5, args = list(negative=F, mean=0, sd=errorsd),
                  geom = "line") +
    annotate("segment", x = 1.96*errorsd, xend = -1.96*errorsd, y = 0.05, yend = 0.05,
             colour = colours[2], size=1) +
    coord_flip() +
    theme_void() +
    lims(x=c(-5,5)) +
    annotate("text", x = 2.5, y = 0.7, label = "True", size=5, colour=colours[1]) +
    annotate("text", x = -2.5, y = 0.7, label = "Error", size=5, colour=colours[2])


  # Make the measurement plot
  
  relplot <- ggplot(reliability, aes(x=Subject, y=True)) +
    geom_point(size=5, alpha=0.3, colour=colours[1]) +
    theme_void() +
    geom_errorbar(aes(ymin=Error_lower, ymax=Error_upper), width=0, colour=colours[2]) +
    coord_cartesian(ylim = c(-5,5)) +
    annotate("text", x = 10, y = 4, label = paste("ICC =", round(icc, 2), sep=" "), size=5) +
    geom_point(aes(y=Measured))


  # Put them together
  
  out <- relplot + distroplot + plot_layout(ncol = 2, widths = c(3, 1))

  # Making a naming scheme so that they're in the right order
  
  icc_error <- 100-(100*icc)

  # Save
  
  ggsave(out, filename = sprintf(paste("gif_figs/", stringr::str_pad(icc_error, side="left", pad="0", width = 2),
                                       "_iccplot_%d.png", sep=""), n), width = 9, height = 5, dpi=200)

  return(out)

}


# Make a bunch of them

iccvals <- c(0.99, 0.9,  0.8, 0.7, 0.6, 0.5, 0.4, 0.2)
each_times <- 6

# I was too lazy to do this tidily. Forgive me Hadley for I have sinned.

for(i in 1:length(iccvals)) {
  for(j in 1:each_times) {
    make_measplot(iccvals[i], j)
  }
}


# Make a gif!

list.files(path = "./gif_figs/", pattern = "*.png", full.names = T) %>%
  map(image_read) %>% # reads each path file
  image_join() %>% # joins image
  image_animate(fps=2) %>% # animates, can opt for number of loops
  image_write("reliability_change.gif") # write to current dir