pacman::p_load(tidyverse, ggthemes, cowplot, plotly, purrr, magick, knitr)

Signal detection measures

Signal detection theory models an observer’s ability to discriminate between signal and noise events, which are associated with separate evidence distributions. Upon observing a stimulus, an observer extracts evidence to decide from which one an evidence value originated. Performance is described in terms of two measures: sensitivity and bias.

Sensitivity

# number of frames
frames <- 9
 
# function for creating file name with leading zeros
rename <- function(x){
  if (x < 10) {
    return(name <- paste('000',i,'plot_d.png',sep=''))
  }
  if (x < 100 && i >= 10) {
    return(name <- paste('00',i,'plot_d.png', sep=''))
  }
  if (x >= 100) {
    return(name <- paste('0', i,'plot_d.png', sep=''))
  }
}
 
# loop through plots
for(i in 1:frames){
  name <- rename(i)
   
  # saves the plot as a .png file in working directory
  png(name)
  factor <- i + 1
  d <- -2 + factor
  Xc <- d/2 # unbiased position halfway between S+N distributions
  
  # code for plot
  print(ggplot(NULL, aes(c(-4,6 + factor))) +
  geom_line(stat = "function", fun = dnorm, 
            args = list(mean = 0)) +
  annotate("text", label = "Noise", 
           x = 0 - 1, y = .42, size = 5) + 
  geom_line(stat = "function", fun = dnorm, 
            args = list(mean = d)) +
  annotate("text", label = "Signal", 
           x = d + 1, y = .42, size = 5) + 
  theme(axis.text.y = element_blank()) + 
  scale_x_continuous(breaks = seq(-4, 6 + factor, 1)) +
  expand_limits(0,0) +
  labs(x = "Evidence value", y = NULL, 
       title = "Signal Detection Theory: Sensitivity",
       
       subtitle = "Sensitivity (d') is an observer's ability to discriminate signal from noise.
It varies with the distance between the signal and noise distributions and is
measured as the difference between the observer's standardized hit and false
alarm rates: d' = z(HR) - z(FAR).\n",

      caption = "Hit rate = proportion of correctly identified signals
False alarm rate = proportion of noise events incorrectly identified as signals") + 
  
  theme(plot.subtitle = element_text(size = 11.5)) +
  
  # draw criterion
  geom_segment(aes(x = Xc, y = 0, xend = Xc, yend = .48), 
               size = .5, linetype = 2, hjust = 0.5) +
  annotate("text", label = "Criterion", 
           x = Xc, y = .5, 
           size = 5, color = 'gray27') + 
  
  # fill hit rate area and add legend
  geom_area(stat = "function", 
            fun = dnorm, 
            args = list(mean = d), 
            fill = "#D55E00", 
            alpha = .4, 
            xlim = c(Xc, 6 + factor)) +
  annotate("rect",  xmin = .6 + factor, 
           xmax = .9 + factor, ymin = .4, ymax = .42, 
           color = 'black', fill = "#D55E00", alpha = .7) + 
  annotate("text",  label = "Hit rate", 
           x = 1 + factor, y = .41,
           size = 5, hjust = 0) + 
  
  # fill FA rate area and add legend
  geom_area(stat = "function", fun = dnorm, 
            fill = "#0072B2", alpha = .4, 
            xlim = c(Xc, 6 + factor)) +
  annotate("rect",  xmin = .6 + factor, 
           xmax = .9 + factor, ymin = .36, ymax = .38, 
           color = 'black', fill = "#0072B2", alpha = .7) + 
  annotate("text",  label = "False alarm rate", 
           x = 1 + factor, y = .37,
           size = 5, hjust = 0))
  
  dev.off()
}
 

d <- list.files(path = "E:/2nd year classes/Spring/Data visualization/assignment_4", pattern = "*plot_d.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("d_animation.gif")  # write to current dir

knitr::include_graphics(d)

Bias

# number of frames
frames <- 9
 
# function for creating file name with leading zeros
rename <- function(x){
  if (x < 10) {
    return(name <- paste('000',i,'plot.png',sep=''))
  }
  if (x < 100 && i >= 10) {
    return(name <- paste('00',i,'plot.png', sep=''))
  }
  if (x >= 100) {
    return(name <- paste('0', i,'plot.png', sep=''))
  }
}
 
# loop through plots
for(i in 1:frames){
  name <- rename(i)
   
  # saves the plot as a .png file in working directory
  png(name)
  d <- 2
  factor <- i + 1
  Xc  <- -5 + factor # start 1 lower than intended since factor adds 1
  
  # code for plot
  print(ggplot(NULL, aes(c(-4,6))) +
  geom_line(stat = "function", fun = dnorm, 
            args = list(mean = 0)) +
  annotate("text", label = "Noise", 
           x = 0, y = .42, size = 5) + 
  geom_line(stat = "function", fun = dnorm, 
            args = list(mean = d)) +
  annotate("text", label = "Signal", 
           x = d, y = .42, size = 5) + 
  theme(axis.text.y = element_blank()) + 
  scale_x_continuous(breaks = seq(-4, 6, 1)) +
  expand_limits(0,0) +
  labs(x = "Evidence value", y = NULL,
       title = "Signal Detection Theory: Bias",
       
       subtitle = "Bias is the tendency to respond 'signal' or 'noise' and depends on the criterion
adopted by the observer. Evidence values above the criterion are transformed
into signal judgments and values below are transformed into noise judgments.
The optimal criterion setting depends on the base rates of signal and noise events
and the payoffs for hits and false alarms.\n",

      caption = "Hit rate = proportion of correctly identified signals
False alarm rate = proportion of noise events incorrectly identified as signals") + 
  theme(plot.subtitle = element_text(size = 11.5)) + 
  
  # draw criterion
  geom_segment(aes(x = Xc, y = 0, xend = Xc, yend = .48), 
               size = .5, linetype = 2, color = 'gray27') +
  annotate("text", label = "Criterion", 
           x = Xc, y = .5, 
           size = 5, color = 'gray27') + 
  
  # fill hit rate area and add legend
  geom_area(stat = "function", 
            fun = dnorm, 
            args = list(mean = d), 
            fill = "#D55E00", 
            alpha = .4, 
            xlim = c(Xc, 6)) +
  annotate("rect",  xmin = 3.6, xmax = 3.9, ymin = .4, ymax = .42, 
           color = 'black', fill = "#D55E00", alpha = .7) + 
  annotate("text",  label = "Hit rate", 
           x = 4, y = .41, size = 5, hjust = 0) + 
  
  # fill FA rate area and add legend
  geom_area(stat = "function", fun = dnorm, 
            fill = "#0072B2", alpha = .4, 
            xlim = c(Xc, 6)) +
  annotate("rect",  xmin = 3.6, xmax = 3.9, ymin = .36, ymax = .38, 
           color = 'black', fill = "#0072B2", alpha = .7) + 
  annotate("text",  label = "False alarm rate", 
           x = 4, y = .37, size = 5, hjust = 0)) 
  
  dev.off()
}
 

bias <- list.files(path = "E:/2nd year classes/Spring/Data visualization/assignment_4", pattern = "*plot.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("bias_animation.gif") # write to current dir


knitr::include_graphics(bias)