---
title: "Experiment 1 Stimuli"
output: html_document
date: "2023-06-05"
---

```{r setup, include=FALSE}

library(tidyverse)
library(ggdist)
library(xts)
library(distributional)
library(moments)

# Set random seed
set.seed(6)

# Set up the theme for image export
theme_set(theme_classic() + 
            theme(plot.title = element_text(size = 10, color = "#333333"),
                  axis.title = element_text(size = 7, color = "#262626"),
                  axis.text = element_text(size = 5, color = "#1B1B1B"),
                  axis.line = element_line(linewidth = 0.25, color = "#1B1B1B"),
                  axis.ticks = element_line(linewidth = 0, color = "#1B1B1B"),
                  axis.line.y = element_blank(),
                  axis.text.y = element_blank(),
                  axis.ticks.y = element_blank(),
                  axis.title.y = element_blank()))

# Variable for setting the x-axis range on either side of the mean
x_range <- 4

```


# Generating Distributions

```{r distribution generator}

## set values

n <- 13 # number of stimuli to generate
target <- 32 # target value of interest
range <- 2 # range for distance from target value
min_mean <- target - range # lower end of possible mean values
max_mean <- target + range # higher end of possible mean values
sd <- 1 # set value for standard deviation of the distributions - value selected based on Padilla, L. M., Powell, M., Kay, M., & Hullman, J. (2021). Uncertain about uncertainty: How qualitative expressions of forecaster confidence impact decision-making with uncertainty visualizations.
dist_n <- 100 # number of values in the distribution
tail_pct <- 0 # pct likelihood of tail value for attention check


## create dataframe structure
df <- data.frame(
  trial = 0:(n-1),
  mean = NA,
  sd = NA,
  crossover_distance = NA,
  freeze.pct = NA,
  min = NA,
  max = NA, 
  tail.value = NA,
  tail.pct = NA,
  distribution = NA,
  skew = NA
)

## generate distributions
for (i in 1:n) { # for each trial
  
  mean <- sample(seq(min_mean, max_mean), 1) # randomly select the mean of the distribution
  
  data <- rnorm(dist_n, mean, sd) # create distribution
  df$mean[i] <- mean(data) # add mean to the data frame
  df$sd[i] <- sd(data) # add mean to the data frame
  
  # calculate the optimal crossover here
  cost_salt <- 1000 # cost to salt
  cost_notsalt <- 3000 # cost if not salting
  p = cost_salt / cost_notsalt # probability of interest
  # first, recenter the data such that the probability of 32º is at p
  ecdf_data <- ecdf(data) # compute the ECDF
  current_p <- quantile(ecdf_data, p) # find the value at the 33rd percentile
  shift <- 32 - current_p # calculate the shift required
  shifted_data <- data + shift # shift the data
  crossover <- mean(shifted_data) # calculate new mean
  df$crossover_distance[i] <- mean(data) - crossover # add the distance from crossover
  
  
  df$distribution[i] <- list(data) # add to the data frame
  
  prob_target <- sum(data <= target) / length(data)
  df$freeze.pct[i] <- prob_target # add to the data frame
  
  df$min[i] <- round(min(data)) # round the minimum value, store it
  
  df$max[i] <- round(max(data)) # round the maximum value, store it
  
  df$fifty.1[i] <-  round(quantile(data, 0.25), 0) # first value in the 50% interval
  df$fifty.2[i] <-  round(quantile(data, 0.75), 0) # second value in the 50% interval
  print(c(df$fifty.1[i], df$fifty.2[i]))
  tail_value <- floor(min(data)) - 1 # get a value with 0% chance of occurring for attention checks
  df$tail.value[i] <- tail_value # add to the data frame
  
  prob_tail <- sum(data <= round(tail_value, 0)) / length(data) # confirm this value has a 0% likelihood
  df$tail.pct[i] <- prob_tail # add to the data frame
  
  df$skew[i] <- skewness(data) # calculate and store the skew value for the distribution
  
}

write_excel_csv(df %>% select(-distribution), "E1_stimuli_data.csv")  # export this data for later use
# write_excel_csv(df, "E1_stimuli_data.csv")  # export this data for later use

```


# Text Stimuli

```{r}

# create dataframe structure
df_text <- data.frame(
  trial = 0:(n-1),
  text_concrete = NA,
  text_fuzzy = NA
)

# Define intervals and labels for skew 
# for both concrete and fuzzy conditions
skew_intervals <- c(-1, -0.5, -0.3, -0.1, 0, 0.1, 0.3, 0.5, 1)
skew_labels_concrete <- c(
  "It is also significantly more likely to be warmer than cooler within that range",
  "It is also more likely to be warmer than cooler within that range",
  "It is also somewhat more likely to be warmer than cooler within that range",
  "It is also slightly more likely to be warmer than cooler within that range",
  "It is also slightly more likely to be cooler than warmer within that range",
  "It is also somewhat more likely to be cooler than warmer within that range",
  "It is also more likely to be cooler than warmer within that range",
  "It is also significantly more likely to be cooler than warmer within that range"
)
skew_labels_fuzzy <- c(
  "It also appears significantly more likely to be warmer than cooler within that range",
  "It also appears more likely to be warmer than cooler within that range",
  "It also appears somewhat more likely to be warmer than cooler within that range",
  "It also appears slightly more likely to be warmer than cooler within that range",
  "It also appears slightly more likely to be cooler than warmer within that range",
  "It also appears somewhat more likely to be cooler than warmer within that range",
  "It also appears more likely to be cooler than warmer within that range",
  "It also appears significantly more likely to be cooler than warmer within that range"
)


for (i in 1:n) {
  
  data <- unlist(df$distribution[i]) # get access to full distribution
  
  # store skew descriptions
  skew_description_concrete <- cut(df$skew[i], breaks = skew_intervals, labels = skew_labels_concrete, right = TRUE)
  skew_description_fuzzy <- cut(df$skew[i], breaks = skew_intervals, labels = skew_labels_fuzzy, right = TRUE)
  
  # use template to create and store concrete condition
  df_text$text_concrete[i] <- paste0(
    "The most likely temperature low tonight is ",
    df$mean[i],
    "ºF. There is a 50% chance that the temperature will fall between ",
    df$fifty.1[i],
    " and ",
    df$fifty.2[i],
    "ºF. While the range of possible lows spans ",
    df$min[i],
    " to ",
    df$max[i],
    "ºF, those extremes are less likely. ",
    skew_description_concrete,
    "."
  )
  # use template to create and store fuzzy condition
  df_text$text_fuzzy[i] <- paste0(
    "The most likely temperature low tonight ",
    "might be around ", # hedge word
    df$mean[i],
    "ºF. There is a 50% chance that the temperature ",
    "could fall between ", # hedge word
    round(quantile(data, 0.25), 0),
    " and ",
    round(quantile(data, 0.75), 0),
    "ºF. While the range of possible lows ",
    "could potentially span ", # hedge word
    df$min[i],
    " to ",
    df$max[i],
    "ºF, those extremes ",
    "seem less likely. ", # hedge word
    skew_description_fuzzy, # hedge word
    "."
  )
  
}


```


# Visual Stimuli

```{r plots, echo = FALSE}

for (i in 1:n) {
  
  trial_data <- df[i,]
  mean <- trial_data$mean
  data <- data.frame(distribution = unlist(trial_data$distribution))
  
  # Density plot
  density.solid <- 
    ggplot(data, aes(x = distribution)) +
    stat_slab(show.legend = c(size = FALSE,
                              slab_alpha = FALSE), fill = "#606B76", alpha = 0.62) +
    scale_x_continuous(breaks = seq(mean - x_range, mean + x_range),
                       limits = c(mean - x_range, mean + x_range))+
    labs(x = "\nºF",
         title = "Estimated Temperature")
  # export and save image
  # commented out to preserve the image files already stored
  # path_and_filename <- paste0("Visualization/", "density.solid.", trial_data$trial, ".png")
  # ggsave(path_and_filename,
  #        plot = density.solid,
  #        width = 1200, height = 800, units = "px")
  # dir.create(dirname(path_and_filename), showWarnings = FALSE)
  
  
  # 20 quantile dot plot
  quantile <- 
    ggplot(data, aes(x = distribution)) +
    stat_dots(position = "dodgejust",
              quantiles = 20,
              color = NA, 
              size = 5,
              fill = "#606B76", alpha = 0.62)+
    scale_x_continuous(breaks = seq(mean - x_range, mean + x_range),
                       limits = c(mean - x_range, mean + x_range))+
    labs(x = "\nºF",
         title = "Estimated Temperature")
  path_and_filename <- paste0("Visualization/", "quantile_20.", trial_data$trial, ".png")
  # export and save image
  # commented out to preserve the image files already stored
  # ggsave(path_and_filename,
  #        plot = quantile,
  #        width = 1200, height = 800, units = "px")
  # dir.create(dirname(path_and_filename), showWarnings = FALSE)
  
  
}


```


