diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..dde3895
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+.DS_Store
+*.pyc
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..68c4a32
--- /dev/null
+++ b/README.md
@@ -0,0 +1,108 @@
+# Explanations Communicate Optimal Interventions
+
+
+This repository contains the experiment, data, analyses and figured for the CogSci 2024 paper "Do as I explain" Explanations communicate optimal interventions" by Lara Kirfel, Jacqueline Harding, Jeong Shin, Cindy Wu, Thomas Icard and Tobias Gerstenberg.
+
+## Abstract
+
+People often select only a few events when explaining what happened. What drives people's explanation selection? Prior research argued that people's explanation choices are affected by event normality and causal structure. Here, we propose a new model of these existing findings and test its predictions in a novel experiment. The model predicts that speakers value accuracy and relevance. They choose explanations that are true, and that communicate useful information to the listener. We test the model's predictions empirically by manipulating what goals a listener has and what actions they can take. Across twelve experimental conditions, we find that our model accurately predicts that people like to choose explanations that communicate optimal interventions.
+
+## Pre-registrations
+
+The pre-registrations for all experiments may be accessed via the Open Science Framework [here](https://osf.io/fpyst/).
+
+Here are separate links for each experiment:
+ - [Condition "Hard Intervention / Negative Outcome"](https://osf.io/8k9sy)
+ - [Condition "Hard Intervention / Positive Outcome"](https://osf.io/7qzu9)
+ - [Condition "Soft Intervention / Negative Outcome"](https://osf.io/aw286)
+ - [Condition "Soft Intervention / Positive Outcome"](https://osf.io/dmgcw)
+ - [Condition "Fixed Intervention / Negative Outcome"](https://osf.io/49bfq)
+ - [Condition "Fixed Intervention / Positive Outcome"](https://osf.io/rbu7y)
+
+## Repository structure
+
+```
+.
+├── code
+│ └── R
+├── data
+├── docs
+│ ├── analyses
+│ ├── experiment_1
+│ ├── experiment_2
+│ └── experiment_3
+├── figures
+│ └── plots
+└── writeup
+ └── cogsci
+```
+
+### code
+
+This folder contains two types of R scripts.
+
+- The model predictions can be seen [here](https://cicl-stanford.github.io/explanation_intervention/analyses/model/index.html)
+- The analyses and plots can be seen [here](https://cicl-stanford.github.io/explanation_intervention/analyses/experiments/index.html)
+
+- R/optimal_intervention_model
:
+ - R/optimal_intervention.rmd
creates the model predictions for the intervention model, the truth model and a combined model.
+ - explanation_predictions_truth_only.csv
, for example, contains the predictions for a "Truth Only" model.
+- R/experiments
: This folder contains all raw data from all experimental conditions.
+ - [...]study_X-responses.csv
contains the response data (i.e., intervention and explanation selection).
+ - [...]study_X-participants.csv
contains demographic information and post-experiment feedback/comments from participants.
+ - Experiment.rmd
reads in the response data from each experimental condition (e.g., fixed intervention / negative), calculates average responses and outputs these in a new data file (e.g., fixedint_negative.csv
).
+
+### docs
+
+Contains all the experiment code. You can preview the experiments below:
+
+- [Condition "Hard Intervention / Positive Outcome"](https://cicl-stanford.github.io/explanation_intervention/experiment_1/index.html?condition=1)
+
+- [Condition "Hard Intervention / Negative Outcome"](https://cicl-stanford.github.io/explanation_intervention/experiment_1/index.html?condition=3)
+
+- [Condition "Soft Intervention / Positive Outcome"](https://cicl-stanford.github.io/explanation_intervention/experiment_2/index.html?condition=1)
+
+- [Condition "Soft Intervention / Negative Outcome"](https://cicl-stanford.github.io/explanation_intervention/experiment_2/index.html?condition=3)
+
+- [Condition "Fixed Intervention / Positive Outcome"](https://cicl-stanford.github.io/explanation_intervention/experiment_3/index.html?condition=1)
+
+- [Condition "Fixed Intervention / Negative Outcome"](https://cicl-stanford.github.io/explanation_intervention/experiment_3/index.html?condition=3)
+
+
+### data
+
+Contains anonymized combined data for all experimental conditions (hard / soft / fixed intervention x positive / negative outcome) (for raw data and how these were computed, see code/R/
).
+
+For example, fixedint_negative.csv
contains the average percentage of choice selection (abnormal switch, normal switch, no preference) in the intervention and explanation task.
+
+data_int.csv
combines all four dataframes (hardint_pos, hardint_neg, softint_pos, softint_neg, fixedint_pos, fixedint_neg)
+
+
+### figures
+
+Contains all the figures from the paper (generated using the script in code/R/experiments
).
+
+### writeup
+
+Contains a pdf of the CogSci 2024 paper.
+
+## CRediT
+
+Please see [here](https://www.elsevier.com/researcher/author/policies-and-guidelines/credit-author-statement) for definitions of the different terms.
+
+| | Lara | Jacqueline | Jeong | Cindy | Thomas | Tobias |
+|----------------------------|------|------------|-------|-------|--------|--------|
+| Conceptualization | X | | | | X | X |
+| Methodology | X | X | X | | | X |
+| Software | X | X | X | X | | X |
+| Validation | X | | | | | X |
+| Formal analysis | X | X | | | | X |
+| Investigation | X | | X | | | |
+| Resources | | | | | | |
+| Data Curation | X | | | | | X |
+| Writing - Original Draft | X | X | | | | |
+| Writing - Review & Editing | X | X | X | X | X | X |
+| Visualization | | | | | | X |
+| Supervision | | | | | X | X |
+| Project administration | | | | | | X |
+| Funding acquisition | | | | | | X |
\ No newline at end of file
diff --git a/code/R/experiments-readme.md b/code/R/experiments-readme.md
new file mode 100644
index 0000000..fa77071
--- /dev/null
+++ b/code/R/experiments-readme.md
@@ -0,0 +1,51 @@
+# Experiments readme
+
+Information about each of the experiment that is run as part of this project.
+
+Experiment 1: Missing --- was it turned into Experiment 1b?
+
+Experiment 1b: "Hard Interventions"
+"The Influence of Outcome Valence on Explanation Selection in Positive / Negative Outcome Cases"
+People select a hard intervention that turns the switch ON or OFF in Conjunctive and Disjunctive Structures with positive and negative outcomes.
+Condition 1: Con/Pos , Dis/Pos
+Condition 2: Dis/Pos , Con/Pos
+Condition 3: Con/Neg , Dis/Neg
+Condition 4: Dis/Neg , Con/Neg
+
+Positive Condition pre-reg: https://osf.io/7qzu9
+Negative Condition pre-reg: https://osf.io/8k9sy
+
+Experiment 2: "Probability Estimation"
+"Estimating outcome probability in causal structures with positive and negative outcomes"
+One Condition
+Pre-reg: https://osf.io/dmgcw
+
+Experiment 3: "Soft interventions"
+"The Influence of Normality on Explanation Selection in Soft Intervention Cases for Positive and Negative Outcomes"
+People select a soft intervention of increasing or decreasing the probablity by 20%.
+Condition 1: Con/Pos , Dis/Pos
+Condition 2: Dis/Pos , Con/Pos
+Condition 3: Con/Neg , Dis/Neg
+Condition 4: Dis/Neg , Con/Neg
+
+
+Positive Condition pre-reg: https://osf.io/dmgcw
+Negative Condition pre-reg: https://osf.io/aw286
+
+Experiment 4: Fixed Interventions
+"The Influence of Normality on Explanation Selection in Fixed Intervention Cases for Positive and Negative Outcomes"
+People select a fixed intervention of increasing or decreasing the probablity to 90%/10%, irrespective of the probability
+
+Condition 1: Con/Pos , Dis/Pos
+Condition 2: Dis/Pos , Con/Pos
+Condition 3: Con/Neg , Dis/Neg
+Condition 4: Dis/Neg , Con/Neg
+
+Experiment 5: Cost of Interventions, with Intervention Task
+"The Influence of Cost of Interventions on Explanation Selection"
+People select an intervention that is either cheap or expensive. Includes Intervention Task
+
+Condition 1: Con/Pos
+Condition 2: Dis/Pos
+
+
diff --git a/code/R/experiments/Experiment.Rmd b/code/R/experiments/Experiment.Rmd
new file mode 100644
index 0000000..cda070b
--- /dev/null
+++ b/code/R/experiments/Experiment.Rmd
@@ -0,0 +1,1083 @@
+---
+title: "Explanation and Intervention Data"
+author: "Tobias Gerstenberg & Lara Kirfel"
+date: "`r format(Sys.Date(), '%B %d, %Y')`"
+bibliography: grateful-refs.bib
+output:
+ bookdown::html_document2:
+ toc: true
+ toc_depth: 4
+ toc_float: true
+ theme: cosmo
+ highlight: tango
+---
+
+```{r, message=FALSE}
+library("knitr")
+library("modelr") # for bootstrapping
+library("patchwork") # making figure panels
+library("tidyverse") # for data wrangling, visualization, etc.
+```
+
+# Set options
+
+```{r}
+theme_set(theme_classic() +
+ theme(text = element_text(size = 24)))
+
+opts_chunk$set(comment = "",
+ fig.show = "hold")
+
+# suppress grouping warning
+options(dplyr.summarise.inform = F)
+```
+
+# Condition 1: Hard Intervention: Positive Outcome
+## Read in Data
+```{r}
+
+#### Read in Data
+df.responses = read.csv(file = "explanation_selection_positive_outcome_study_2-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-error)
+
+
+df.participants <- read.csv(file = "explanation_selection_positive_outcome_study_2-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-c(proliferate.condition, error))
+
+
+df.data1 <- merge(df.responses, df.participants, by="workerid")
+```
+
+## Wrangle Data
+
+```{r}
+df.exp1 <- df.data1 %>%
+ gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Conpos_") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Conpos_") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Dispos_") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Dispos_") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Conpos_") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Dispos_") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ explanation == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ mutate(normal_explanation =
+ case_when(
+ explanation == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ mutate(nopreference_explanation =
+ case_when(
+ explanation == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ mutate(abnormal_intervention =
+ case_when(
+ intervention== "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ mutate(normal_intervention =
+ case_when(
+ intervention == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ mutate(nopreference_intervention =
+ case_when(
+ intervention== "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ mutate(intervention = "hard") %>%
+ mutate(outcome = "positive")
+
+
+
+
+```
+
+## Prepate Dataset
+
+```{r}
+df.exp1_summary <- df.exp1 %>%
+ group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ ) %>%
+ mutate(Outcome = "positive") %>%
+ mutate(Experiment = "hardint")
+
+write_csv(df.exp1_summary, "hardint_pos.csv")
+
+```
+
+# Condition 2: Hard Intervention: Negative Outcome
+
+## Read in Data
+
+```{r}
+
+#### Read in Data
+df.responses = read.csv(file = "explanation_selection_negative_outcome-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-error)
+
+
+df.participants <- read.csv(file = "explanation_selection_negative_outcome-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-c(proliferate.condition, error))
+
+
+df.data2 <- merge(df.responses, df.participants, by="workerid")
+```
+
+## Wrangle Data
+
+```{r}
+df.exp2 <- df.data2 %>%
+ gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Conneg_") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Conneg_") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Disneg_") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Disneg_") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Conneg_") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Disneg_") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ explanation == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ mutate(normal_explanation =
+ case_when(
+ explanation == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ mutate(nopreference_explanation =
+ case_when(
+ explanation == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ mutate(abnormal_intervention =
+ case_when(
+ intervention== "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ mutate(normal_intervention =
+ case_when(
+ intervention == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ mutate(nopreference_intervention =
+ case_when(
+ intervention== "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ mutate(intervention = "hard") %>%
+ mutate(outcome = "negative")
+
+```
+
+## Prepare Dataset
+
+```{r}
+df.exp2_summary <- df.exp2 %>%
+ group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ ) %>%
+ mutate(Outcome = "negative") %>%
+ mutate(Experiment = "hardint")
+
+write_csv(df.exp2_summary, "hardint_neg.csv")
+
+```
+
+# Condition 3: Soft Intervention: Positive Outcome
+
+## Read in Data
+
+```{r}
+###Experiment 4
+#### Read in Data
+
+df.responses = read.csv(file = "pressbutton_positivecondition-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-error)
+
+
+df.participants <- read.csv(file = "pressbutton_positivecondition-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-c(proliferate.condition, error))
+
+
+df.data3 <- merge(df.responses, df.participants, by="workerid")
+```
+
+## Wrangle Data
+
+```{r}
+df.exp3 <- df.data3 %>%
+ gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_1") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_1") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_2") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_2") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_1") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_2") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ explanation == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ mutate(normal_explanation =
+ case_when(
+ explanation == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ mutate(nopreference_explanation =
+ case_when(
+ explanation == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ mutate(abnormal_intervention =
+ case_when(
+ intervention== "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ mutate(normal_intervention =
+ case_when(
+ intervention == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ mutate(nopreference_intervention =
+ case_when(
+ intervention== "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other"))%>%
+ mutate(intervention = "soft") %>%
+ mutate(outcome = "positive")
+
+
+```
+
+## Prepare Dataset
+
+```{r}
+df.exp3_summary <- df.exp3 %>%
+ group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ ) %>%
+ mutate(Outcome = "positive") %>%
+ mutate(Experiment = "softint")
+
+write_csv(df.exp3_summary, "softint_pos.csv")
+
+```
+
+# Condition 4: Soft Intervention: Negative Outcome
+## Read in Data
+
+```{r}
+###Experiment 4
+#### Read in Data
+
+df.responses = read.csv(file = "pressbutton_negativecondition-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-error)
+
+
+df.participants <- read.csv(file = "pressbutton_negativecondition-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-c(proliferate.condition, error))
+
+
+df.data4 <- merge(df.responses, df.participants, by="workerid") %>%
+ filter(!row_number() %in% c(71, 72))
+```
+
+## Wrangle Data
+
+```{r}
+df.exp4 <- df.data4 %>%
+ gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_4") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ explanation == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ mutate(normal_explanation =
+ case_when(
+ explanation == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ mutate(nopreference_explanation =
+ case_when(
+ explanation == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ mutate(abnormal_intervention =
+ case_when(
+ intervention== "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ mutate(normal_intervention =
+ case_when(
+ intervention == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ mutate(nopreference_intervention =
+ case_when(
+ intervention== "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ mutate(intervention = "soft") %>%
+ mutate(outcome = "negative")
+
+
+```
+
+## Prepare Dataset
+
+```{r}
+df.exp4_summary <- df.exp4 %>%
+ group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ ) %>%
+ mutate(Outcome = "negative") %>%
+ mutate(Experiment = "softint")
+
+write_csv(df.exp4_summary, "softint_neg.csv")
+
+```
+
+# Condition 5: Fixed Intervention: Positive Outcome
+## Read in Data
+
+```{r}
+###Experiment 5
+#### Read in Data
+
+df.responses = read.csv(file = "fixedintervention_positive-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-error)
+
+
+df.participants <- read.csv(file = "fixedintervention_positive-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-c(proliferate.condition, error))
+
+
+df.data5 <- merge(df.responses, df.participants, by="workerid")
+```
+
+## Wrangle Data
+
+```{r}
+df.exp5 <- df.data5 %>%
+ gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition1") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition1") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition2") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition2") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition1") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition2") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ explanation == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ mutate(normal_explanation =
+ case_when(
+ explanation == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ mutate(nopreference_explanation =
+ case_when(
+ explanation == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ mutate(abnormal_intervention =
+ case_when(
+ intervention== "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ mutate(normal_intervention =
+ case_when(
+ intervention == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ mutate(nopreference_intervention =
+ case_when(
+ intervention== "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ mutate(intervention = "fixed") %>%
+ mutate(outcome = "positive")
+
+```
+
+## Prepare Dataset
+
+```{r}
+df.exp5_summary <- df.exp5 %>%
+ group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ ) %>%
+ mutate(Outcome = "negative") %>%
+ mutate(Experiment = "fixedint")
+
+write_csv(df.exp5_summary, "fixedint_pos.csv")
+
+```
+
+# Condition 6: Fixed Intervention: Negative Outcome
+
+
+## Read in Data
+
+```{r}
+###Experiment 6
+#### Read in Data
+
+df.responses = read.csv(file = "fixedintervention_negative-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-error)
+
+
+df.participants <- read.csv(file = "fixedintervention_negative-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ select(-c(proliferate.condition, error))
+
+
+df.data6 <- merge(df.responses, df.participants, by="workerid")
+```
+
+## Wrangle Data
+
+```{r}
+df.exp6 <- df.data6 %>%
+ gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_4") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ explanation == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ mutate(normal_explanation =
+ case_when(
+ explanation == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ mutate(nopreference_explanation =
+ case_when(
+ explanation == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ mutate(abnormal_intervention =
+ case_when(
+ intervention== "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ mutate(normal_intervention =
+ case_when(
+ intervention == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ mutate(nopreference_intervention =
+ case_when(
+ intervention== "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ mutate(intervention = "fixed") %>%
+ mutate(outcome = "negative")
+
+
+```
+
+## Prepare Dataset
+
+```{r}
+df.exp6_summary <- df.exp6 %>%
+ group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ ) %>%
+ mutate(Outcome = "negative") %>%
+ mutate(Experiment = "fixedint")
+
+write_csv(df.exp6_summary, "fixedint_neg.csv")
+
+```
+
+# Create Dataset including raw data from all conditions
+
+```{r}
+df.exp_all <- rbind(df.exp1, df.exp2, df.exp3, df.exp4, df.exp5, df.exp6)
+
+```
+
+# Bootstrapping
+
+## DATA
+
+### Data frame
+
+```{r}
+df.boot = df.exp_all %>%
+ select(workerid,
+ structure = CausalStructure,
+ outcome,
+ action = intervention,
+ explanation,
+ abnormal_intervention,
+ normal_intervention,
+ nopreference_intervention) %>%
+ mutate(structure = tolower(structure),
+ intervention = abnormal_intervention,
+ intervention = ifelse(normal_intervention != "other", normal_intervention, intervention),
+ intervention = ifelse(nopreference_intervention != "other", nopreference_intervention, intervention),
+ intervention = factor(intervention,
+ levels = c("abnormal", "no preference", "normal")),
+ explanation = factor(explanation,
+ levels = c("abnormal", "no preference", "normal"))) %>%
+ select(-contains("_"))
+
+```
+
+### Percentages
+
+```{r}
+df.percentage = df.boot %>%
+ count(structure, outcome, action, choice = intervention,
+ name = "intervention_n") %>%
+ left_join(df.boot %>%
+ count(structure, outcome, action, choice = explanation,
+ name = "explanation_n"),
+ by = c("structure", "outcome", "action", "choice")) %>%
+ group_by(structure, outcome, action) %>%
+ mutate(intervention_p = intervention_n/sum(intervention_n),
+ explanation_p = explanation_n/sum(explanation_n)) %>%
+ ungroup()
+```
+
+### Bootstrapped confidence intervals
+
+```{r}
+set.seed(1)
+
+# percentages with bootstrapped confidence intervals
+df.confidence = df.boot %>%
+ group_by(structure, outcome, action) %>%
+ nest() %>%
+ mutate(bootstraps = map(.x = data,
+ .f = ~ bootstrap(.x, n = 1000))) %>%
+ unnest(bootstraps) %>%
+ mutate(intervention = map(.x = strap,
+ .f = ~ .x %>%
+ as_tibble() %>%
+ count(intervention,
+ name = "intervention_n",
+ .drop = F) %>%
+ mutate(intervention_p = intervention_n/sum(intervention_n))),
+ explanation = map(.x = strap,
+ .f = ~ .x %>%
+ as_tibble() %>%
+ count(explanation,
+ name = "explanation_n",
+ .drop = F) %>%
+ mutate(explanation_p = explanation_n/sum(explanation_n)))) %>%
+ select(structure, outcome, action, intervention, explanation) %>%
+ unnest(c(intervention, explanation)) %>%
+ select(everything(), choice = intervention, -explanation) %>%
+ group_by(structure, outcome, action, choice) %>%
+ summarize(intervention_low = as.numeric(quantile(intervention_p, probs = 0.025)),
+ intervention_high = as.numeric(quantile(intervention_p, probs = 0.975)),
+ explanation_low = as.numeric(quantile(explanation_p, probs = 0.025)),
+ explanation_high = as.numeric(quantile(explanation_p, probs = 0.975))) %>%
+ ungroup()
+```
+
+### Combined data frame
+
+```{r}
+df.combined = df.confidence %>%
+ left_join(df.percentage %>%
+ select(-(contains("_n"))),
+ by = c("structure", "outcome", "action", "choice")) %>%
+ select(structure, outcome, action, choice, contains("intervention"),
+ contains("explanation"))
+```
+
+## PLOTS
+
+### Read in model predictions
+
+```{r, message=FALSE, warning=FALSE}
+df.prediction_intervention = read_csv("intervention_predictions.csv")
+df.prediction_explanation = read_csv("explanation_predictions.csv") %>%
+ select(-truth)
+
+df.optimal_intervention_model = df.prediction_intervention %>%
+ mutate(index = "intervention_prediction") %>%
+ bind_rows(df.prediction_explanation %>%
+ mutate(index = "explanation_prediction")) %>%
+ select(structure = causal_structure,
+ outcome,
+ action = intervention,
+ choice,
+ index,
+ prediction) %>%
+ pivot_wider(names_from = index,
+ values_from = prediction)
+
+df.intervention_only_model = read_csv("explanation_predictions_intervention_only.csv")
+df.truth_only_model = read_csv("explanation_predictions_truth_only.csv")
+
+df.alternative_models = df.intervention_only_model %>%
+ mutate(model = "intervention_only") %>%
+ bind_rows(df.truth_only_model %>%
+ mutate(model = "truth_only")) %>%
+ select(structure = causal_structure,
+ outcome,
+ action = intervention,
+ choice,
+ model,
+ prediction) %>%
+ pivot_wider(names_from = model,
+ values_from = prediction)
+
+df.models = df.optimal_intervention_model %>%
+ left_join(df.alternative_models)
+```
+
+### Bar plot
+
+```{r, fig.width=20, fig.height=14, warning=FALSE, message=FALSE}
+
+df.plot = df.combined %>%
+ mutate(choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+df.model = df.optimal_intervention_model %>%
+ left_join(df.alternative_models) %>%
+ mutate(choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+df.model2 = df.model %>%
+ select(-intervention_prediction) %>%
+ pivot_longer(cols = c("explanation_prediction", "intervention_only", "truth_only"),
+ names_to = "model",
+ values_to = "prediction") %>%
+ mutate(model = factor(model,
+ levels = c("truth_only", "explanation_prediction", "intervention_only"))) %>%
+ arrange(structure, outcome, action, choice, model)
+
+p_intervention = ggplot(data = df.plot,
+ mapping = aes(x = action,
+ y = intervention_p,
+ group = choice,
+ fill = action,
+ alpha = choice)) +
+ geom_col(color = "black",
+ position = position_dodge(width = 0.9)) +
+ geom_linerange(mapping = aes(ymin = intervention_low,
+ ymax = intervention_high),
+ position = position_dodge(width = 0.9),
+ alpha = 1,
+ linewidth = 1) +
+ geom_point(data = df.model,
+ mapping = aes(y = intervention_prediction),
+ position = position_dodge(width = 0.9),
+ shape = 21,
+ size = 4,
+ show.legend = F) +
+ facet_grid(structure ~ outcome) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_alpha_manual(values = c(0.4, 0.65, 0.9)) +
+ labs(title = "Intervention Task",
+ x = "type of intervention",
+ y = "percent selected") +
+ theme(legend.position = "bottom",
+ plot.title = element_text(hjust = 0.5)) +
+ guides(fill = "none",
+ alpha = "none")
+
+p_explanation = ggplot(data = df.plot,
+ mapping = aes(x = action,
+ y = explanation_p,
+ group = choice,
+ fill = action,
+ alpha = choice)) +
+ geom_col(color = "black",
+ position = position_dodge(width = 0.9)) +
+ geom_linerange(mapping = aes(ymin = explanation_low,
+ ymax = explanation_high),
+ position = position_dodge(width = 0.9),
+ alpha = 1,
+ linewidth = 1) +
+ geom_point(data = df.model2,
+ mapping = aes(y = prediction,
+ shape = model),
+ position = position_dodge2(width = 0.9,
+ padding = 0.2),
+ size = 4,
+ show.legend = F) +
+ facet_grid(structure ~ outcome) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_alpha_manual(values = c(0.4, 0.65, 0.9)) +
+ scale_shape_manual(values = c("truth_only" = 22,
+ "explanation_prediction" = 21,
+ "intervention_only" = 23)) +
+ labs(title = "Explanation Task",
+ x = "type of intervention",
+ y = "percent selected") +
+ theme(legend.position = "bottom",
+ plot.title = element_text(hjust = 0.5)) +
+ guides(fill = "none")
+
+p_intervention + p_explanation +
+ plot_layout(ncol = 1) + plot_annotation(tag_levels = "A") &
+ theme(plot.tag = element_text(size = 40, face = "bold"))
+
+ggsave(filename = "../../../figures/plots/bars.pdf",
+ width = 20,
+ height = 14)
+```
+
+### Scatter plots
+
+#### Scatter plot function
+
+```{r}
+fun.scatter = function(data, xtitle, ytitle, legend = F){
+ p = ggplot(data = data,
+ mapping = aes(x = model,
+ y = p,
+ ymin = low,
+ ymax = high)) +
+ geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
+ annotate(geom = "text",
+ x = 0,
+ y = 1,
+ hjust = 0,
+ label = str_c("r = ", round(cor(data$model, data$p), 2)),
+ size = 8) +
+ annotate(geom = "text",
+ x = 0,
+ y = 0.92,
+ hjust = 0,
+ label = str_c("RMSE = ", round(sqrt(mean((data$model - data$p)^2)), 2)),
+ size = 8) +
+ geom_smooth(method = "lm",
+ color = "black",
+ alpha = 0.2,
+ show.legend = F) +
+ geom_linerange(alpha = 0.2) +
+ geom_point(mapping = aes(fill = action),
+ alpha = 0.9,
+ shape = 21,
+ size = 4) +
+ scale_x_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ labs(x = xtitle,
+ y = ytitle) +
+ theme(legend.position = c(1, 0),
+ legend.justification = c(1.2, -0.1))
+
+ if(legend == F){
+ p = p + theme(legend.position = "none")
+ }
+
+ return(p)
+}
+```
+
+#### Combined scatter plots
+
+```{r, warning=FALSE, message=FALSE, fig.width=16, fig.height=12}
+df.plot = df.combined %>%
+ left_join(df.models %>%
+ mutate(choice = factor(choice,
+ levels = c("abnormal", "nopreference", "normal"),
+ labels = c("abnormal", "no preference", "normal")))) %>%
+ mutate(structure = factor(structure,
+ levels = c("conjunctive", "disjunctive")),
+ choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+df.plot.intervention = df.plot %>%
+ select(structure, outcome, action, choice,
+ low = intervention_low, high = intervention_high,
+ p = intervention_p, model = intervention_prediction)
+
+df.plot.explanation = df.plot %>%
+ select(structure, outcome, action, choice,
+ low = explanation_low, high = explanation_high,
+ p = explanation_p,
+ explanation_prediction,
+ intervention_only,
+ truth_only)
+
+scatter1 = fun.scatter(data = df.plot.intervention,
+ xtitle = "model prediction",
+ ytitle = "intervention choices",
+ legend = T)
+
+scatter2 = fun.scatter(data = df.plot.explanation %>%
+ mutate(model = intervention_only),
+ xtitle = "relevance only model",
+ ytitle = "explanation choices")
+
+scatter3 = fun.scatter(data = df.plot.explanation %>%
+ mutate(model = truth_only),
+ xtitle = "accuracy only model",
+ ytitle = "explanation choices")
+
+scatter4 = fun.scatter(data = df.plot.explanation %>%
+ mutate(model = explanation_prediction),
+ xtitle = "combined model",
+ ytitle = "explanation choices")
+
+scatter1 + scatter2 + scatter3 + scatter4 +
+ plot_layout(ncol = 2) +
+ plot_annotation(tag_levels = "A") &
+ theme(text = element_text(size = 30),
+ plot.tag = element_text(size = 40, face = "bold"),
+ plot.margin = margin(t = 0,
+ r = 0.35,
+ b = 0,
+ l = 0,
+ "cm"))
+
+ggsave(filename = "../../../figures/plots/scatter.pdf",
+ width = 16,
+ height = 12)
+```
+
+#### Overall
+
+```{r, warning=FALSE, message=FALSE, fig.width=8, fig.height=6}
+df.scatter = df.plot %>%
+ ungroup() %>%
+ pivot_longer(cols = contains("_"),
+ names_to = c("task", "index"),
+ names_sep = "_",
+ values_to = "value") %>%
+ pivot_wider(names_from = index,
+ values_from = value) %>%
+ left_join(df.model %>%
+ pivot_longer(cols = contains("_"),
+ names_to = c("task", "index"),
+ names_sep = "_",
+ values_to = "model") %>%
+ select(-index),
+ by = c("structure", "outcome", "action", "choice", "task"))
+
+
+ggplot(data = df.scatter,
+ mapping = aes(x = model,
+ y = p,
+ ymin = low,
+ ymax = high)) +
+ geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
+ annotate(geom = "text",
+ x = 0,
+ y = 1,
+ hjust = 0,
+ label = str_c("r = ", round(cor(df.scatter$model, df.scatter$p), 2)),
+ size = 8) +
+ annotate(geom = "text",
+ x = 0,
+ y = 0.92,
+ hjust = 0,
+ label = str_c("RMSE = ", round(sqrt(mean((df.scatter$model - df.scatter$p)^2)), 2)),
+ size = 8) +
+ geom_smooth(method = "lm",
+ color = "black",
+ alpha = 0.2,
+ show.legend = F) +
+ geom_linerange(alpha = 0.2) +
+ geom_point(mapping = aes(fill = action),
+ # shape = task),
+ shape = 21,
+ size = 2) +
+ scale_x_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ # scale_shape_manual(values = c("intervention" = 21,
+ # "explanation" = 22)) +
+ labs(x = "model prediction",
+ y = "participant choices") +
+ theme(legend.position = c(1, 0),
+ legend.justification = c(1.2, -0.1))
+
+ggsave(filename = "../../../figures/plots/scatter.pdf",
+ width = 8,
+ height = 6)
+```
+
+## STATS
+
+### Correlations and RMSE
+
+```{r, warning=FALSE, message=FALSE}
+df.combined %>%
+ ungroup() %>%
+ select(-(contains("low") | contains("high"))) %>%
+ mutate(choice = str_replace(choice, "no preference", "nopreference")) %>%
+ left_join(df.alternative_models) %>%
+ left_join(df.optimal_intervention_model %>%
+ select(-intervention_prediction)) %>%
+ summarize(across(c(explanation_prediction, intervention_only, truth_only),
+ list(r = ~ cor(.x, explanation_p),
+ rmse = ~ sqrt(mean((.x - explanation_p)^2))),
+ .names = "{.col}.{.fn}")) %>%
+ pivot_longer(cols = everything(),
+ names_to = c("model", "stat"),
+ names_sep = "\\.",
+ values_to = "value") %>%
+ pivot_wider(names_from = stat,
+ values_from = value) %>%
+ mutate(across(where(is.numeric),
+ ~ round(., 2)))
+```
+
+
+# Session info
+
+```{r, echo=F}
+sessionInfo()
+```
\ No newline at end of file
diff --git a/code/R/experiments/Experiment.html b/code/R/experiments/Experiment.html
new file mode 100644
index 0000000..9963616
--- /dev/null
+++ b/code/R/experiments/Experiment.html
@@ -0,0 +1,2706 @@
+
+
+
+
+
library("knitr")
+library("modelr") # for bootstrapping
+library("patchwork") # making figure panels
+library("tidyverse") # for data wrangling, visualization, etc.
theme_set(theme_classic() +
+theme(text = element_text(size = 24)))
+
+$set(comment = "",
+ opts_chunkfig.show = "hold")
+
+# suppress grouping warning
+options(dplyr.summarise.inform = F)
#### Read in Data
+= read.csv(file = "explanation_selection_positive_outcome_study_2-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "explanation_selection_positive_outcome_study_2-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data1
<- df.data1 %>%
+ df.exp1 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Conpos_") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Conpos_") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Dispos_") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Dispos_") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Conpos_") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Dispos_") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "hard") %>%
+ mutate(outcome = "positive")
<- df.exp1 %>%
+ df.exp1_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "positive") %>%
+ mutate(Experiment = "hardint")
+
+write_csv(df.exp1_summary, "hardint_pos.csv")
#### Read in Data
+= read.csv(file = "explanation_selection_negative_outcome-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "explanation_selection_negative_outcome-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data2
<- df.data2 %>%
+ df.exp2 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Conneg_") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Conneg_") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Disneg_") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Disneg_") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Conneg_") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Disneg_") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "hard") %>%
+ mutate(outcome = "negative")
<- df.exp2 %>%
+ df.exp2_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "negative") %>%
+ mutate(Experiment = "hardint")
+
+write_csv(df.exp2_summary, "hardint_neg.csv")
###Experiment 4
+#### Read in Data
+
+= read.csv(file = "pressbutton_positivecondition-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "pressbutton_positivecondition-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data3
<- df.data3 %>%
+ df.exp3 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_1") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_1") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_2") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_2") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_1") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_2") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other"))%>%
+ interventionmutate(intervention = "soft") %>%
+ mutate(outcome = "positive")
<- df.exp3 %>%
+ df.exp3_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "positive") %>%
+ mutate(Experiment = "softint")
+
+write_csv(df.exp3_summary, "softint_pos.csv")
###Experiment 4
+#### Read in Data
+
+= read.csv(file = "pressbutton_negativecondition-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "pressbutton_negativecondition-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") %>%
+ df.data4 filter(!row_number() %in% c(71, 72))
<- df.data4 %>%
+ df.exp4 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_4") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "soft") %>%
+ mutate(outcome = "negative")
<- df.exp4 %>%
+ df.exp4_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "negative") %>%
+ mutate(Experiment = "softint")
+
+write_csv(df.exp4_summary, "softint_neg.csv")
###Experiment 5
+#### Read in Data
+
+= read.csv(file = "fixedintervention_positive-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "fixedintervention_positive-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data5
<- df.data5 %>%
+ df.exp5 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition1") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition1") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition2") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition2") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition1") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition2") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "fixed") %>%
+ mutate(outcome = "positive")
<- df.exp5 %>%
+ df.exp5_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "negative") %>%
+ mutate(Experiment = "fixedint")
+
+write_csv(df.exp5_summary, "fixedint_pos.csv")
###Experiment 6
+#### Read in Data
+
+= read.csv(file = "fixedintervention_negative-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "fixedintervention_negative-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data6
<- df.data6 %>%
+ df.exp6 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_4") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "fixed") %>%
+ mutate(outcome = "negative")
<- df.exp6 %>%
+ df.exp6_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "negative") %>%
+ mutate(Experiment = "fixedint")
+
+write_csv(df.exp6_summary, "fixedint_neg.csv")
<- rbind(df.exp1, df.exp2, df.exp3, df.exp4, df.exp5, df.exp6) df.exp_all
= df.exp_all %>%
+ df.boot select(workerid,
+ structure = CausalStructure,
+
+ outcome,action = intervention,
+
+ explanation,
+ abnormal_intervention,
+ normal_intervention,%>%
+ nopreference_intervention) mutate(structure = tolower(structure),
+ intervention = abnormal_intervention,
+ intervention = ifelse(normal_intervention != "other", normal_intervention, intervention),
+ intervention = ifelse(nopreference_intervention != "other", nopreference_intervention, intervention),
+ intervention = factor(intervention,
+ levels = c("abnormal", "no preference", "normal")),
+ explanation = factor(explanation,
+ levels = c("abnormal", "no preference", "normal"))) %>%
+ select(-contains("_"))
= df.boot %>%
+ df.percentage count(structure, outcome, action, choice = intervention,
+ name = "intervention_n") %>%
+ left_join(df.boot %>%
+ count(structure, outcome, action, choice = explanation,
+ name = "explanation_n"),
+ by = c("structure", "outcome", "action", "choice")) %>%
+ group_by(structure, outcome, action) %>%
+ mutate(intervention_p = intervention_n/sum(intervention_n),
+ explanation_p = explanation_n/sum(explanation_n)) %>%
+ ungroup()
set.seed(1)
+
+# percentages with bootstrapped confidence intervals
+= df.boot %>%
+ df.confidence group_by(structure, outcome, action) %>%
+ nest() %>%
+ mutate(bootstraps = map(.x = data,
+ .f = ~ bootstrap(.x, n = 1000))) %>%
+ unnest(bootstraps) %>%
+ mutate(intervention = map(.x = strap,
+ .f = ~ .x %>%
+ as_tibble() %>%
+ count(intervention,
+ name = "intervention_n",
+ .drop = F) %>%
+ mutate(intervention_p = intervention_n/sum(intervention_n))),
+ explanation = map(.x = strap,
+ .f = ~ .x %>%
+ as_tibble() %>%
+ count(explanation,
+ name = "explanation_n",
+ .drop = F) %>%
+ mutate(explanation_p = explanation_n/sum(explanation_n)))) %>%
+ select(structure, outcome, action, intervention, explanation) %>%
+ unnest(c(intervention, explanation)) %>%
+ select(everything(), choice = intervention, -explanation) %>%
+ group_by(structure, outcome, action, choice) %>%
+ summarize(intervention_low = as.numeric(quantile(intervention_p, probs = 0.025)),
+ intervention_high = as.numeric(quantile(intervention_p, probs = 0.975)),
+ explanation_low = as.numeric(quantile(explanation_p, probs = 0.025)),
+ explanation_high = as.numeric(quantile(explanation_p, probs = 0.975))) %>%
+ ungroup()
= df.confidence %>%
+ df.combined left_join(df.percentage %>%
+ select(-(contains("_n"))),
+ by = c("structure", "outcome", "action", "choice")) %>%
+ select(structure, outcome, action, choice, contains("intervention"),
+ contains("explanation"))
= read_csv("intervention_predictions.csv")
+ df.prediction_intervention = read_csv("explanation_predictions.csv") %>%
+ df.prediction_explanation select(-truth)
+
+= df.prediction_intervention %>%
+ df.optimal_intervention_model mutate(index = "intervention_prediction") %>%
+ bind_rows(df.prediction_explanation %>%
+ mutate(index = "explanation_prediction")) %>%
+ select(structure = causal_structure,
+
+ outcome, action = intervention,
+
+ choice,
+ index,%>%
+ prediction) pivot_wider(names_from = index,
+ values_from = prediction)
+
+= read_csv("explanation_predictions_intervention_only.csv")
+ df.intervention_only_model = read_csv("explanation_predictions_truth_only.csv")
+ df.truth_only_model
+= df.intervention_only_model %>%
+ df.alternative_models mutate(model = "intervention_only") %>%
+ bind_rows(df.truth_only_model %>%
+ mutate(model = "truth_only")) %>%
+ select(structure = causal_structure,
+
+ outcome, action = intervention,
+
+ choice,
+ model, %>%
+ prediction) pivot_wider(names_from = model,
+ values_from = prediction)
+
+= df.optimal_intervention_model %>%
+ df.models left_join(df.alternative_models)
= df.combined %>%
+ df.plot mutate(choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+= df.optimal_intervention_model %>%
+ df.model left_join(df.alternative_models) %>%
+ mutate(choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+= df.model %>%
+ df.model2 select(-intervention_prediction) %>%
+ pivot_longer(cols = c("explanation_prediction", "intervention_only", "truth_only"),
+ names_to = "model",
+ values_to = "prediction") %>%
+ mutate(model = factor(model,
+ levels = c("truth_only", "explanation_prediction", "intervention_only"))) %>%
+ arrange(structure, outcome, action, choice, model)
+
+ = ggplot(data = df.plot,
+ p_intervention mapping = aes(x = action,
+ y = intervention_p,
+ group = choice,
+ fill = action,
+ alpha = choice)) +
+ geom_col(color = "black",
+ position = position_dodge(width = 0.9)) +
+ geom_linerange(mapping = aes(ymin = intervention_low,
+ ymax = intervention_high),
+ position = position_dodge(width = 0.9),
+ alpha = 1,
+ linewidth = 1) +
+ geom_point(data = df.model,
+ mapping = aes(y = intervention_prediction),
+ position = position_dodge(width = 0.9),
+ shape = 21,
+ size = 4,
+ show.legend = F) +
+ facet_grid(structure ~ outcome) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_alpha_manual(values = c(0.4, 0.65, 0.9)) +
+ labs(title = "Intervention Task",
+ x = "type of intervention",
+ y = "percent selected") +
+ theme(legend.position = "bottom",
+ plot.title = element_text(hjust = 0.5)) +
+ guides(fill = "none",
+ alpha = "none")
+
+= ggplot(data = df.plot,
+ p_explanation mapping = aes(x = action,
+ y = explanation_p,
+ group = choice,
+ fill = action,
+ alpha = choice)) +
+ geom_col(color = "black",
+ position = position_dodge(width = 0.9)) +
+ geom_linerange(mapping = aes(ymin = explanation_low,
+ ymax = explanation_high),
+ position = position_dodge(width = 0.9),
+ alpha = 1,
+ linewidth = 1) +
+ geom_point(data = df.model2,
+ mapping = aes(y = prediction,
+ shape = model),
+ position = position_dodge2(width = 0.9,
+ padding = 0.2),
+ size = 4,
+ show.legend = F) +
+ facet_grid(structure ~ outcome) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_alpha_manual(values = c(0.4, 0.65, 0.9)) +
+ scale_shape_manual(values = c("truth_only" = 22,
+ "explanation_prediction" = 21,
+ "intervention_only" = 23)) +
+ labs(title = "Explanation Task",
+ x = "type of intervention",
+ y = "percent selected") +
+ theme(legend.position = "bottom",
+ plot.title = element_text(hjust = 0.5)) +
+ guides(fill = "none")
+
++ p_explanation +
+ p_intervention plot_layout(ncol = 1) + plot_annotation(tag_levels = "A") &
+ theme(plot.tag = element_text(size = 40, face = "bold"))
+
+ggsave(filename = "../../../figures/plots/bars.pdf",
+width = 20,
+ height = 14)
= function(data, xtitle, ytitle, legend = F){
+ fun.scatter = ggplot(data = data,
+ p mapping = aes(x = model,
+ y = p,
+ ymin = low,
+ ymax = high)) +
+ geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
+ annotate(geom = "text",
+ x = 0,
+ y = 1,
+ hjust = 0,
+ label = str_c("r = ", round(cor(data$model, data$p), 2)),
+ size = 8) +
+ annotate(geom = "text",
+ x = 0,
+ y = 0.92,
+ hjust = 0,
+ label = str_c("RMSE = ", round(sqrt(mean((data$model - data$p)^2)), 2)),
+ size = 8) +
+ geom_smooth(method = "lm",
+ color = "black",
+ alpha = 0.2,
+ show.legend = F) +
+ geom_linerange(alpha = 0.2) +
+ geom_point(mapping = aes(fill = action),
+ alpha = 0.9,
+ shape = 21,
+ size = 4) +
+ scale_x_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ labs(x = xtitle,
+ y = ytitle) +
+ theme(legend.position = c(1, 0),
+ legend.justification = c(1.2, -0.1))
+
+ if(legend == F){
+ = p + theme(legend.position = "none")
+ p
+ }
+ return(p)
+ }
= df.combined %>%
+ df.plot left_join(df.models %>%
+ mutate(choice = factor(choice,
+ levels = c("abnormal", "nopreference", "normal"),
+ labels = c("abnormal", "no preference", "normal")))) %>%
+ mutate(structure = factor(structure,
+ levels = c("conjunctive", "disjunctive")),
+ choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+= df.plot %>%
+ df.plot.intervention select(structure, outcome, action, choice,
+ low = intervention_low, high = intervention_high,
+ p = intervention_p, model = intervention_prediction)
+
+= df.plot %>%
+ df.plot.explanation select(structure, outcome, action, choice,
+ low = explanation_low, high = explanation_high,
+ p = explanation_p,
+
+ explanation_prediction,
+ intervention_only,
+ truth_only)
+ = fun.scatter(data = df.plot.intervention,
+ scatter1 xtitle = "model prediction",
+ ytitle = "intervention choices",
+ legend = T)
+
+= fun.scatter(data = df.plot.explanation %>%
+ scatter2 mutate(model = intervention_only),
+ xtitle = "relevance only model",
+ ytitle = "explanation choices")
+
+= fun.scatter(data = df.plot.explanation %>%
+ scatter3 mutate(model = truth_only),
+ xtitle = "accuracy only model",
+ ytitle = "explanation choices")
+
+= fun.scatter(data = df.plot.explanation %>%
+ scatter4 mutate(model = explanation_prediction),
+ xtitle = "combined model",
+ ytitle = "explanation choices")
+
++ scatter2 + scatter3 + scatter4 +
+ scatter1 plot_layout(ncol = 2) +
+ plot_annotation(tag_levels = "A") &
+ theme(text = element_text(size = 30),
+ plot.tag = element_text(size = 40, face = "bold"),
+ plot.margin = margin(t = 0,
+ r = 0.35,
+ b = 0,
+ l = 0,
+ "cm"))
+
+ggsave(filename = "../../../figures/plots/scatter.pdf",
+width = 16,
+ height = 12)
= df.plot %>%
+ df.scatter ungroup() %>%
+ pivot_longer(cols = contains("_"),
+ names_to = c("task", "index"),
+ names_sep = "_",
+ values_to = "value") %>%
+ pivot_wider(names_from = index,
+ values_from = value) %>%
+ left_join(df.model %>%
+ pivot_longer(cols = contains("_"),
+ names_to = c("task", "index"),
+ names_sep = "_",
+ values_to = "model") %>%
+ select(-index),
+ by = c("structure", "outcome", "action", "choice", "task"))
+
+
+ggplot(data = df.scatter,
+mapping = aes(x = model,
+ y = p,
+ ymin = low,
+ ymax = high)) +
+ geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
+ annotate(geom = "text",
+ x = 0,
+ y = 1,
+ hjust = 0,
+ label = str_c("r = ", round(cor(df.scatter$model, df.scatter$p), 2)),
+ size = 8) +
+ annotate(geom = "text",
+ x = 0,
+ y = 0.92,
+ hjust = 0,
+ label = str_c("RMSE = ", round(sqrt(mean((df.scatter$model - df.scatter$p)^2)), 2)),
+ size = 8) +
+ geom_smooth(method = "lm",
+ color = "black",
+ alpha = 0.2,
+ show.legend = F) +
+ geom_linerange(alpha = 0.2) +
+ geom_point(mapping = aes(fill = action),
+ # shape = task),
+ shape = 21,
+ size = 2) +
+ scale_x_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ # scale_shape_manual(values = c("intervention" = 21,
+ # "explanation" = 22)) +
+ labs(x = "model prediction",
+ y = "participant choices") +
+ theme(legend.position = c(1, 0),
+ legend.justification = c(1.2, -0.1))
+
+ggsave(filename = "../../../figures/plots/scatter.pdf",
+width = 8,
+ height = 6)
%>%
+ df.combined ungroup() %>%
+ select(-(contains("low") | contains("high"))) %>%
+ mutate(choice = str_replace(choice, "no preference", "nopreference")) %>%
+ left_join(df.alternative_models) %>%
+ left_join(df.optimal_intervention_model %>%
+ select(-intervention_prediction)) %>%
+ summarize(across(c(explanation_prediction, intervention_only, truth_only),
+ list(r = ~ cor(.x, explanation_p),
+ rmse = ~ sqrt(mean((.x - explanation_p)^2))),
+ .names = "{.col}.{.fn}")) %>%
+ pivot_longer(cols = everything(),
+ names_to = c("model", "stat"),
+ names_sep = "\\.",
+ values_to = "value") %>%
+ pivot_wider(names_from = stat,
+ values_from = value) %>%
+ mutate(across(where(is.numeric),
+ ~ round(., 2)))
# A tibble: 3 × 3
+ model r rmse
+ <chr> <dbl> <dbl>
+1 explanation_prediction 0.81 0.09
+2 intervention_only 0.61 0.13
+3 truth_only 0.47 0.14
+R version 4.1.3 (2022-03-10)
+Platform: x86_64-apple-darwin17.0 (64-bit)
+Running under: macOS Big Sur/Monterey 10.16
+
+Matrix products: default
+BLAS: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRblas.0.dylib
+LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+locale:
+[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+attached base packages:
+[1] stats graphics grDevices utils datasets methods base
+
+other attached packages:
+ [1] lubridate_1.9.2 forcats_1.0.0 stringr_1.5.0 dplyr_1.1.4
+ [5] purrr_1.0.1 readr_2.1.4 tidyr_1.3.0 tibble_3.2.1
+ [9] ggplot2_3.4.4 tidyverse_2.0.0 patchwork_1.1.2 modelr_0.1.11
+[13] knitr_1.38
+
+loaded via a namespace (and not attached):
+ [1] tidyselect_1.2.0 xfun_0.30 bslib_0.3.1 lattice_0.20-45
+ [5] splines_4.1.3 colorspace_2.0-3 vctrs_0.6.5 generics_0.1.2
+ [9] htmltools_0.5.2 mgcv_1.8-39 yaml_2.3.5 utf8_1.2.2
+[13] rlang_1.1.1 jquerylib_0.1.4 pillar_1.9.0 glue_1.6.2
+[17] withr_2.5.0 bit64_4.0.5 lifecycle_1.0.3 munsell_0.5.0
+[21] gtable_0.3.0 ragg_1.2.5 evaluate_0.15 tzdb_0.4.0
+[25] fastmap_1.1.0 parallel_4.1.3 fansi_1.0.3 highr_0.9
+[29] broom_1.0.5 backports_1.4.1 scales_1.2.1 vroom_1.6.3
+[33] jsonlite_1.8.4 systemfonts_1.0.4 farver_2.1.0 bit_4.0.4
+[37] textshaping_0.3.6 hms_1.1.3 digest_0.6.29 stringi_1.7.6
+[41] bookdown_0.25 grid_4.1.3 cli_3.6.1 tools_4.1.3
+[45] magrittr_2.0.3 sass_0.4.1 crayon_1.5.1 pkgconfig_2.0.3
+[49] Matrix_1.4-0 timechange_0.2.0 rmarkdown_2.13 rstudioapi_0.15.0
+[53] R6_2.5.1 nlme_3.1-155 compiler_4.1.3
+library("knitr")
+library("janitor")
+library("patchwork")
+library("Metrics")
+library("tidyverse")
theme_set(theme_classic() +
+theme(text = element_text(size = 24)))
+
+$set(comment = "",
+ opts_chunkfig.show = "hold")
+
+# suppress grouping warning
+options(dplyr.summarise.inform = F)
= function(x, temp = 3) {
+ fun.softmax = exp(x*temp) / sum(exp(x*temp))
+ out return(out)
+ }
= bind_rows(
+ df.data read_csv(file = "../../../data/hardint_pos.csv"),
+ read_csv(file = "../../../data/hardint_neg.csv"),
+ read_csv(file = "../../../data/softint_pos.csv"),
+ read_csv(file = "../../../data/softint_neg.csv"),
+ read_csv(file = "../../../data/fixedint_pos.csv"),
+ read_csv(file = "../../../data/fixedint_neg.csv")) %>%
+ clean_names() %>%
+ mutate(causal_structure = str_to_lower(causal_structure),
+ experiment = str_remove(experiment, "int")) %>%
+ rename_with(.fn = ~str_remove_all(., "_percentage")) %>%
+ pivot_longer(cols = -c(causal_structure, outcome, experiment),
+ values_to = "probability") %>%
+ separate(col = name,
+ into = c("choice", "type")) %>%
+ mutate(across(.cols = -probability,
+ .fns = ~ as.factor(.)),
+ choice = factor(choice, levels = c("abnormal", "nopreference", "normal"))) %>%
+ mutate(probability = probability / 100)
+
+= df.data %>%
+ df.intervention filter(type == "intervention") %>%
+ rename(intervention = experiment)
+
+= df.data %>%
+ df.explanation filter(type == "explanation")
+
+colnames(df.data)
[1] "causal_structure" "outcome" "experiment" "choice"
+[5] "type" "probability"
+# write_csv(df.data, "data.csv")
= function(p_abnormal, p_normal, causal_structure, outcome){
+ fun.success if (causal_structure == "conjunctive"){
+ = p_abnormal * p_normal
+ p else{
+ } = 1 - (1 - p_abnormal) * (1 - p_normal)
+ p
+ }if (outcome == "negative"){
+ = 1 - p
+ p
+ }return(p)
+
+ }
+= c("conjunctive", "disjunctive")
+ causal_structure = c("positive", "negative")
+ outcome
+= expand_grid(causal_structure, outcome) %>%
+ df.model mutate(p_abnormal = 0.2,
+ p_normal = 0.8,
+ int_hard_abnormal = ifelse(outcome == "positive", 1, 0),
+ int_hard_normal = ifelse(outcome == "positive", 1, 0),
+ int_soft_abnormal = ifelse(outcome == "positive",
+ + 0.2,
+ p_abnormal - 0.2),
+ p_abnormal int_soft_normal = ifelse(outcome == "positive",
+ + 0.2,
+ p_normal - 0.2),
+ p_normal int_fixed_abnormal = ifelse(outcome == "positive",
+ 0.9,
+ 0.1),
+ int_fixed_normal = ifelse(outcome == "positive",
+ 0.9,
+ 0.1),
+ p_success = pmap_dbl(.l = list(p_abnormal,
+
+ p_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_hard_abnormal = pmap_dbl(.l = list(int_hard_abnormal,
+
+ p_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_hard_normal = pmap_dbl(.l = list(p_abnormal,
+
+ int_hard_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_soft_abnormal = pmap_dbl(.l = list(int_soft_abnormal,
+
+ p_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_soft_normal = pmap_dbl(.l = list(p_abnormal,
+
+ int_soft_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_fixed_abnormal = pmap_dbl(.l = list(int_fixed_abnormal,
+
+ p_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_fixed_normal = pmap_dbl(.l = list(p_abnormal,
+
+ int_fixed_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)))
# gives expected value for each intervention
+= df.model %>%
+ df.choice select(causal_structure, outcome,
+ contains("p_success_int")) %>%
+ pivot_longer(-c(causal_structure, outcome)) %>%
+ mutate(name = str_remove(name, "p_success_int_")) %>%
+ separate(name, into = c("intervention", "target")) %>%
+ pivot_wider(names_from = target,
+ values_from = value) %>%
+ arrange(intervention, causal_structure) %>%
+ relocate(intervention) %>%
+ mutate(nopreference = 0.5 * abnormal + 0.5 * normal) %>%
+ pivot_longer(c(abnormal, normal, nopreference),
+ names_to = "choice") %>%
+ mutate(choice = factor(choice, levels = c("abnormal", "nopreference", "normal")),
+ across(.cols = c(intervention, causal_structure, outcome),
+ .fns = ~ as.factor(.)))
= function(df_data, df_prediction, temperature){
+ fun.fit_temperature %>%
+ df_prediction group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(value, temp = temperature)) %>%
+ ungroup() %>%
+ left_join(df_data,
+ by = c("intervention", "causal_structure", "outcome", "choice")) %>%
+ summarize(loss = sum((prediction - probability) ^ 2)) %>%
+ pull(loss)
+
+ }
+= optim(par = 10,
+ fit.temperature fn = fun.fit_temperature,
+ method = "L-BFGS-B",
+ lower = 0,
+ upper = 100,
+ df_data = df.intervention,
+ df_prediction = df.choice)
+
+print(fit.temperature$par)
[1] 18.97389
+= df.choice %>%
+ df.prediction_intervention group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(value, temp = fit.temperature$par)) %>%
+ left_join(df.data %>%
+ filter(type == "intervention") %>%
+ select(-type) %>%
+ rename(intervention = experiment),
+ by = c("causal_structure", "outcome", "intervention", "choice"))
= df.choice %>%
+ df.prediction_explanation group_by(intervention, causal_structure, outcome) %>%
+ mutate(truth = ifelse(choice == "nopreference", 1, 0)) %>%
+ left_join(df.data %>%
+ filter(type == "explanation") %>%
+ select(-type) %>%
+ rename(intervention = experiment),
+ by = c("causal_structure", "outcome", "intervention", "choice")) %>%
+ ungroup()
= function(params, df_prediction){
+ fun.fit_params
+ <- params[1]
+ weight <- params[2]
+ temperature
+ %>%
+ df_prediction group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(weight * value + (1 - weight) * truth, temp = temperature)) %>%
+ ungroup() %>%
+ summarize(loss = sum((prediction - probability) ^ 2)) %>%
+ pull(loss)
+ }
= function(params, df_prediction){
+ fun.fit_params_intervention_only
+ <- params[1]
+ temperature
+ %>%
+ df_prediction group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(value, temp = temperature)) %>%
+ ungroup() %>%
+ summarize(loss = sum((prediction - probability) ^ 2)) %>%
+ pull(loss)
+ }
= function(params, df_prediction){
+ fun.fit_params_truth_only
+ <- params[1]
+ temperature
+ %>%
+ df_prediction group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(truth, temp = temperature)) %>%
+ ungroup() %>%
+ summarize(loss = sum((prediction - probability) ^ 2)) %>%
+ pull(loss)
+ }
<- c(weight = 0.5, temperature = 10)
+ initial_params <- c(weight = 0, temperature = 0)
+ lower_bounds <- c(weight = 1, temperature = 100)
+ upper_bounds
+<- optim(par = initial_params,
+ fit.params fn = fun.fit_params,
+ method = "L-BFGS-B",
+ lower = lower_bounds,
+ upper = upper_bounds,
+ df_prediction = df.prediction_explanation)
+
+print(fit.params$par)
weight temperature
+ 0.8420403 3.5050364
+<- c(temperature = 10)
+ initial_params <- c(temperature = 0)
+ lower_bounds <- c(temperature = 100)
+ upper_bounds
+<- optim(par = initial_params,
+ fit.params_intervention_only fn = fun.fit_params_intervention_only,
+ method = "L-BFGS-B",
+ lower = lower_bounds,
+ upper = upper_bounds,
+ df_prediction = df.prediction_explanation)
+
+print(fit.params_intervention_only$par)
temperature
+ 2.097383
+<- c(temperature = 10)
+ initial_params <- c(temperature = 0)
+ lower_bounds <- c(temperature = 100)
+ upper_bounds
+<- optim(par = initial_params,
+ fit.params_truth_only fn = fun.fit_params_truth_only,
+ method = "L-BFGS-B",
+ lower = lower_bounds,
+ upper = upper_bounds,
+ df_prediction = df.prediction_explanation)
+
+print(fit.params_truth_only$par)
temperature
+ 0.4546058
+= df.prediction_explanation %>%
+ df.prediction_explanation group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(fit.params$par[1] * value + (1 - fit.params$par[1]) * truth, temp = fit.params$par[2])) %>%
+ ungroup()
+
+write.csv(df.prediction_explanation, file = "explanation_predictions.csv", row.names = FALSE)
+write.csv(df.prediction_intervention, file = "intervention_predictions.csv", row.names = FALSE)
= df.prediction_explanation %>%
+ df.prediction_explanation_intervention_only group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(value, temp = fit.params_intervention_only$par[1])) %>%
+ ungroup()
+
+write.csv(df.prediction_explanation_intervention_only, file = "explanation_predictions_intervention_only.csv", row.names = FALSE)
= df.prediction_explanation %>%
+ df.prediction_explanation_truth_only group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(truth, temp = fit.params_truth_only$par[1])) %>%
+ ungroup()
+
+write.csv(df.prediction_explanation_truth_only, file = "explanation_predictions_truth_only.csv", row.names = FALSE)
R version 4.1.3 (2022-03-10)
+Platform: x86_64-apple-darwin17.0 (64-bit)
+Running under: macOS Big Sur/Monterey 10.16
+
+Matrix products: default
+BLAS: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRblas.0.dylib
+LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+locale:
+[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+attached base packages:
+[1] stats graphics grDevices utils datasets methods base
+
+other attached packages:
+ [1] lubridate_1.9.2 forcats_1.0.0 stringr_1.5.0 dplyr_1.1.4
+ [5] purrr_1.0.1 readr_2.1.4 tidyr_1.3.0 tibble_3.2.1
+ [9] ggplot2_3.4.4 tidyverse_2.0.0 Metrics_0.1.4 patchwork_1.1.2
+[13] janitor_2.2.0 knitr_1.38
+
+loaded via a namespace (and not attached):
+ [1] bslib_0.3.1 compiler_4.1.3 pillar_1.9.0 jquerylib_0.1.4
+ [5] tools_4.1.3 bit_4.0.4 digest_0.6.29 jsonlite_1.8.4
+ [9] evaluate_0.15 lifecycle_1.0.3 gtable_0.3.0 timechange_0.2.0
+[13] pkgconfig_2.0.3 rlang_1.1.1 cli_3.6.1 rstudioapi_0.15.0
+[17] parallel_4.1.3 yaml_2.3.5 xfun_0.30 fastmap_1.1.0
+[21] withr_2.5.0 hms_1.1.3 generics_0.1.2 vctrs_0.6.5
+[25] sass_0.4.1 bit64_4.0.5 grid_4.1.3 tidyselect_1.2.0
+[29] glue_1.6.2 snakecase_0.11.0 R6_2.5.1 fansi_1.0.3
+[33] vroom_1.6.3 rmarkdown_2.13 bookdown_0.25 tzdb_0.4.0
+[37] magrittr_2.0.3 scales_1.2.1 htmltools_0.5.2 colorspace_2.0-3
+[41] utf8_1.2.2 stringi_1.7.6 munsell_0.5.0 crayon_1.5.1
+library("knitr")
+library("modelr") # for bootstrapping
+library("patchwork") # making figure panels
+library("tidyverse") # for data wrangling, visualization, etc.
theme_set(theme_classic() +
+theme(text = element_text(size = 24)))
+
+$set(comment = "",
+ opts_chunkfig.show = "hold")
+
+# suppress grouping warning
+options(dplyr.summarise.inform = F)
#### Read in Data
+= read.csv(file = "explanation_selection_positive_outcome_study_2-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "explanation_selection_positive_outcome_study_2-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data1
<- df.data1 %>%
+ df.exp1 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Conpos_") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Conpos_") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Dispos_") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Dispos_") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Conpos_") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Dispos_") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "hard") %>%
+ mutate(outcome = "positive")
<- df.exp1 %>%
+ df.exp1_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "positive") %>%
+ mutate(Experiment = "hardint")
+
+write_csv(df.exp1_summary, "hardint_pos.csv")
#### Read in Data
+= read.csv(file = "explanation_selection_negative_outcome-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "explanation_selection_negative_outcome-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data2
<- df.data2 %>%
+ df.exp2 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Conneg_") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Conneg_") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Disneg_") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Disneg_") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Conneg_") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Disneg_") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "hard") %>%
+ mutate(outcome = "negative")
<- df.exp2 %>%
+ df.exp2_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "negative") %>%
+ mutate(Experiment = "hardint")
+
+write_csv(df.exp2_summary, "hardint_neg.csv")
###Experiment 4
+#### Read in Data
+
+= read.csv(file = "pressbutton_positivecondition-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "pressbutton_positivecondition-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data3
<- df.data3 %>%
+ df.exp3 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_1") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_1") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_2") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_2") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_1") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_2") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other"))%>%
+ interventionmutate(intervention = "soft") %>%
+ mutate(outcome = "positive")
<- df.exp3 %>%
+ df.exp3_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "positive") %>%
+ mutate(Experiment = "softint")
+
+write_csv(df.exp3_summary, "softint_pos.csv")
###Experiment 4
+#### Read in Data
+
+= read.csv(file = "pressbutton_negativecondition-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "pressbutton_negativecondition-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") %>%
+ df.data4 filter(!row_number() %in% c(71, 72))
<- df.data4 %>%
+ df.exp4 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_4") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "soft") %>%
+ mutate(outcome = "negative")
<- df.exp4 %>%
+ df.exp4_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "negative") %>%
+ mutate(Experiment = "softint")
+
+write_csv(df.exp4_summary, "softint_neg.csv")
###Experiment 5
+#### Read in Data
+
+= read.csv(file = "fixedintervention_positive-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "fixedintervention_positive-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data5
<- df.data5 %>%
+ df.exp5 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition1") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition1") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition2") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition2") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition1") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition2") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "fixed") %>%
+ mutate(outcome = "positive")
<- df.exp5 %>%
+ df.exp5_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "negative") %>%
+ mutate(Experiment = "fixedint")
+
+write_csv(df.exp5_summary, "fixedint_pos.csv")
###Experiment 6
+#### Read in Data
+
+= read.csv(file = "fixedintervention_negative-responses.csv", stringsAsFactors = F, sep = ",") %>%
+ df.responses select(-error)
+
+
+<- read.csv(file = "fixedintervention_negative-participants.csv", stringsAsFactors = F, sep = ",") %>%
+ df.participants select(-c(proliferate.condition, error))
+
+
+<- merge(df.responses, df.participants, by="workerid") df.data6
<- df.data6 %>%
+ df.exp6 gather("index", "response", -c(workerid, proliferate.condition, age, ethnicity, gender, feedback, race))%>%
+ mutate(CausalStructure =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_1") ~ "Conjunctive",
+ str_detect(proliferate.condition, "Condition_3") & str_detect(index, "response_2") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_1") ~ "Disjunctive",
+ str_detect(proliferate.condition, "Condition_4") & str_detect(index, "response_2") ~ "Conjunctive"))%>%
+ mutate(Order =
+ case_when(
+ str_detect(proliferate.condition, "Condition_3") ~ "conjunctive first",
+ str_detect(proliferate.condition, "Condition_4") ~ "disjunctive first"))%>%
+ mutate(ResponseType =
+ case_when(
+ str_detect(index, "explanation") ~ "explanation",
+ str_detect(index, "intervention") ~ "intervention"))%>%
+ select(-index) %>%
+ spread(ResponseType, response) %>%
+ mutate(CausalStructure= factor(CausalStructure, levels=c("Conjunctive", "Disjunctive"))) %>%
+ mutate(explanation = recode (explanation,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(intervention = recode (intervention,
+ "orange" = "abnormal",
+ "blue" = "normal" )) %>%
+ mutate(abnormal_explanation =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ explanation != "abnormal"~ "other")) %>%
+ explanation mutate(normal_explanation =
+ case_when(
+ == "normal" ~ "normal",
+ explanation != "normal"~ "other")) %>%
+ explanation mutate(nopreference_explanation =
+ case_when(
+ == "no preference" ~ "no preference",
+ explanation != "no preference"~ "other")) %>%
+ explanation mutate(abnormal_intervention =
+ case_when(
+ == "abnormal" ~ "abnormal",
+ intervention!= "abnormal"~ "other")) %>%
+ interventionmutate(normal_intervention =
+ case_when(
+ == "normal" ~ "normal",
+ intervention != "normal"~ "other")) %>%
+ intervention mutate(nopreference_intervention =
+ case_when(
+ == "no preference" ~ "no preference",
+ intervention!= "no preference"~ "other")) %>%
+ interventionmutate(intervention = "fixed") %>%
+ mutate(outcome = "negative")
<- df.exp6 %>%
+ df.exp6_summary group_by(CausalStructure) %>%
+ summarise(
+ abnormal_explanation_percentage = mean(abnormal_explanation == "abnormal") * 100,
+ normal_explanation_percentage = mean(normal_explanation == "normal") * 100,
+ nopreference_explanation_percentage = mean(nopreference_explanation == "no preference") * 100,
+
+ abnormal_intervention_percentage = mean(abnormal_intervention == "abnormal") * 100,
+ normal_intervention_percentage = mean(normal_intervention == "normal") * 100,
+ nopreference_intervention_percentage = mean(nopreference_intervention == "no preference") * 100
+ %>%
+ ) mutate(Outcome = "negative") %>%
+ mutate(Experiment = "fixedint")
+
+write_csv(df.exp6_summary, "fixedint_neg.csv")
<- rbind(df.exp1, df.exp2, df.exp3, df.exp4, df.exp5, df.exp6) df.exp_all
= df.exp_all %>%
+ df.boot select(workerid,
+ structure = CausalStructure,
+
+ outcome,action = intervention,
+
+ explanation,
+ abnormal_intervention,
+ normal_intervention,%>%
+ nopreference_intervention) mutate(structure = tolower(structure),
+ intervention = abnormal_intervention,
+ intervention = ifelse(normal_intervention != "other", normal_intervention, intervention),
+ intervention = ifelse(nopreference_intervention != "other", nopreference_intervention, intervention),
+ intervention = factor(intervention,
+ levels = c("abnormal", "no preference", "normal")),
+ explanation = factor(explanation,
+ levels = c("abnormal", "no preference", "normal"))) %>%
+ select(-contains("_"))
= df.boot %>%
+ df.percentage count(structure, outcome, action, choice = intervention,
+ name = "intervention_n") %>%
+ left_join(df.boot %>%
+ count(structure, outcome, action, choice = explanation,
+ name = "explanation_n"),
+ by = c("structure", "outcome", "action", "choice")) %>%
+ group_by(structure, outcome, action) %>%
+ mutate(intervention_p = intervention_n/sum(intervention_n),
+ explanation_p = explanation_n/sum(explanation_n)) %>%
+ ungroup()
set.seed(1)
+
+# percentages with bootstrapped confidence intervals
+= df.boot %>%
+ df.confidence group_by(structure, outcome, action) %>%
+ nest() %>%
+ mutate(bootstraps = map(.x = data,
+ .f = ~ bootstrap(.x, n = 1000))) %>%
+ unnest(bootstraps) %>%
+ mutate(intervention = map(.x = strap,
+ .f = ~ .x %>%
+ as_tibble() %>%
+ count(intervention,
+ name = "intervention_n",
+ .drop = F) %>%
+ mutate(intervention_p = intervention_n/sum(intervention_n))),
+ explanation = map(.x = strap,
+ .f = ~ .x %>%
+ as_tibble() %>%
+ count(explanation,
+ name = "explanation_n",
+ .drop = F) %>%
+ mutate(explanation_p = explanation_n/sum(explanation_n)))) %>%
+ select(structure, outcome, action, intervention, explanation) %>%
+ unnest(c(intervention, explanation)) %>%
+ select(everything(), choice = intervention, -explanation) %>%
+ group_by(structure, outcome, action, choice) %>%
+ summarize(intervention_low = as.numeric(quantile(intervention_p, probs = 0.025)),
+ intervention_high = as.numeric(quantile(intervention_p, probs = 0.975)),
+ explanation_low = as.numeric(quantile(explanation_p, probs = 0.025)),
+ explanation_high = as.numeric(quantile(explanation_p, probs = 0.975))) %>%
+ ungroup()
= df.confidence %>%
+ df.combined left_join(df.percentage %>%
+ select(-(contains("_n"))),
+ by = c("structure", "outcome", "action", "choice")) %>%
+ select(structure, outcome, action, choice, contains("intervention"),
+ contains("explanation"))
= read_csv("intervention_predictions.csv")
+ df.prediction_intervention = read_csv("explanation_predictions.csv") %>%
+ df.prediction_explanation select(-truth)
+
+= df.prediction_intervention %>%
+ df.optimal_intervention_model mutate(index = "intervention_prediction") %>%
+ bind_rows(df.prediction_explanation %>%
+ mutate(index = "explanation_prediction")) %>%
+ select(structure = causal_structure,
+
+ outcome, action = intervention,
+
+ choice,
+ index,%>%
+ prediction) pivot_wider(names_from = index,
+ values_from = prediction)
+
+= read_csv("explanation_predictions_intervention_only.csv")
+ df.intervention_only_model = read_csv("explanation_predictions_truth_only.csv")
+ df.truth_only_model
+= df.intervention_only_model %>%
+ df.alternative_models mutate(model = "intervention_only") %>%
+ bind_rows(df.truth_only_model %>%
+ mutate(model = "truth_only")) %>%
+ select(structure = causal_structure,
+
+ outcome, action = intervention,
+
+ choice,
+ model, %>%
+ prediction) pivot_wider(names_from = model,
+ values_from = prediction)
+
+= df.optimal_intervention_model %>%
+ df.models left_join(df.alternative_models)
= df.combined %>%
+ df.plot mutate(choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+= df.optimal_intervention_model %>%
+ df.model left_join(df.alternative_models) %>%
+ mutate(choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+= df.model %>%
+ df.model2 select(-intervention_prediction) %>%
+ pivot_longer(cols = c("explanation_prediction", "intervention_only", "truth_only"),
+ names_to = "model",
+ values_to = "prediction") %>%
+ mutate(model = factor(model,
+ levels = c("truth_only", "explanation_prediction", "intervention_only"))) %>%
+ arrange(structure, outcome, action, choice, model)
+
+ = ggplot(data = df.plot,
+ p_intervention mapping = aes(x = action,
+ y = intervention_p,
+ group = choice,
+ fill = action,
+ alpha = choice)) +
+ geom_col(color = "black",
+ position = position_dodge(width = 0.9)) +
+ geom_linerange(mapping = aes(ymin = intervention_low,
+ ymax = intervention_high),
+ position = position_dodge(width = 0.9),
+ alpha = 1,
+ linewidth = 1) +
+ geom_point(data = df.model,
+ mapping = aes(y = intervention_prediction),
+ position = position_dodge(width = 0.9),
+ shape = 21,
+ size = 4,
+ show.legend = F) +
+ facet_grid(structure ~ outcome) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_alpha_manual(values = c(0.4, 0.65, 0.9)) +
+ labs(title = "Intervention Task",
+ x = "type of intervention",
+ y = "percent selected") +
+ theme(legend.position = "bottom",
+ plot.title = element_text(hjust = 0.5)) +
+ guides(fill = "none",
+ alpha = "none")
+
+= ggplot(data = df.plot,
+ p_explanation mapping = aes(x = action,
+ y = explanation_p,
+ group = choice,
+ fill = action,
+ alpha = choice)) +
+ geom_col(color = "black",
+ position = position_dodge(width = 0.9)) +
+ geom_linerange(mapping = aes(ymin = explanation_low,
+ ymax = explanation_high),
+ position = position_dodge(width = 0.9),
+ alpha = 1,
+ linewidth = 1) +
+ geom_point(data = df.model2,
+ mapping = aes(y = prediction,
+ shape = model),
+ position = position_dodge2(width = 0.9,
+ padding = 0.2),
+ size = 4,
+ show.legend = F) +
+ facet_grid(structure ~ outcome) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_alpha_manual(values = c(0.4, 0.65, 0.9)) +
+ scale_shape_manual(values = c("truth_only" = 22,
+ "explanation_prediction" = 21,
+ "intervention_only" = 23)) +
+ labs(title = "Explanation Task",
+ x = "type of intervention",
+ y = "percent selected") +
+ theme(legend.position = "bottom",
+ plot.title = element_text(hjust = 0.5)) +
+ guides(fill = "none")
+
++ p_explanation +
+ p_intervention plot_layout(ncol = 1) + plot_annotation(tag_levels = "A") &
+ theme(plot.tag = element_text(size = 40, face = "bold"))
+
+ggsave(filename = "../../../figures/plots/bars.pdf",
+width = 20,
+ height = 14)
= function(data, xtitle, ytitle, legend = F){
+ fun.scatter = ggplot(data = data,
+ p mapping = aes(x = model,
+ y = p,
+ ymin = low,
+ ymax = high)) +
+ geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
+ annotate(geom = "text",
+ x = 0,
+ y = 1,
+ hjust = 0,
+ label = str_c("r = ", round(cor(data$model, data$p), 2)),
+ size = 8) +
+ annotate(geom = "text",
+ x = 0,
+ y = 0.92,
+ hjust = 0,
+ label = str_c("RMSE = ", round(sqrt(mean((data$model - data$p)^2)), 2)),
+ size = 8) +
+ geom_smooth(method = "lm",
+ color = "black",
+ alpha = 0.2,
+ show.legend = F) +
+ geom_linerange(alpha = 0.2) +
+ geom_point(mapping = aes(fill = action),
+ alpha = 0.9,
+ shape = 21,
+ size = 4) +
+ scale_x_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ labs(x = xtitle,
+ y = ytitle) +
+ theme(legend.position = c(1, 0),
+ legend.justification = c(1.2, -0.1))
+
+ if(legend == F){
+ = p + theme(legend.position = "none")
+ p
+ }
+ return(p)
+ }
= df.combined %>%
+ df.plot left_join(df.models %>%
+ mutate(choice = factor(choice,
+ levels = c("abnormal", "nopreference", "normal"),
+ labels = c("abnormal", "no preference", "normal")))) %>%
+ mutate(structure = factor(structure,
+ levels = c("conjunctive", "disjunctive")),
+ choice = factor(choice,
+ labels = c("abnormal", "no\npreference", "normal")),
+ outcome = factor(outcome,
+ levels = c("positive", "negative"),
+ labels = c("positive outcome", "negative outcome")),
+ action = factor(action,
+ levels = c("hard", "soft", "fixed")))
+
+= df.plot %>%
+ df.plot.intervention select(structure, outcome, action, choice,
+ low = intervention_low, high = intervention_high,
+ p = intervention_p, model = intervention_prediction)
+
+= df.plot %>%
+ df.plot.explanation select(structure, outcome, action, choice,
+ low = explanation_low, high = explanation_high,
+ p = explanation_p,
+
+ explanation_prediction,
+ intervention_only,
+ truth_only)
+ = fun.scatter(data = df.plot.intervention,
+ scatter1 xtitle = "model prediction",
+ ytitle = "intervention choices",
+ legend = T)
+
+= fun.scatter(data = df.plot.explanation %>%
+ scatter2 mutate(model = intervention_only),
+ xtitle = "relevance only model",
+ ytitle = "explanation choices")
+
+= fun.scatter(data = df.plot.explanation %>%
+ scatter3 mutate(model = truth_only),
+ xtitle = "accuracy only model",
+ ytitle = "explanation choices")
+
+= fun.scatter(data = df.plot.explanation %>%
+ scatter4 mutate(model = explanation_prediction),
+ xtitle = "combined model",
+ ytitle = "explanation choices")
+
++ scatter2 + scatter3 + scatter4 +
+ scatter1 plot_layout(ncol = 2) +
+ plot_annotation(tag_levels = "A") &
+ theme(text = element_text(size = 30),
+ plot.tag = element_text(size = 40, face = "bold"),
+ plot.margin = margin(t = 0,
+ r = 0.35,
+ b = 0,
+ l = 0,
+ "cm"))
+
+ggsave(filename = "../../../figures/plots/scatter.pdf",
+width = 16,
+ height = 12)
= df.plot %>%
+ df.scatter ungroup() %>%
+ pivot_longer(cols = contains("_"),
+ names_to = c("task", "index"),
+ names_sep = "_",
+ values_to = "value") %>%
+ pivot_wider(names_from = index,
+ values_from = value) %>%
+ left_join(df.model %>%
+ pivot_longer(cols = contains("_"),
+ names_to = c("task", "index"),
+ names_sep = "_",
+ values_to = "model") %>%
+ select(-index),
+ by = c("structure", "outcome", "action", "choice", "task"))
+
+
+ggplot(data = df.scatter,
+mapping = aes(x = model,
+ y = p,
+ ymin = low,
+ ymax = high)) +
+ geom_abline(intercept = 0, slope = 1, linetype = "dashed") +
+ annotate(geom = "text",
+ x = 0,
+ y = 1,
+ hjust = 0,
+ label = str_c("r = ", round(cor(df.scatter$model, df.scatter$p), 2)),
+ size = 8) +
+ annotate(geom = "text",
+ x = 0,
+ y = 0.92,
+ hjust = 0,
+ label = str_c("RMSE = ", round(sqrt(mean((df.scatter$model - df.scatter$p)^2)), 2)),
+ size = 8) +
+ geom_smooth(method = "lm",
+ color = "black",
+ alpha = 0.2,
+ show.legend = F) +
+ geom_linerange(alpha = 0.2) +
+ geom_point(mapping = aes(fill = action),
+ # shape = task),
+ shape = 21,
+ size = 2) +
+ scale_x_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ scale_y_continuous(limits = c(0, 1),
+ breaks = seq(0, 1, 0.25),
+ labels = scales::label_percent()) +
+ # scale_shape_manual(values = c("intervention" = 21,
+ # "explanation" = 22)) +
+ labs(x = "model prediction",
+ y = "participant choices") +
+ theme(legend.position = c(1, 0),
+ legend.justification = c(1.2, -0.1))
+
+ggsave(filename = "../../../figures/plots/scatter.pdf",
+width = 8,
+ height = 6)
%>%
+ df.combined ungroup() %>%
+ select(-(contains("low") | contains("high"))) %>%
+ mutate(choice = str_replace(choice, "no preference", "nopreference")) %>%
+ left_join(df.alternative_models) %>%
+ left_join(df.optimal_intervention_model %>%
+ select(-intervention_prediction)) %>%
+ summarize(across(c(explanation_prediction, intervention_only, truth_only),
+ list(r = ~ cor(.x, explanation_p),
+ rmse = ~ sqrt(mean((.x - explanation_p)^2))),
+ .names = "{.col}.{.fn}")) %>%
+ pivot_longer(cols = everything(),
+ names_to = c("model", "stat"),
+ names_sep = "\\.",
+ values_to = "value") %>%
+ pivot_wider(names_from = stat,
+ values_from = value) %>%
+ mutate(across(where(is.numeric),
+ ~ round(., 2)))
# A tibble: 3 × 3
+ model r rmse
+ <chr> <dbl> <dbl>
+1 explanation_prediction 0.81 0.09
+2 intervention_only 0.61 0.13
+3 truth_only 0.47 0.14
+R version 4.1.3 (2022-03-10)
+Platform: x86_64-apple-darwin17.0 (64-bit)
+Running under: macOS Big Sur/Monterey 10.16
+
+Matrix products: default
+BLAS: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRblas.0.dylib
+LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+locale:
+[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+attached base packages:
+[1] stats graphics grDevices utils datasets methods base
+
+other attached packages:
+ [1] lubridate_1.9.2 forcats_1.0.0 stringr_1.5.0 dplyr_1.1.4
+ [5] purrr_1.0.1 readr_2.1.4 tidyr_1.3.0 tibble_3.2.1
+ [9] ggplot2_3.4.4 tidyverse_2.0.0 patchwork_1.1.2 modelr_0.1.11
+[13] knitr_1.38
+
+loaded via a namespace (and not attached):
+ [1] tidyselect_1.2.0 xfun_0.30 bslib_0.3.1 lattice_0.20-45
+ [5] splines_4.1.3 colorspace_2.0-3 vctrs_0.6.5 generics_0.1.2
+ [9] htmltools_0.5.2 mgcv_1.8-39 yaml_2.3.5 utf8_1.2.2
+[13] rlang_1.1.1 jquerylib_0.1.4 pillar_1.9.0 glue_1.6.2
+[17] withr_2.5.0 bit64_4.0.5 lifecycle_1.0.3 munsell_0.5.0
+[21] gtable_0.3.0 ragg_1.2.5 evaluate_0.15 tzdb_0.4.0
+[25] fastmap_1.1.0 parallel_4.1.3 fansi_1.0.3 highr_0.9
+[29] broom_1.0.5 backports_1.4.1 scales_1.2.1 vroom_1.6.3
+[33] jsonlite_1.8.4 systemfonts_1.0.4 farver_2.1.0 bit_4.0.4
+[37] textshaping_0.3.6 hms_1.1.3 digest_0.6.29 stringi_1.7.6
+[41] bookdown_0.25 grid_4.1.3 cli_3.6.1 tools_4.1.3
+[45] magrittr_2.0.3 sass_0.4.1 crayon_1.5.1 pkgconfig_2.0.3
+[49] Matrix_1.4-0 timechange_0.2.0 rmarkdown_2.13 rstudioapi_0.15.0
+[53] R6_2.5.1 nlme_3.1-155 compiler_4.1.3
+library("knitr")
+library("janitor")
+library("patchwork")
+library("Metrics")
+library("tidyverse")
theme_set(theme_classic() +
+theme(text = element_text(size = 24)))
+
+$set(comment = "",
+ opts_chunkfig.show = "hold")
+
+# suppress grouping warning
+options(dplyr.summarise.inform = F)
= function(x, temp = 3) {
+ fun.softmax = exp(x*temp) / sum(exp(x*temp))
+ out return(out)
+ }
= bind_rows(
+ df.data read_csv(file = "../../../data/hardint_pos.csv"),
+ read_csv(file = "../../../data/hardint_neg.csv"),
+ read_csv(file = "../../../data/softint_pos.csv"),
+ read_csv(file = "../../../data/softint_neg.csv"),
+ read_csv(file = "../../../data/fixedint_pos.csv"),
+ read_csv(file = "../../../data/fixedint_neg.csv")) %>%
+ clean_names() %>%
+ mutate(causal_structure = str_to_lower(causal_structure),
+ experiment = str_remove(experiment, "int")) %>%
+ rename_with(.fn = ~str_remove_all(., "_percentage")) %>%
+ pivot_longer(cols = -c(causal_structure, outcome, experiment),
+ values_to = "probability") %>%
+ separate(col = name,
+ into = c("choice", "type")) %>%
+ mutate(across(.cols = -probability,
+ .fns = ~ as.factor(.)),
+ choice = factor(choice, levels = c("abnormal", "nopreference", "normal"))) %>%
+ mutate(probability = probability / 100)
+
+= df.data %>%
+ df.intervention filter(type == "intervention") %>%
+ rename(intervention = experiment)
+
+= df.data %>%
+ df.explanation filter(type == "explanation")
+
+colnames(df.data)
[1] "causal_structure" "outcome" "experiment" "choice"
+[5] "type" "probability"
+# write_csv(df.data, "data.csv")
= function(p_abnormal, p_normal, causal_structure, outcome){
+ fun.success if (causal_structure == "conjunctive"){
+ = p_abnormal * p_normal
+ p else{
+ } = 1 - (1 - p_abnormal) * (1 - p_normal)
+ p
+ }if (outcome == "negative"){
+ = 1 - p
+ p
+ }return(p)
+
+ }
+= c("conjunctive", "disjunctive")
+ causal_structure = c("positive", "negative")
+ outcome
+= expand_grid(causal_structure, outcome) %>%
+ df.model mutate(p_abnormal = 0.2,
+ p_normal = 0.8,
+ int_hard_abnormal = ifelse(outcome == "positive", 1, 0),
+ int_hard_normal = ifelse(outcome == "positive", 1, 0),
+ int_soft_abnormal = ifelse(outcome == "positive",
+ + 0.2,
+ p_abnormal - 0.2),
+ p_abnormal int_soft_normal = ifelse(outcome == "positive",
+ + 0.2,
+ p_normal - 0.2),
+ p_normal int_fixed_abnormal = ifelse(outcome == "positive",
+ 0.9,
+ 0.1),
+ int_fixed_normal = ifelse(outcome == "positive",
+ 0.9,
+ 0.1),
+ p_success = pmap_dbl(.l = list(p_abnormal,
+
+ p_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_hard_abnormal = pmap_dbl(.l = list(int_hard_abnormal,
+
+ p_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_hard_normal = pmap_dbl(.l = list(p_abnormal,
+
+ int_hard_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_soft_abnormal = pmap_dbl(.l = list(int_soft_abnormal,
+
+ p_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_soft_normal = pmap_dbl(.l = list(p_abnormal,
+
+ int_soft_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_fixed_abnormal = pmap_dbl(.l = list(int_fixed_abnormal,
+
+ p_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)),
+ p_success_int_fixed_normal = pmap_dbl(.l = list(p_abnormal,
+
+ int_fixed_normal,
+ causal_structure,
+ outcome),.f = ~ fun.success(..1, ..2, ..3, ..4)))
# gives expected value for each intervention
+= df.model %>%
+ df.choice select(causal_structure, outcome,
+ contains("p_success_int")) %>%
+ pivot_longer(-c(causal_structure, outcome)) %>%
+ mutate(name = str_remove(name, "p_success_int_")) %>%
+ separate(name, into = c("intervention", "target")) %>%
+ pivot_wider(names_from = target,
+ values_from = value) %>%
+ arrange(intervention, causal_structure) %>%
+ relocate(intervention) %>%
+ mutate(nopreference = 0.5 * abnormal + 0.5 * normal) %>%
+ pivot_longer(c(abnormal, normal, nopreference),
+ names_to = "choice") %>%
+ mutate(choice = factor(choice, levels = c("abnormal", "nopreference", "normal")),
+ across(.cols = c(intervention, causal_structure, outcome),
+ .fns = ~ as.factor(.)))
= function(df_data, df_prediction, temperature){
+ fun.fit_temperature %>%
+ df_prediction group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(value, temp = temperature)) %>%
+ ungroup() %>%
+ left_join(df_data,
+ by = c("intervention", "causal_structure", "outcome", "choice")) %>%
+ summarize(loss = sum((prediction - probability) ^ 2)) %>%
+ pull(loss)
+
+ }
+= optim(par = 10,
+ fit.temperature fn = fun.fit_temperature,
+ method = "L-BFGS-B",
+ lower = 0,
+ upper = 100,
+ df_data = df.intervention,
+ df_prediction = df.choice)
+
+print(fit.temperature$par)
[1] 18.97389
+= df.choice %>%
+ df.prediction_intervention group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(value, temp = fit.temperature$par)) %>%
+ left_join(df.data %>%
+ filter(type == "intervention") %>%
+ select(-type) %>%
+ rename(intervention = experiment),
+ by = c("causal_structure", "outcome", "intervention", "choice"))
= df.choice %>%
+ df.prediction_explanation group_by(intervention, causal_structure, outcome) %>%
+ mutate(truth = ifelse(choice == "nopreference", 1, 0)) %>%
+ left_join(df.data %>%
+ filter(type == "explanation") %>%
+ select(-type) %>%
+ rename(intervention = experiment),
+ by = c("causal_structure", "outcome", "intervention", "choice")) %>%
+ ungroup()
= function(params, df_prediction){
+ fun.fit_params
+ <- params[1]
+ weight <- params[2]
+ temperature
+ %>%
+ df_prediction group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(weight * value + (1 - weight) * truth, temp = temperature)) %>%
+ ungroup() %>%
+ summarize(loss = sum((prediction - probability) ^ 2)) %>%
+ pull(loss)
+ }
= function(params, df_prediction){
+ fun.fit_params_intervention_only
+ <- params[1]
+ temperature
+ %>%
+ df_prediction group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(value, temp = temperature)) %>%
+ ungroup() %>%
+ summarize(loss = sum((prediction - probability) ^ 2)) %>%
+ pull(loss)
+ }
= function(params, df_prediction){
+ fun.fit_params_truth_only
+ <- params[1]
+ temperature
+ %>%
+ df_prediction group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(truth, temp = temperature)) %>%
+ ungroup() %>%
+ summarize(loss = sum((prediction - probability) ^ 2)) %>%
+ pull(loss)
+ }
<- c(weight = 0.5, temperature = 10)
+ initial_params <- c(weight = 0, temperature = 0)
+ lower_bounds <- c(weight = 1, temperature = 100)
+ upper_bounds
+<- optim(par = initial_params,
+ fit.params fn = fun.fit_params,
+ method = "L-BFGS-B",
+ lower = lower_bounds,
+ upper = upper_bounds,
+ df_prediction = df.prediction_explanation)
+
+print(fit.params$par)
weight temperature
+ 0.8420403 3.5050364
+<- c(temperature = 10)
+ initial_params <- c(temperature = 0)
+ lower_bounds <- c(temperature = 100)
+ upper_bounds
+<- optim(par = initial_params,
+ fit.params_intervention_only fn = fun.fit_params_intervention_only,
+ method = "L-BFGS-B",
+ lower = lower_bounds,
+ upper = upper_bounds,
+ df_prediction = df.prediction_explanation)
+
+print(fit.params_intervention_only$par)
temperature
+ 2.097383
+<- c(temperature = 10)
+ initial_params <- c(temperature = 0)
+ lower_bounds <- c(temperature = 100)
+ upper_bounds
+<- optim(par = initial_params,
+ fit.params_truth_only fn = fun.fit_params_truth_only,
+ method = "L-BFGS-B",
+ lower = lower_bounds,
+ upper = upper_bounds,
+ df_prediction = df.prediction_explanation)
+
+print(fit.params_truth_only$par)
temperature
+ 0.4546058
+= df.prediction_explanation %>%
+ df.prediction_explanation group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(fit.params$par[1] * value + (1 - fit.params$par[1]) * truth, temp = fit.params$par[2])) %>%
+ ungroup()
+
+write.csv(df.prediction_explanation, file = "explanation_predictions.csv", row.names = FALSE)
+write.csv(df.prediction_intervention, file = "intervention_predictions.csv", row.names = FALSE)
= df.prediction_explanation %>%
+ df.prediction_explanation_intervention_only group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(value, temp = fit.params_intervention_only$par[1])) %>%
+ ungroup()
+
+write.csv(df.prediction_explanation_intervention_only, file = "explanation_predictions_intervention_only.csv", row.names = FALSE)
= df.prediction_explanation %>%
+ df.prediction_explanation_truth_only group_by(intervention, causal_structure, outcome) %>%
+ mutate(prediction = fun.softmax(truth, temp = fit.params_truth_only$par[1])) %>%
+ ungroup()
+
+write.csv(df.prediction_explanation_truth_only, file = "explanation_predictions_truth_only.csv", row.names = FALSE)
R version 4.1.3 (2022-03-10)
+Platform: x86_64-apple-darwin17.0 (64-bit)
+Running under: macOS Big Sur/Monterey 10.16
+
+Matrix products: default
+BLAS: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRblas.0.dylib
+LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
+
+locale:
+[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
+
+attached base packages:
+[1] stats graphics grDevices utils datasets methods base
+
+other attached packages:
+ [1] lubridate_1.9.2 forcats_1.0.0 stringr_1.5.0 dplyr_1.1.4
+ [5] purrr_1.0.1 readr_2.1.4 tidyr_1.3.0 tibble_3.2.1
+ [9] ggplot2_3.4.4 tidyverse_2.0.0 Metrics_0.1.4 patchwork_1.1.2
+[13] janitor_2.2.0 knitr_1.38
+
+loaded via a namespace (and not attached):
+ [1] bslib_0.3.1 compiler_4.1.3 pillar_1.9.0 jquerylib_0.1.4
+ [5] tools_4.1.3 bit_4.0.4 digest_0.6.29 jsonlite_1.8.4
+ [9] evaluate_0.15 lifecycle_1.0.3 gtable_0.3.0 timechange_0.2.0
+[13] pkgconfig_2.0.3 rlang_1.1.1 cli_3.6.1 rstudioapi_0.15.0
+[17] parallel_4.1.3 yaml_2.3.5 xfun_0.30 fastmap_1.1.0
+[21] withr_2.5.0 hms_1.1.3 generics_0.1.2 vctrs_0.6.5
+[25] sass_0.4.1 bit64_4.0.5 grid_4.1.3 tidyselect_1.2.0
+[29] glue_1.6.2 snakecase_0.11.0 R6_2.5.1 fansi_1.0.3
+[33] vroom_1.6.3 rmarkdown_2.13 bookdown_0.25 tzdb_0.4.0
+[37] magrittr_2.0.3 scales_1.2.1 htmltools_0.5.2 colorspace_2.0-3
+[41] utf8_1.2.2 stringi_1.7.6 munsell_0.5.0 crayon_1.5.1
+' + cn_arr_long[i] + '
' + cn_arr_long[i] + '
' + cn_arr_long[i] + '
Please review the instructions again.', + choices: ['Review'], + }, + cn_instructions_long, + cn_instructions_comp_long + ], + loop_function: function (data) { + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_instructions_key = trialData["conjunctive_negative"]["cn_instructions_key"]; + + if (JSON.stringify(trial_data) === JSON.stringify(cn_instructions_key)) { + return false; + } else { + return true; + } + }, +} + +const cn_conditional_node_instructions_long = { + timeline: [ + cn_loop_node_instructions_long + ], + conditional_function: function(){ + // get the data from the previous trial + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + + const cn_instructions_key = trialData["conjunctive_negative"]["cn_instructions_key"]; + + // if the participant's respone doesn't match the key, replay the instructions and comp checks + if (JSON.stringify(trial_data) === JSON.stringify(cn_instructions_key)) { + return false; + } else { + return true; + } + }, +} + + +const cn_loop_node_round_one_q1_long = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + cn_round_one_long, + cn_round_one_comp_q1_long, + ], + loop_function: function (data) { + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_participant_key = trialData["conjunctive_negative"]["cn_gameplay_q1_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(participant_response) === JSON.stringify(cn_participant_key))) { + return false; + } else { + return true; + } + }, +} + +const cn_conditional_node_round_one_q1_long = { + timeline: [ + cn_loop_node_round_one_q1_long + ], + conditional_function: function(){ + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_participant_key = trialData["conjunctive_negative"]["cn_gameplay_q1_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(participant_response) === JSON.stringify(cn_participant_key))) { + return true; + } else { + return false; + } + }, +} + +const cn_loop_node_round_one_q2_long = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + cn_round_one_long, + cn_round_one_comp_q2_long, + ], + loop_function: function (data) { + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_teammate_key = trialData["conjunctive_negative"]["cn_gameplay_q2_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(teammate_response) === JSON.stringify(cn_teammate_key))) { + return false; + } else { + return true; + } + }, +} + +const cn_conditional_node_round_one_q2_long = { + timeline: [ + cn_loop_node_round_one_q2_long + ], + conditional_function: function(){ + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_teammate_key = trialData["conjunctive_negative"]["cn_gameplay_q2_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(teammate_response) === JSON.stringify(cn_teammate_key))) { + return true; + } else { + return false; + } + }, +} + +const cn_intervention_task_long = { + type: jsPsychSurveyMultiChoice, + preamble: `
' + cn_arr_short[i] + '
' + cn_arr_short[i] + '
' + cn_arr_short[i] + '
Please review the instructions again.', + choices: ['Review'], + }, + cn_instructions_short, + cn_instructions_comp_short + ], + loop_function: function (data) { + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_instructions_key = trialData["conjunctive_negative"]["cn_instructions_key"]; + + if (JSON.stringify(trial_data) === JSON.stringify(cn_instructions_key)) { + return false; + } else { + return true; + } + }, +} + +const cn_conditional_node_instructions_short = { + timeline: [ + cn_loop_node_instructions_short + ], + conditional_function: function(){ + // get the data from the previous trial + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_instructions_key = trialData["conjunctive_negative"]["cn_instructions_key"]; + + // if the participant's respone doesn't match the key, replay the instructions and comp checks + if (JSON.stringify(trial_data) === JSON.stringify(cn_instructions_key)) { + return false; + } else { + return true; + } + }, +} + + +const cn_loop_node_round_one_q1_short = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + cn_round_one_short, + cn_round_one_comp_q1_short, + ], + loop_function: function (data) { + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_participant_key = trialData["conjunctive_negative"]["cn_gameplay_q1_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(participant_response) === JSON.stringify(cn_participant_key))) { + return false; + } else { + return true; + } + }, +} + +const cn_conditional_node_round_one_q1_short = { + timeline: [ + cn_loop_node_round_one_q1_short + ], + conditional_function: function(){ + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_participant_key = trialData["conjunctive_negative"]["cn_gameplay_q1_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(participant_response) === JSON.stringify(cn_participant_key))) { + return true; + } else { + return false; + } + }, +} + +const cn_loop_node_round_one_q2_short = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + cn_round_one_short, + cn_round_one_comp_q2_short, + ], + loop_function: function (data) { + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_teammate_key = trialData["conjunctive_negative"]["cn_gameplay_q2_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(teammate_response) === JSON.stringify(cn_teammate_key))) { + return false; + } else { + return true; + } + }, +} + +const cn_conditional_node_round_one_q2_short = { + timeline: [ + cn_loop_node_round_one_q2_short + ], + conditional_function: function(){ + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cn_teammate_key = trialData["conjunctive_negative"]["cn_gameplay_q2_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(teammate_response) === JSON.stringify(cn_teammate_key))) { + return true; + } else { + return false; + } + }, +} + +const cn_intervention_task_short = { + type: jsPsychSurveyMultiChoice, + preamble: `
' + cp_arr_long[i] + '
' + cp_arr_long[i] + '
' + cp_arr_long[i] + '
Please review the instructions again.', + choices: ['Review'], + }, + cp_instructions_long, + cp_instructions_comp_long + ], + loop_function: function (data) { + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_instructions_key = trialData["conjunctive_positive"]["cp_instructions_key"]; + + console.log(trial_data); + console.log(cp_instructions_key); + if (JSON.stringify(trial_data) === JSON.stringify(cp_instructions_key)) { + return false; + } else { + return true; + } + }, +} + +const cp_conditional_node_instructions_long = { + timeline: [ + cp_loop_node_instructions_long + ], + conditional_function: function(){ + // get the data from the previous trial + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + + const cp_instructions_key = trialData["conjunctive_positive"]["cp_instructions_key"]; + + console.log(trial_data); + console.log(cp_instructions_key); + // if the participant's respone doesn't match the key, replay the instructions and comp checks + if (JSON.stringify(trial_data) === JSON.stringify(cp_instructions_key)) { + return false; + } else { + return true; + } + }, +} + + +const cp_loop_node_round_one_q1_long = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + cp_round_one_long, + cp_round_one_comp_q1_long, + ], + loop_function: function (data) { + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_participant_key = trialData["conjunctive_positive"]["cp_gameplay_q1_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(participant_response) === JSON.stringify(cp_participant_key))) { + return false; + } else { + return true; + } + }, +} + +const cp_conditional_node_round_one_q1_long = { + timeline: [ + cp_loop_node_round_one_q1_long + ], + conditional_function: function(){ + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_participant_key = trialData["conjunctive_positive"]["cp_gameplay_q1_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(participant_response) === JSON.stringify(cp_participant_key))) { + return true; + } else { + return false; + } + }, +} + +const cp_loop_node_round_one_q2_long = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + cp_round_one_long, + cp_round_one_comp_q2_long, + ], + loop_function: function (data) { + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_teammate_key = trialData["conjunctive_positive"]["cp_gameplay_q2_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(teammate_response) === JSON.stringify(cp_teammate_key))) { + return false; + } else { + return true; + } + }, +} + +const cp_conditional_node_round_one_q2_long = { + timeline: [ + cp_loop_node_round_one_q2_long + ], + conditional_function: function(){ + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_teammate_key = trialData["conjunctive_positive"]["cp_gameplay_q2_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(teammate_response) === JSON.stringify(cp_teammate_key))) { + return true; + } else { + return false; + } + }, +} + +const cp_intervention_task_long = { + type: jsPsychSurveyMultiChoice, + preamble: `
' + cp_arr_short[i] + '
' + cp_arr_short[i] + '
' + cp_arr_short[i] + '
Please review the instructions again.', + choices: ['Review'], + }, + cp_instructions_short, + cp_instructions_comp_short + ], + loop_function: function (data) { + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_instructions_key = trialData["conjunctive_positive"]["cp_instructions_key"]; + + if (JSON.stringify(trial_data) === JSON.stringify(cp_instructions_key)) { + return false; + } else { + return true; + } + }, +} + +const cp_conditional_node_instructions_short = { + timeline: [ + cp_loop_node_instructions_short + ], + conditional_function: function(){ + // get the data from the previous trial + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_instructions_key = trialData["conjunctive_positive"]["cp_instructions_key"]; + + // if the participant's respone doesn't match the key, replay the instructions and comp checks + if (JSON.stringify(trial_data) === JSON.stringify(cp_instructions_key)) { + return false; + } else { + return true; + } + }, +} + + +const cp_loop_node_round_one_q1_short = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + cp_round_one_short, + cp_round_one_comp_q1_short, + ], + loop_function: function (data) { + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_participant_key = trialData["conjunctive_positive"]["cp_gameplay_q1_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(participant_response) === JSON.stringify(cp_participant_key))) { + return false; + } else { + return true; + } + }, +} + +const cp_conditional_node_round_one_q1_short = { + timeline: [ + cp_loop_node_round_one_q1_short + ], + conditional_function: function(){ + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_participant_key = trialData["conjunctive_positive"]["cp_gameplay_q1_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(participant_response) === JSON.stringify(cp_participant_key))) { + return true; + } else { + return false; + } + }, +} + +const cp_loop_node_round_one_q2_short = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + cp_round_one_short, + cp_round_one_comp_q2_short, + ], + loop_function: function (data) { + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_teammate_key = trialData["conjunctive_positive"]["cp_gameplay_q2_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(teammate_response) === JSON.stringify(cp_teammate_key))) { + return false; + } else { + return true; + } + }, +} + +const cp_conditional_node_round_one_q2_short = { + timeline: [ + cp_loop_node_round_one_q2_short + ], + conditional_function: function(){ + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const cp_teammate_key = trialData["conjunctive_positive"]["cp_gameplay_q2_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(teammate_response) === JSON.stringify(cp_teammate_key))) { + return true; + } else { + return false; + } + }, +} + +const cp_intervention_task_short = { + type: jsPsychSurveyMultiChoice, + preamble: `
Consent Form
++ Description: + Welcome! You are invited to participate in a research study in cognitive psychology. + You will be asked to perform various tasks on a computer which may include: + looking at images or videos, listening to sounds, reading scenarios, or playing games. + You may be asked a number of different questions about making judgments and interpreting + people's actions. All information collected will remain confidential. +
++ Risks and benefits: + Risks involved in this study are the same as those normally associated + with using a computer (e.g., mild eye/arm strain). If you have any + pre-existing conditions that might make reading and completing a computer-based + survey strenuous for you, you should probably elect to not participate in this + study. If at any time during the study you feel unable to participate because + you are experiencing strain, you may end your participation without penalty. + We cannot and do not guarantee or promise that you will receive any benefits + from this study. Your decision whether or not to participate in this study will + not affect your employment, medical care, and/or grades in school. +
++ Time involvement: + Your involvement in this study should take about 10-15 minutes. +
++ Payment: + If recruitment materials indicate payment (e.g., Prolific or other recruitment), you + will receive compensation as indicated. +
+ Subject's rights: + If you have read this form and have decided to participate in this project, please + understand your participation is voluntary and you have the right to withdraw your + consent or discontinue participation at any time without penalty or loss of benefits + to which you are otherwise entitled. The alternative is not to participate. + You have the right to refuse to answer particular questions. Your individual privacy will + be maintained in all published and written data resulting from the study. No personally + identifying information is ever revealed to the researchers. + +
+ Contact information:
+ If you have any questions, concerns or complaints about this research study,
+ its procedures, or risks and benefits, you should ask the Protocol Director,
+ (Professor Tobias Gerstenberg, Phone: (650) 725-2431; Email: gerstenberg@stanford.edu).
+ If you are not satisfied with how this study is being conducted, or if you have any
+ concerns, complaints, or general questions about the research or your rights as a participant,
+ please contact the Stanford Institutional Review Board (IRB) to speak to someone independent of
+ the research team at (650) 723-2480 or toll free at 1-866-680-2906. You can also write to
+ the Stanford IRB, Stanford University, 1705 El Camino Real, Palo Alto, CA 94306 or contact
+ the IRB by email at irbnonmed@stanford.edu.
+
+
+ You may want to print a copy of this consent form to keep. By clicking the button below, + you acknowledge that you have read the above information, that you are 18 years of age, + or older and give your consent to participate in our internet-based study and consent for + us to analyze the resulting data. +
++ Do you agree with the terms of the experiment as explained above? +
+ `, + choices: ['I agree'], + on_start: function () { + jsPsych.setProgressBar(0); + } +}; \ No newline at end of file diff --git a/docs/experiment_1/js/demographics.js b/docs/experiment_1/js/demographics.js new file mode 100644 index 0000000..7f464c7 --- /dev/null +++ b/docs/experiment_1/js/demographics.js @@ -0,0 +1,61 @@ +const demographic_form = { + type: jsPsychSurveyHtmlForm, + data: { + "page_type": "participant_survey", + }, + html: 'Please press the finish button to complete the experiment.
' + dn_arr_long[i] + '
' + dn_arr_long[i] + '
' + dn_arr_long[i] + '
Please review the instructions again.', + choices: ['Review'], + }, + dn_instructions_long, + dn_instructions_comp_long + ], + loop_function: function (data) { + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_instructions_key = trialData["disjunctive_negative"]["dn_instructions_key"]; + + if (JSON.stringify(trial_data) === JSON.stringify(dn_instructions_key)) { + return false; + } else { + return true; + } + }, +} + +const dn_conditional_node_instructions_long = { + timeline: [ + dn_loop_node_instructions_long + ], + conditional_function: function(){ + // get the data from the previous trial + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + + const dn_instructions_key = trialData["disjunctive_negative"]["dn_instructions_key"]; + + // if the participant's respone doesn't match the key, replay the instructions and comp checks + if (JSON.stringify(trial_data) === JSON.stringify(dn_instructions_key)) { + return false; + } else { + return true; + } + }, +} + + +const dn_loop_node_round_one_q1_long = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + dn_round_one_long, + dn_round_one_comp_q1_long, + ], + loop_function: function (data) { + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_participant_key = trialData["disjunctive_negative"]["dn_gameplay_q1_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(participant_response) === JSON.stringify(dn_participant_key))) { + return false; + } else { + return true; + } + }, +} + +const dn_conditional_node_round_one_q1_long = { + timeline: [ + dn_loop_node_round_one_q1_long + ], + conditional_function: function(){ + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_participant_key = trialData["disjunctive_negative"]["dn_gameplay_q1_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(participant_response) === JSON.stringify(dn_participant_key))) { + return true; + } else { + return false; + } + }, +} + +const dn_loop_node_round_one_q2_long = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + dn_round_one_long, + dn_round_one_comp_q2_long, + ], + loop_function: function (data) { + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_teammate_key = trialData["disjunctive_negative"]["dn_gameplay_q2_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(teammate_response) === JSON.stringify(dn_teammate_key))) { + return false; + } else { + return true; + } + }, +} + +const dn_conditional_node_round_one_q2_long = { + timeline: [ + dn_loop_node_round_one_q2_long + ], + conditional_function: function(){ + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_teammate_key = trialData["disjunctive_negative"]["dn_gameplay_q2_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(teammate_response) === JSON.stringify(dn_teammate_key))) { + return true; + } else { + return false; + } + }, +} + +const dn_intervention_task_long = { + type: jsPsychSurveyMultiChoice, + preamble: `
' + dn_arr_short[i] + '
' + dn_arr_short[i] + '
' + dn_arr_short[i] + '
Please review the instructions again.', + choices: ['Review'], + }, + dn_instructions_short, + dn_instructions_comp_short + ], + loop_function: function (data) { + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_instructions_key = trialData["disjunctive_negative"]["dn_instructions_key"]; + + if (JSON.stringify(trial_data) === JSON.stringify(dn_instructions_key)) { + return false; + } else { + return true; + } + }, +} + +const dn_conditional_node_instructions_short = { + timeline: [ + dn_loop_node_instructions_short + ], + conditional_function: function(){ + // get the data from the previous trial + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_instructions_key = trialData["disjunctive_negative"]["dn_instructions_key"]; + + // if the participant's respone doesn't match the key, replay the instructions and comp checks + if (JSON.stringify(trial_data) === JSON.stringify(dn_instructions_key)) { + return false; + } else { + return true; + } + }, +} + + +const dn_loop_node_round_one_q1_short = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + dn_round_one_short, + dn_round_one_comp_q1_short, + ], + loop_function: function (data) { + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_participant_key = trialData["disjunctive_negative"]["dn_gameplay_q1_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(participant_response) === JSON.stringify(dn_participant_key))) { + return false; + } else { + return true; + } + }, +} + +const dn_conditional_node_round_one_q1_short = { + timeline: [ + dn_loop_node_round_one_q1_short + ], + conditional_function: function(){ + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_participant_key = trialData["disjunctive_negative"]["dn_gameplay_q1_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(participant_response) === JSON.stringify(dn_participant_key))) { + return true; + } else { + return false; + } + }, +} + +const dn_loop_node_round_one_q2_short = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + dn_round_one_short, + dn_round_one_comp_q2_short, + ], + loop_function: function (data) { + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_teammate_key = trialData["disjunctive_negative"]["dn_gameplay_q2_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(teammate_response) === JSON.stringify(dn_teammate_key))) { + return false; + } else { + return true; + } + }, +} + +const dn_conditional_node_round_one_q2_short = { + timeline: [ + dn_loop_node_round_one_q2_short + ], + conditional_function: function(){ + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dn_teammate_key = trialData["disjunctive_negative"]["dn_gameplay_q2_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(teammate_response) === JSON.stringify(dn_teammate_key))) { + return true; + } else { + return false; + } + }, +} + + +const dn_intervention_task_short = { + type: jsPsychSurveyMultiChoice, + preamble: `
' + dp_arr_long[i] + '
' + dp_arr_long[i] + '
' + dp_arr_long[i] + '
Please review the instructions again.', + choices: ['Review'], + }, + dp_instructions_long, + dp_instructions_comp_long + ], + loop_function: function (data) { + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_instructions_key = trialData["disjunctive_positive"]["dp_instructions_key"]; + + if (JSON.stringify(trial_data) === JSON.stringify(dp_instructions_key)) { + return false; + } else { + return true; + } + }, +} + +const dp_conditional_node_instructions_long = { + timeline: [ + dp_loop_node_instructions_long + ], + conditional_function: function(){ + // get the data from the previous trial + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + + const dp_instructions_key = trialData["disjunctive_positive"]["dp_instructions_key"]; + + // if the participant's respone doesn't match the key, replay the instructions and comp checks + if (JSON.stringify(trial_data) === JSON.stringify(dp_instructions_key)) { + return false; + } else { + return true; + } + }, +} + + +const dp_loop_node_round_one_q1_long = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + dp_round_one_long, + dp_round_one_comp_q1_long, + ], + loop_function: function (data) { + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_participant_key = trialData["disjunctive_positive"]["dp_gameplay_q1_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(participant_response) === JSON.stringify(dp_participant_key))) { + return false; + } else { + return true; + } + }, +} + +const dp_conditional_node_round_one_q1_long = { + timeline: [ + dp_loop_node_round_one_q1_long + ], + conditional_function: function(){ + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_participant_key = trialData["disjunctive_positive"]["dp_gameplay_q1_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(participant_response) === JSON.stringify(dp_participant_key))) { + return true; + } else { + return false; + } + }, +} + +const dp_loop_node_round_one_q2_long = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + dp_round_one_long, + dp_round_one_comp_q2_long, + ], + loop_function: function (data) { + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_teammate_key = trialData["disjunctive_positive"]["dp_gameplay_q2_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(teammate_response) === JSON.stringify(dp_teammate_key))) { + return false; + } else { + return true; + } + }, +} + +const dp_conditional_node_round_one_q2_long = { + timeline: [ + dp_loop_node_round_one_q2_long + ], + conditional_function: function(){ + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_teammate_key = trialData["disjunctive_positive"]["dp_gameplay_q2_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(teammate_response) === JSON.stringify(dp_teammate_key))) { + return true; + } else { + return false; + } + }, +} + +const dp_intervention_task_long = { + type: jsPsychSurveyMultiChoice, + preamble: `
' + dp_arr_short[i] + '
' + dp_arr_short[i] + '
' + dp_arr_short[i] + '
Please review the instructions again.', + choices: ['Review'], + }, + dp_instructions_short, + dp_instructions_comp_short + ], + loop_function: function (data) { + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_instructions_key = trialData["disjunctive_positive"]["dp_instructions_key"]; + + if (JSON.stringify(trial_data) === JSON.stringify(dp_instructions_key)) { + return false; + } else { + return true; + } + }, +} + +const dp_conditional_node_instructions_short = { + timeline: [ + dp_loop_node_instructions_short + ], + conditional_function: function(){ + // get the data from the previous trial + var trial_data = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_instructions_key = trialData["disjunctive_positive"]["dp_instructions_key"]; + + // if the participant's respone doesn't match the key, replay the instructions and comp checks + if (JSON.stringify(trial_data) === JSON.stringify(dp_instructions_key)) { + return false; + } else { + return true; + } + }, +} + + +const dp_loop_node_round_one_q1_short = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + dp_round_one_short, + dp_round_one_comp_q1_short, + ], + loop_function: function (data) { + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_participant_key = trialData["disjunctive_positive"]["dp_gameplay_q1_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(participant_response) === JSON.stringify(dp_participant_key))) { + return false; + } else { + return true; + } + }, +} + +const dp_conditional_node_round_one_q1_short = { + timeline: [ + dp_loop_node_round_one_q1_short + ], + conditional_function: function(){ + const participant_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_participant_key = trialData["disjunctive_positive"]["dp_gameplay_q1_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(participant_response) === JSON.stringify(dp_participant_key))) { + return true; + } else { + return false; + } + }, +} + +const dp_loop_node_round_one_q2_short = { + timeline: [ + { + type: jsPsychHtmlButtonResponse, + stimulus: 'Unfortunately, you missed some of the comprehension ' + + 'questions.
Please review the instructions again.', + choices: ['Review'], + }, + dp_round_one_short, + dp_round_one_comp_q2_short, + ], + loop_function: function (data) { + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_teammate_key = trialData["disjunctive_positive"]["dp_gameplay_q2_key"]; + + // if participant and teammate responses match the key, return false, do not loop + if (!!(JSON.stringify(teammate_response) === JSON.stringify(dp_teammate_key))) { + return false; + } else { + return true; + } + }, +} + +const dp_conditional_node_round_one_q2_short = { + timeline: [ + dp_loop_node_round_one_q2_short + ], + conditional_function: function(){ + const teammate_response = jsPsych.data.getLastTrialData().filter({ trial_type: 'survey-multi-choice' }).trials[0]["response"]; + const dp_teammate_key = trialData["disjunctive_positive"]["dp_gameplay_q2_key"]; + + // if participant and teammate responses DO NOT match the key, return true to run the loop node + if (!(JSON.stringify(teammate_response) === JSON.stringify(dp_teammate_key))) { + return true; + } else { + return false; + } + }, +} + +const dp_intervention_task_short = { + type: jsPsychSurveyMultiChoice, + preamble: `
' + + 'What factors influenced how you decided to respond? Do you' + + ' have any questions or comments regarding the experiment?' + + // feedback box + '
Please provide the following' + + ' information to complete the study.
Please press the finish button to complete the experiment.