Simulation

There are a few relatively simple steps I took to begin simulating this data: library setup, scenario and question setup, model setup, and participant setup. Note that this is all done in Python, as there isn’t an equivalent R package to do this (yet).

from edsl import QuestionMultipleChoice, QuestionFreeText, QuestionLinearScale, \
    Survey, FileStore, Scenario, ScenarioList, AgentList, Agent, Model, ModelList
from itertools import product

scenarios = ScenarioList.from_source("pdf", "stimuli/intentional.pdf") + \
ScenarioList.from_source("pdf", "stimuli/unintentional.pdf")

stimuli = QuestionFreeText(
  question_name = "stimuli",
  question_text = "How do you feel about this story: {{ scenario.text }}"
)

nmj_1 = QuestionLinearScale(
  question_name = "nmj_1",
  question_text = "I believe Professor Gerber harmed his Black students",
  question_options = [1,2,3,4,5,6,7,],
  option_labels = {1:"Strongly disagree", 7:"Strongly agree"},
  include_comment = False
)

nmj_2 = QuestionLinearScale(
  question_name = "nmj_2",
  question_text = "I believe Professor Gerber intended to harm his Black students",
  question_options = [1,2,3,4,5,6,7,],
  option_labels = {1:"Strongly disagree", 7:"Strongly agree"},
  include_comment = False
)

nmj_3 = QuestionLinearScale(
  question_name = "nmj_3",
  question_text = "I blame Professor Gerber for harming his Black students",
  question_options = [1,2,3,4,5,6,7,],
  option_labels = {1:"Strongly disagree", 7:"Strongly agree"},
  include_comment = False
)

dv = QuestionLinearScale(
  question_name = "dv",
  question_text = "In response to this incident, the Kentucky Antiracist Students Alliance (KASA) is raising funds to support those harmed by the professor's speech. For each donation, KASA promises to send a letter calling for the professor's dismissal. Please rate your likelihood of donating to KASA below:",
  question_options = [1,2,3,4,5,6,7,],
  option_labels = {1:"Extremely unlikely", 7:"Extremely likely"},
  include_comment = False
)

models = ModelList([
  Model("gemini-1.5-flash-8b", service_name = "google", temperature = 1.0),
  Model("claude-3-haiku-20240307", service_name = "anthropic", temperature = 1.0),
  Model("mistral.mistral-7b-instruct-v0:2", service_name = "bedrock", temperature = 1.0),
])

ages = [20, 25, 30, 35, 40, 45]
genders = ["Male", "Female"]
nationalities = ["American", "Canadian"]
political_views = ["Conservative", "Liberal", "Moderate", "Progressive"]

agents = AgentList(
    Agent(traits={"age": age, "gender": gender, "nationality": nationality, "politics": politics})
    for age, gender, nationality, politics in product(ages, genders, nationalities, political_views)
)

survey = Survey(questions = [stimuli, nmj_1, nmj_2, nmj_3, dv])
survey = survey.set_full_memory_mode()

results = survey.by(scenarios).by(agents).by(models).run()

results.to_csv("results/blended/full.csv")

results.select("filename", "model", "age", "gender", "nationality", "politics", 
               "generated_tokens.nmj_1_generated_tokens", 
               "generated_tokens.nmj_2_generated_tokens", 
               "generated_tokens.nmj_3_generated_tokens", 
               "generated_tokens.dv_generated_tokens").to_csv("results/blended/reduced.csv")

Comparison

I generally prefer working with R, so I will load the data in and analyze it using R instead of Python. Here’s some quick code to load in the simulated data and report the results of a between-conditions t-test:

library(here)
library(tidyverse)

data <- read_csv(here("blog", "expected_parrot", "results", "google", "reduced.csv"))

data <- data |>
  mutate(across(.cols = matches("nmj|dv"),
                .fns = ~ as.numeric(str_extract(as.character(.x), "\\d")))) 

names(data) <- names(data) |>
  str_replace_all("generated_tokens\\.", "") %>%
  str_replace_all("_generated_tokens", "")

t.test(data[data$scenario.filename == "intentional.pdf",]$dv,
data[data$scenario.filename == "unintentional.pdf",]$dv)

    Welch Two Sample t-test

data:  data[data$scenario.filename == "intentional.pdf", ]$dv and data[data$scenario.filename == "unintentional.pdf", ]$dv
t = 5.5398, df = 361.49, p-value = 5.84e-08
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
 0.4255307 0.8939137
sample estimates:
mean of x mean of y 
 2.690972  2.031250 

These results look like very similar results to what was reported in the paper! The mean willingness to retributively donate in the intentional condition was almost exactly the same for the real (M = 2.67) and simulated data (M = 2.69); the mean willingness to retributively donate in the unintentional condition was very close for both the real (M = 1.83) and simulated data (M = 2.03) as well. The statistical tests were both significant as well (though these two studies differed in overall sample size):

• Real: t(1109.2) = 8.40, (p < .001)
• Simulated: t(361.49) = 5.54, (p < .001)

(Note that for the purpose of this analysis, I am only showing the output of Google’s gemini 1.5 flash modelm but the results I am sharing are consistent across the different models I tested.)

In short, it looks like for this sort of study, LLM-based simulations work very well! I can imagine a lot of use-cases for this. In particular, I think power analyses could be greatly helped by LLM-based simulation: right now, power analysis often requires the researcher to either guess what an effect might be or identify what a minimally interesting effect size might be in order to calculate the necessary sample for an experiment. If these models work well, I could see researchers using them to more easily simulate data prior to power analysis in order to get a better grounding for their likely effect sizes.

Conclusion

This was a small test of using LLMs to simulate experimental data. This is a growing area of research that a lot of behavioral scientists are paying attention to, and noting areas where LLM-simulated data converges and diverges from “real” studies will be important as our discipline considers how best to use this information in the design, execution, and replication of experimental studies. Hopefully this was useful to anybody interested in trying this method out for themselves!

Package mechanics

The Haikuify package contains a single function, reproduced below:

haikuify <- function (x) {
    x |>
        strsplit("(?<=[[:punct:]])\\s(?=[A-Z])", perl = T) |>
        unlist() |>
        data.frame() |>
        rename("Sentences" = 1) |>
        mutate(
            Sentences = gsub("[[:punct:]]", "", Sentences),
            Sentences = tolower(Sentences),
            Sentence_ID = row_number()
        ) |>
        tidytext::unnest_tokens(word, Sentences) |>
        mutate(
            syllables = nsyllable::nsyllable(word) |>
                as.numeric()
        ) |>
        group_by(Sentence_ID) |>
        mutate(sentence_syllables = sum(syllables)) |>
        filter(sentence_syllables == 17) |>
        mutate(syllable_count = cumsum(syllables)) |>
        filter(any(syllable_count == 5)) |>
        filter(any(syllable_count == 12)) |>
        filter(any(syllable_count == 17)) |>
        mutate(
            word = ifelse(syllable_count == 5, 
                          paste(word, "/", sep = " "),
                          word),
            word = ifelse(syllable_count == 12, 
                          paste(word, "/", sep = " "),
                          word)
        ) |>
        summarise(text = stringr::str_c(word, collapse = " ")) |>
        mutate(text = stringr::str_to_title(text)) |>
        dplyr::pull(text)
}

Let’s break this down piece by piece. First, we need to split a given text string into its component sentences. The following chunk takes a string (x) and splits it whenever it finds punctuation. These split strings are output as a list, which is then unlisted and turned into a dataframe. Then, the dataframe is given sensible column names (e.g. “sentences”), and the punctuation is stripped from the string. Finally, all words are turned into lowercase using the tolower() function.

x |>
    strsplit("(?<=[[:punct:]])\\s(?=[A-Z])", perl = T) |>
        unlist() |>
        data.frame() |>
        rename("Sentences" = ".") |>
        mutate(
            Sentences = gsub("[[:punct:]]", "", Sentences),
            Sentences = tolower(Sentences),
            Sentence_ID = row_number()
        )

Next, we need to figure out the number of syllables contained in each word, in each sentence. The following chunk “unnests” the words in each sentence, splitting by the spaces in the sentence and giving each word its own row in a new dataframe. Then, the quanteda function nsyllable() is applied to each individual word in its row to come up with a syllable value per word.

tidytext::unnest_tokens(word, Sentences) |>
    mutate(
        syllables = quanteda::nsyllable(word, 
                                        syllable_dictionary = quanteda::data_int_syllables) |>
            as.numeric()
    )

Now that syllables have been determined, we can identify if a sentence meets basic criteria for a haiku. The first check is whether a sentence has 17 total syllables (the sum of 5 + 7 + 5):

group_by(Sentence_ID) |>
        mutate(sentence_syllables = sum(syllables)) |>
        filter(sentence_syllables == 17)

But not every sentence that has 17 syllables is truly a haiku. Consider the following sentence:

“Antidisestablishmentarianism is a cool word eh?”

While this sentence does have 17 syllables, the word “antidisestablishmentarianism” cannot be split across multiple lines. The solution, then, is to cumulatively sum the syllables in a given sentence, and identify when a sentence reaches a syllable count of 5, 12 (5+7), and 17 (5+7+5) respectively:

mutate(syllable_count = cumsum(syllables)) |>
        filter(any(syllable_count == 5)) |>
        filter(any(syllable_count == 12)) |>
        filter(any(syllable_count == 17))

Now we need to identify the line breaks for a haiku. With our list of true haikus, we can easily append “/” to the end of the 5 and 12-syllable words to signify line breaks:

mutate(word = ifelse(syllable_count == 5, 
                     paste(word, "/", sep = " "), 
                     word),
            word = ifelse(syllable_count == 12, 
                          paste(word, "/", sep = " "), 
                          word)
        )

Finally, we can pull everything together and output a full haiku, complete with line breaks and all:

summarise(text = stringr::str_c(word, collapse = " ")) |>
        mutate(text = stringr::str_to_title(text)) |>
        dplyr::pull(text)

Implementation

Now to install the package and give it a live test:

devtools::install_github("SEthanMilne/Haikuify")
library(Haikuify)


text <- "I've been wondering for a while now how we might start this project. We need to make sure that the tools are all in place to get started soon. Sound good? Let's get going."

haikuify(text)

[1] "We Need To Make Sure / That The Tools Are All In Place / To Get Started Soon"

The use-case for Haikuify is clear: whimsical exploration of otherwise serious text data. As an example, I undertook a small project a couple years back using this package to find accidental haikus in 10-k reports from major tech firms. Here’s a haiku sourced from Microsoft’s 2018 report (with a background chart of their stock movement)

Required Packages

library(pdftools)
library(tidyverse)
library(ggthemes)
library(ggtext)
library(ggpubr)

Extract P Values

The code chunk below extracts the P values from papers in the following way:

• Get the names of all papers in a folder containing them
• Loop through each paper name and use the pdftools package to extract their raw text
• Do some basic cleaning (e.g. getting rid of “\n”, which denote paragraph breaks)
• Extract all strings of text that are preceded by "P >", "P <", "P =", and which end in a closed bracket ")"
• Output a data frame with 2 columns: P values and Paper Name

files <- list.files("PDFs")

Results <- data.frame(matrix(ncol = 2, nrow = 0))
names(Results) <- c("P_Value", "Paper")

for (i in 1:length(files)) {
  name <- files[i]
  
  text <-
    pdf_text(
        here::here("blog", "jcr_pvals", "PDFs", name)
    )
  text <- gsub("\n", "", text)
  text <- gsub("  ", "", text)
  
  values <-
    unlist(str_extract_all(text, 'p\\s?[=<>]\\s?\\.\\d{1,4}')) |>
    as.data.frame() |>
    mutate(Paper = name)
  
  if (is_empty(values)) {
    next
  } else{
    names(values) <- c("P_Value", "Paper")
    
    Results <- rbind(values, Results)
  }
}

Cleaning

Now that I have every P value, I need to extract the actual number. This is moderately challenging - P values are often reported without the leading 0 (e.g. p = .07), and a p value that is reported as greater than 0.05 is different from one that is equal to or less than, and those differences need to be recorded somewhere for any future work I may do.

In summary, what the below code does is:

• Extract the “raw numeric value” from each reported p value string
• Replace the prior “p [<=>]” with a “0” instead
• Convert this column to numeric

Cleaned_Results <- Results |>
  mutate(
    Raw_Value = P_Value,
    Raw_Value = gsub("p < ", "0", Raw_Value),
    Raw_Value = gsub("p = ", "0", Raw_Value),
    Raw_Value = gsub("p > ", "0", Raw_Value),
    Raw_Value = gsub("p >", "0", Raw_Value),
    Raw_Value = gsub("p =", "0", Raw_Value),
    Raw_Value = gsub("p <", "0", Raw_Value),
    Raw_Value = gsub("p< ", "0", Raw_Value),
    Raw_Value = gsub("p= ", "0", Raw_Value),
    Raw_Value = gsub("p> ", "0", Raw_Value),
    Raw_Value = gsub("p<", "0", Raw_Value),
    Raw_Value = gsub("p=", "0", Raw_Value),
    Raw_Value = gsub("p>", "0", Raw_Value)
  ) |>
  mutate(Operator = str_extract(P_Value, "[=<>]"))

Cleaned_Results$Raw_Value <- as.numeric(Cleaned_Results$Raw_Value)

Plotting

Finally, I wanted to plot the raw p values I’ve found. There’s little analytic code here - mostly just ggplot aesthetic wrangling. I used the {ggthemes} package for R to get the theme_fivethirtyeight function which gives me a lot of aesthetic power, for lack of a better term.

I’ve added X axis breaks at the standard p value thresholds - 0.1, 0.05, 0.01, 0.001. We should expect that there is significant clustering around these thresholds, as most researchers seem to report inequalities (p < x) rather than exact values.

Finally, p values aren’t exactly linear in their distribution, so everything is put on a log scale for easier interpretation.

ggplot(Cleaned_Results, aes(x = Raw_Value)) +
    geom_histogram(bins = 50, fill = "black") +
    scale_x_log10(
        breaks = c(0.0001, 0.001, 0.01, 0.05, 0.1, 1),
        labels = c(".0001", ".001", ".01", ".05", ".1", "1")
    ) +
    theme_pubclean() +
    theme(
        axis.title.x = element_text(),
        axis.title.y = element_text(),
        plot.title = element_markdown(),
        plot.background = element_rect(
            colour = "black",
            fill = NA,
            size = 2
        )
    ) +
    labs(
        title = "<span style = 'color: #ed713a;'>Distribution of P Values</span>",
        subtitle = "Appearing in JCR, 2019-2020 editions",
        x = "P Values",
        y = "Count"
    )