- 6.5.1 Bayesian Linear Mixed Model
- 6.5.2 Test Hypotheses @@ -511,14 +519,16 @@
- 4.4.1 Property Means by Condition
- 4.4.2 Plot of Actual Property Ratings vs Expected Property Ratings -
- 4.4.3 Expected Property Selections for Each Property Type on Catgeorization Rating -
- 4.4.4 Bayesian Linear Mixed Model -
- 4.4.5 Test Hypotheses +
- 4.4.3 Catgeorization Ratings for Each Individual Property
- 4.5 LLM Diagnosticity +
- 4.5 Stats +
- 4.6 LLM Diagnosticity + @@ -479,7 +487,7 @@
- 5.4.1 Property Means by Condition
- 5.4.2 Plot of Actual Property Ratings vs Expected Property Ratings -
- 5.5 Stats +
- 5.5 Stats -
- 6.5 Stats +
- 6.5 Stats
- 6.5.1 Bayesian Linear Mixed Model
- 6.5.2 Test Hypotheses @@ -509,12 +517,18 @@
May 06, 2024
1 Load packages
+library("png") # for reading in png files +library("grid") # for arranging plots +library("ggtext") # for formatting ggplot2 text +library("emmeans") # for comparing models +library("knitr") # for knitting +library("RSQLite") # for reading in participants.db file +library("tidyjson") # for reading in json data +library("entropy") # for computing entropy +library("brms") # for Bayesian data analysis +library("janitor") # for cleaning variable names +library("corrr") # for correlations +library("tidyverse") # for everything elselibrary("xtable") # for saving tables -library("emmeans") # for comparing models -library("knitr") # for knitting -library("RSQLite") # for reading in participants.db file -library("tidyjson") # for reading in json data -library("brms") # for Bayesian data analysis -library("tidyverse") # for everything else
1 Load packages
library("xtable") # for saving tables
library("png") # for reading in png files
library("grid") # for arranging plots
-remotes::install_github("wilkelab/ggtext")
-library("ggtext") # for formatting ggplot2 text
-library("emmeans") # for comparing models
-library("knitr") # for knitting
-library("RSQLite") # for reading in participants.db file
-library("tidyjson") # for reading in json data
+library("ggtext") # for formatting ggplot2 text
+library("emmeans") # for comparing models
+library("knitr") # for knitting
+library("RSQLite") # for reading in participants.db file
+library("tidyjson") # for reading in json data
+library("entropy") # for computing entropy
library("brms") # for Bayesian data analysis
-library("tidyverse") # for everything else 2 Global options
@@ -871,7 +881,7 @@4.4.1 Property Means by Condition theme(axis.text.x = element_markdown()) ggsave(width = 8, height = 5, "../../figures/experiment2/exp2_property_by_condition_means.pdf")
4.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
@@ -925,8 +935,8 @@4.4.2 Plot of Actual Property Rat width = 8)
-
4.4.3 Expected Property Selections for Each Property Type on Catgeorization Rating
+
+
-
-4.4.3 Catgeorization Ratings for Each Individual Property
# property categorization and categorization judgment dataframe
df.exp2.property_categorization = df.exp2 %>%
mutate(participant = rep(1:100, each = 2)) %>%
@@ -976,11 +986,11 @@ 4.4.3 Expected Property Selection
df.exp2.purpose,
df.exp2.social)
-df.plot = df.exp2.property_categorization %>%
+df.each_property = df.exp2.property_categorization %>%
filter(categorization == "behavioral" & property_selected %in% c("jump", "chew", "swim", "run") | categorization == "biological" & property_selected %in% c("have hair", "have long legs", "are warm blooded", "have pointy ears") | categorization == "purpose" & property_selected %in% c("purify water", "aerate soil", "enable decomposition", "make honey") | categorization == "social" & property_selected %in% c("pair bond", "share food with group members", "follow the dominant group member", "cooperate with group members"))
#give short labels to properties for plotting
-df.plot = df.plot %>%
+df.each_property = df.each_property %>%
mutate(property_selected = str_replace_all(property_selected, "are warm blooded", "blood"),
property_selected = str_replace_all(property_selected, "have hair", "hair"),
property_selected = str_replace_all(property_selected, "have pointy ears", "ears"),
@@ -995,12 +1005,12 @@ 4.4.3 Expected Property Selection
property_selected = str_replace_all(property_selected, "pair bond", "bond"))
# rename property types
-df.plot = df.plot %>%
+df.each_property = df.each_property %>%
mutate(property_changed = str_replace_all(property_changed, "behavioral", "behavior"),
property_changed = str_replace_all(property_changed, "biological", "biology"))
-ggplot(data = df.plot,
+ggplot(data = df.each_property,
mapping = aes(x = property_selected,
y = response,
group = property_changed,
@@ -1041,11 +1051,13 @@ 4.4.3 Expected Property Selection
scales = "free")
ggsave(width = 10, height = 6, "../../figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf")
-## Stats
-
+4.4.4 Bayesian Linear Mixed Model
+
+
4.5 Stats
+
+
-
4.5.1 Bayesian Linear Mixed Model
fit.brm1 = brm(formula = response ~ 1 + property*condition + (1 | participant),
data = df.exp2.long,
seed = 1,
@@ -1092,8 +1104,8 @@ 4.4.4 Bayesian Linear Mixed Model
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
-
-4.4.5 Test Hypotheses
+
-
4.5 LLM Diagnosticity
-
-
4.5.1 Read in the data
+
+
4.6 LLM Diagnosticity
+
+
-4.6.1 Read in the data
#> Rows: 80 Columns: 6
#> ── Column specification ────────────────────────────────────────────────────────
@@ -1169,8 +1181,8 @@ 4.5.1 Read in the data
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
-
4.5.2 Wrangle
+
+
-4.6.2 Wrangle
-4.5.3.1 Overall Property Means by
4.5.3 Plots
-
-
-
@@ -1216,46 +1319,46 @@ 4.5.3.1 Overall Property Means by Model
-ggplot(data = df.llm,
- mapping = aes(x = category,
- y = probability,
- group = category,
- color = category,
- fill = category)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.2) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- # scale_y_continuous(breaks = 1:7) +
- theme(plot.title = element_text(size=16, hjust = .5),
- axis.text.x = element_blank(),
- legend.title = element_blank(),
- legend.position="bottom",
- axis.title.x = element_blank(),
- text = element_text(size = 18)) +
- facet_wrap(~ model)
-
-ggsave(width = 8, height = 3, "../../figures/experiment2/bert_overall_probabilities.pdf")
+
+4.6.3 Stats
+
+
+
+4.6.3.1 Correlate participant ratings for individual properties with LLM completions
+df.each_property.means = df.each_property %>%
+ select(property_selected, categorization, response) %>%
+ rename(property = property_selected, category = categorization) %>% mutate(category = str_replace_all(category, "behavioral", "behavior"),
+ category = str_replace_all(category, "biological", "biology")) %>%
+
+ group_by(category, property) %>%
+ summarise(mean = mean(response, na.rm = TRUE))
+
+df.llm2 = df.llm %>%
+ #give short labels to properties
+ mutate(property = str_replace_all(property, "warm blooded", "blood"),
+ property = str_replace_all(property, "pointy ears", "ears"),
+ property = str_replace_all(property, "long legs", "legs"),
+ property = str_replace_all(property, "enables decomposition", "decompose"),
+ property = str_replace_all(property, "purifies water", "purify"),
+ property = str_replace_all(property, "makes honey", "honey"),
+ property = str_replace_all(property, "aerates soil", "aerate"),
+ property = str_replace_all(property, "share food with group members", "share"),
+ property = str_replace_all(property, "cooperates with group members", "cooperate"),
+ property = str_replace_all(property, "follow dominant group member", "follow"),
+ property = str_replace_all(property, "pair bond", "bond")) %>%
+ group_by(category, property, model) %>%
+ summarise(entropy_value = entropy(probability)) %>%
+ pivot_wider(names_from = model,
+ values_from = entropy_value)
+
+df.each_property.means %>%
+ left_join(df.llm2, by = c("category", "property")) %>%
+ ungroup() %>%
+ clean_names() %>%
+ select(-c(category, property)) %>%
+ correlate() %>%
+ shave() %>%
+ fashion()#> Correlation computed with
+#> • Method: 'pearson'
+#> • Missing treated using: 'pairwise.complete.obs'#> term mean bert_base bert_large ro_ber_ta_large
+#> 1 mean
+#> 2 bert_base -.51
+#> 3 bert_large -.69 .67
+#> 4 ro_ber_ta_large -.14 .51 .40
+
+
+4.6.3.2 Linear mixed effects model with diagnosticity and property type
+df.regression = df.each_property %>%
+ left_join(df.llm2,
+ by = c("property_selected" = "property",
+ "property_changed" = "category")) %>%
+ clean_names() %>%
+ mutate(property_changed = factor(property_changed,
+ levels = c("behavior", "biology", "purpose", "social")),
+ property_purpose = ifelse(property_changed == "purpose", 1, 0))
+
+fit.brm_property_diagnosticity = brm(formula = response ~ 1 + property_changed + bert_large + (1 | participant),
+ data = df.regression,
+ seed = 1,
+ file = "cache/brm_property_diagnosticity")
+
+fit.brm_property_diagnosticity #> Family: gaussian
+#> Links: mu = identity; sigma = identity
+#> Formula: response ~ 1 + property_purpose + bert_large + (1 | participant)
+#> Data: df.regression (Number of observations: 1500)
+#> Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
+#> total post-warmup draws = 4000
+#>
+#> Multilevel Hyperparameters:
+#> ~participant (Number of levels: 100)
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> sd(Intercept) 0.91 0.07 0.77 1.06 1.00 958 1434
+#>
+#> Regression Coefficients:
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> Intercept 3.05 0.27 2.53 3.60 1.00 1820 2347
+#> property_purpose 0.69 0.10 0.50 0.88 1.00 3628 3045
+#> bert_large -0.18 0.17 -0.53 0.15 1.00 3308 2693
+#>
+#> Further Distributional Parameters:
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> sigma 1.17 0.02 1.13 1.22 1.00 6094 2976
+#>
+#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
+#> and Tail_ESS are effective sample size measures, and Rhat is the potential
+#> scale reduction factor on split chains (at convergence, Rhat = 1).
+
4.6.4 Plots
+
+
+
4.6.4.1 Top 5 probabilites for each property by model
+ggplot(data = df.llm,
+ mapping = aes(x = category,
+ y = probability,
+ group = category,
+ color = category,
+ fill = category)) +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.7,
+ jitter.height = 0.06),
+ alpha = 0.9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(limits = c(0, 1) ) +
+ theme(plot.title = element_text(size=16, hjust = .5),
+ axis.text.x = element_blank(),
+ legend.title = element_blank(),
+ legend.position="bottom",
+ axis.title.x = element_blank(),
+ text = element_text(size = 18)) +
+ facet_wrap(~model)
+
+ggsave(width = 8, height = 3, "../../figures/experiment2/bert_overall_probabilities.pdf")
4.5.3.1 Overall Property Means by
5 EXPERIMENT 3 (Induction)
5.1 Read in the data
-
+
5.2 Wrangle
-# catgeorization judgment dataframe
-df.exp3.long = df.exp3 %>%
- rename(condition = expCondition) %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- select(participant, comprehension_check, condition, response_behavioral: response_social) %>%
- pivot_longer(cols = response_behavioral:response_social,
- names_to = "property",
- values_to = "response") %>%
- mutate(property = str_remove_all(property, "response_"),
- property = str_replace_all(property, "behavioral", "behavior"),
- property = str_replace_all(property, "biological", "biology"),
- response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
- condition = recode(condition, "non_generic" = "specific"),
- study = rep("induction"))
+# catgeorization judgment dataframe
+df.exp3.long = df.exp3 %>%
+ rename(condition = expCondition) %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ select(participant, comprehension_check, condition, response_behavioral: response_social) %>%
+ pivot_longer(cols = response_behavioral:response_social,
+ names_to = "property",
+ values_to = "response") %>%
+ mutate(property = str_remove_all(property, "response_"),
+ property = str_replace_all(property, "behavioral", "behavior"),
+ property = str_replace_all(property, "biological", "biology"),
+ response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
+ condition = recode(condition, "non_generic" = "specific"),
+ study = rep("induction"))
5.3 Demographics
-# read in demographic data
-
-df.exp3.demographics = read_csv("../../data/experiment3/experiment3_demographics.csv")
-
-df.exp3.demographics %>%
- summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
+# read in demographic data
+
+df.exp3.demographics = read_csv("../../data/experiment3/experiment3_demographics.csv")
+
+df.exp3.demographics %>%
+ summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 34.4
-
+
#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 14.0
-
+
#> # A tibble: 5 × 2
#> # Groups: gender [5]
#> gender n
@@ -1265,9 +1368,9 @@ 5.3 Demographics
#> 3 Non-binary 3
#> 4 other_gender 1
#> 5 <NA> 1
-
+
#> # A tibble: 5 × 2
#> # Groups: race [5]
#> race n
@@ -1277,9 +1380,9 @@ 5.3 Demographics
#> 3 White 62
#> 4 other_race 2
#> 5 <NA> 3
-
+
#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
@@ -1292,121 +1395,121 @@ 5.3 Demographics
5.4 Plots
5.4.1 Property Means by Condition
-ggplot(data = df.exp3.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_hline(yintercept = 4, linetype = "dashed") +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.15,
- jitter.height = 0.1),
- alpha = 0.2) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.55),
- color = "black",
- size = .9) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- ggtitle("What is this creature?") +
- xlab("Property type that \n\ differed") +
- theme(plot.title = element_text(size=24, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank(),
- axis.text.x = element_text(size=16),
- axis.title.y = element_text(size=18),
- axis.text.y = element_text(size=14),
- legend.text = element_text(size=16)) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50"))) +
- coord_flip() +
- annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
- expand_limits(x = c(-Inf, 5.3)) +
-scale_y_continuous(breaks = 1:7,
- labels = c(
- "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
- "2" = "2",
- "3" = "3",
- "4" = "unsure",
- "5" = "5",
- "6" = "6",
- "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
- )) +
- theme(axis.text.x = element_markdown())
-
-ggsave(width = 8, height = 5, "../../figures/experiment3/exp3_property_by_condition_means.pdf")
-
+ggplot(data = df.exp3.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment3/exp3_property_by_condition_means.pdf")
+
5.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
-# create dataframe to get proportion of properties that were categorized as expected
-df.plot = df.exp3 %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- rename(condition = expCondition) %>%
- relocate(participant) %>%
- select(-c("item_0", "item_1", "error")) %>%
- pivot_longer(starts_with("item"),
- names_to = "tmp",
- values_to = "value") %>%
- separate(col = tmp,
- into = c("placeholder_a", "thing", "rank", "placeholder_b"),
- sep = "_") %>%
- group_by(rank) %>%
- mutate(row = row_number()) %>%
- pivot_wider(names_from = rank,
- values_from = value) %>%
- select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
- mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
- rename(item = property,
- response = categorization) %>%
- mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
- expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
- item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
- item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
- item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
- group_by(expected, response, item) %>%
- count(.drop = F) %>%
- mutate(proportion = n/100) %>%
- mutate(response = str_replace_all(response, "behavioral", "behavior"),
- response = str_replace_all(response, "biological", "biology")) %>%
- ungroup() %>%
- add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
-
-ggplot(data = df.plot) +
- geom_tile(aes(x = expected,
- y = response,
- fill = proportion,
- group = proportion),
- color = "black") +
-scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
- theme(legend.title = element_blank(),
- text = element_text(size = 20)) +
- xlab("Expected Categorization") +
- ylab("Actual Categorization")
-
-ggsave(filename = "../../figures/experiment3/exp3_heat_map.pdf",
- height = 5,
- width = 8)
+# create dataframe to get proportion of properties that were categorized as expected
+df.plot = df.exp3 %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ rename(condition = expCondition) %>%
+ relocate(participant) %>%
+ select(-c("item_0", "item_1", "error")) %>%
+ pivot_longer(starts_with("item"),
+ names_to = "tmp",
+ values_to = "value") %>%
+ separate(col = tmp,
+ into = c("placeholder_a", "thing", "rank", "placeholder_b"),
+ sep = "_") %>%
+ group_by(rank) %>%
+ mutate(row = row_number()) %>%
+ pivot_wider(names_from = rank,
+ values_from = value) %>%
+ select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
+ mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
+ rename(item = property,
+ response = categorization) %>%
+ mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
+ expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
+ item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
+ item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
+ item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
+ group_by(expected, response, item) %>%
+ count(.drop = F) %>%
+ mutate(proportion = n/100) %>%
+ mutate(response = str_replace_all(response, "behavioral", "behavior"),
+ response = str_replace_all(response, "biological", "biology")) %>%
+ ungroup() %>%
+ add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
+
+ggplot(data = df.plot) +
+ geom_tile(aes(x = expected,
+ y = response,
+ fill = proportion,
+ group = proportion),
+ color = "black") +
+scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
+ theme(legend.title = element_blank(),
+ text = element_text(size = 20)) +
+ xlab("Expected Categorization") +
+ ylab("Actual Categorization")
+
+ggsave(filename = "../../figures/experiment3/exp3_heat_map.pdf",
+ height = 5,
+ width = 8)
-
+
5.5 Stats
5.5.1 Bayesian Linear Mixed Model
-fit.brm2 = brm(formula = response ~ 1 + property*condition + (1 | participant),
- data = df.exp3.long,
- seed = 1,
- file = "cache/brm2")
-
-fit.brm2
+fit.brm2 = brm(formula = response ~ 1 + property*condition + (1 | participant),
+ data = df.exp3.long,
+ seed = 1,
+ file = "cache/brm2")
+
+fit.brm2
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
@@ -1449,8 +1552,8 @@ 5.5.1 Bayesian Linear Mixed Model
5.5.2 Test Hypotheses
-
+
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
@@ -1497,46 +1600,46 @@ 5.5.2 Test Hypotheses
6 EXPERIMENT 4 (Offspring)
6.1 Read in the data
-
+
6.2 Wrangle
-# catgeorization judgment dataframe
-df.exp4.long = df.exp4 %>%
- rename(condition = expCondition) %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- select(participant, comprehension_check, condition, offspring_behavioral: offspring_social) %>%
- pivot_longer(cols = offspring_behavioral:offspring_social,
- names_to = "property",
- values_to = "response") %>%
- mutate(property = str_remove_all(property, "offspring_"),
- property = str_replace_all(property, "behavioral", "behavior"),
- property = str_replace_all(property, "biological", "biology"),
- response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
- condition = recode(condition, "non_generic" = "specific"),
- study = rep("offspring"))
+# catgeorization judgment dataframe
+df.exp4.long = df.exp4 %>%
+ rename(condition = expCondition) %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ select(participant, comprehension_check, condition, offspring_behavioral: offspring_social) %>%
+ pivot_longer(cols = offspring_behavioral:offspring_social,
+ names_to = "property",
+ values_to = "response") %>%
+ mutate(property = str_remove_all(property, "offspring_"),
+ property = str_replace_all(property, "behavioral", "behavior"),
+ property = str_replace_all(property, "biological", "biology"),
+ response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
+ condition = recode(condition, "non_generic" = "specific"),
+ study = rep("offspring"))
6.3 Demographics
-# read in demographic data
-
-df.exp4.demographics = read_csv("../../data/experiment4/experiment4_demographics.csv")
-
-df.exp4.demographics %>%
- summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
+# read in demographic data
+
+df.exp4.demographics = read_csv("../../data/experiment4/experiment4_demographics.csv")
+
+df.exp4.demographics %>%
+ summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 33.9
-
+
#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 12.7
-
+
#> # A tibble: 4 × 2
#> # Groups: gender [4]
#> gender n
@@ -1545,9 +1648,9 @@ 6.3 Demographics
#> 2 Male 36
#> 3 Non-binary 1
#> 4 <NA> 2
-
+
#> # A tibble: 6 × 2
#> # Groups: race [6]
#> race n
@@ -1558,9 +1661,9 @@ 6.3 Demographics
#> 4 Native Hawaiian/Pacific Islander 2
#> 5 White 74
#> 6 other_race 5
-
+
#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
@@ -1573,121 +1676,121 @@ 6.3 Demographics
6.4 Plots
6.4.1 Property Means by Condition
-ggplot(data = df.exp4.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_hline(yintercept = 4, linetype = "dashed") +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.15,
- jitter.height = 0.1),
- alpha = 0.2) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.55),
- color = "black",
- size = .9) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- ggtitle("What is this creature?") +
- xlab("Property type that \n\ differed") +
- theme(plot.title = element_text(size=24, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank(),
- axis.text.x = element_text(size=16),
- axis.title.y = element_text(size=18),
- axis.text.y = element_text(size=14),
- legend.text = element_text(size=16)) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50"))) +
- coord_flip() +
- annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
- expand_limits(x = c(-Inf, 5.3)) +
-scale_y_continuous(breaks = 1:7,
- labels = c(
- "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
- "2" = "2",
- "3" = "3",
- "4" = "unsure",
- "5" = "5",
- "6" = "6",
- "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
- )) +
- theme(axis.text.x = element_markdown())
-
-ggsave(width = 8, height = 5, "../../figures/experiment4/exp4_property_by_condition_means.pdf")
-
+ggplot(data = df.exp4.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment4/exp4_property_by_condition_means.pdf")
+
6.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
-# create dataframe to get proportion of properties that were categorized as expected
-df.plot = df.exp4 %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- rename(condition = expCondition) %>%
- relocate(participant) %>%
- select(-c("item_0", "item_1", "error")) %>%
- pivot_longer(starts_with("item"),
- names_to = "tmp",
- values_to = "value") %>%
- separate(col = tmp,
- into = c("placeholder_a", "thing", "rank", "placeholder_b"),
- sep = "_") %>%
- group_by(rank) %>%
- mutate(row = row_number()) %>%
- pivot_wider(names_from = rank,
- values_from = value) %>%
- select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
- mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
- rename(item = property,
- response = categorization) %>%
- mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
- expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
- item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
- item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
- item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
- group_by(expected, response, item) %>%
- count(.drop = F) %>%
- mutate(proportion = n/100) %>%
- mutate(response = str_replace_all(response, "behavioral", "behavior"),
- response = str_replace_all(response, "biological", "biology")) %>%
- ungroup() %>%
- add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
-
-ggplot(data = df.plot) +
- geom_tile(aes(x = expected,
- y = response,
- fill = proportion,
- group = proportion),
- color = "black") +
-scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
- theme(legend.title = element_blank(),
- text = element_text(size = 20)) +
- xlab("Expected Categorization") +
- ylab("Actual Categorization")
-
-ggsave(filename = "../../figures/experiment4/exp4_heat_map.pdf",
- height = 5,
- width = 8)
+# create dataframe to get proportion of properties that were categorized as expected
+df.plot = df.exp4 %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ rename(condition = expCondition) %>%
+ relocate(participant) %>%
+ select(-c("item_0", "item_1", "error")) %>%
+ pivot_longer(starts_with("item"),
+ names_to = "tmp",
+ values_to = "value") %>%
+ separate(col = tmp,
+ into = c("placeholder_a", "thing", "rank", "placeholder_b"),
+ sep = "_") %>%
+ group_by(rank) %>%
+ mutate(row = row_number()) %>%
+ pivot_wider(names_from = rank,
+ values_from = value) %>%
+ select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
+ mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
+ rename(item = property,
+ response = categorization) %>%
+ mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
+ expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
+ item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
+ item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
+ item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
+ group_by(expected, response, item) %>%
+ count(.drop = F) %>%
+ mutate(proportion = n/100) %>%
+ mutate(response = str_replace_all(response, "behavioral", "behavior"),
+ response = str_replace_all(response, "biological", "biology")) %>%
+ ungroup() %>%
+ add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
+
+ggplot(data = df.plot) +
+ geom_tile(aes(x = expected,
+ y = response,
+ fill = proportion,
+ group = proportion),
+ color = "black") +
+scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
+ theme(legend.title = element_blank(),
+ text = element_text(size = 20)) +
+ xlab("Expected Categorization") +
+ ylab("Actual Categorization")
+
+ggsave(filename = "../../figures/experiment4/exp4_heat_map.pdf",
+ height = 5,
+ width = 8)
-
+
6.5 Stats
6.5.1 Bayesian Linear Mixed Model
-fit.brm3 = brm(formula = response ~ 1 + property*condition + (1 | participant),
- data = df.exp4.long,
- seed = 1,
- file = "cache/brm3")
-
-fit.brm3
+fit.brm3 = brm(formula = response ~ 1 + property*condition + (1 | participant),
+ data = df.exp4.long,
+ seed = 1,
+ file = "cache/brm3")
+
+fit.brm3
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
@@ -1730,8 +1833,8 @@ 6.5.1 Bayesian Linear Mixed Model
6.5.2 Test Hypotheses
-
+
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
@@ -1774,8 +1877,8 @@ 6.5.2 Test Hypotheses
6.5.3 Effect of statememt type
-
+
#> $emmeans
#> property = behavior:
#> condition emmean lower.HPD upper.HPD
@@ -1845,13 +1948,14 @@ 7 Session info
#> other attached packages:
#> [1] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4
#> [5] purrr_1.0.2 readr_2.1.5 tidyr_1.3.1 tibble_3.2.1
-#> [9] ggplot2_3.5.1 tidyverse_2.0.0 brms_2.21.0 Rcpp_1.0.12
-#> [13] tidyjson_0.3.2 RSQLite_2.3.6 knitr_1.45 emmeans_1.10.1
-#> [17] ggtext_0.1.2 png_0.1-8 xtable_1.8-4
+#> [9] ggplot2_3.5.1 tidyverse_2.0.0 corrr_0.4.4 janitor_2.2.0
+#> [13] brms_2.21.0 Rcpp_1.0.12 entropy_1.3.1 tidyjson_0.3.2
+#> [17] RSQLite_2.3.6 knitr_1.45 emmeans_1.10.1 ggtext_0.1.2
+#> [21] png_0.1-8 xtable_1.8-4
#>
#> loaded via a namespace (and not attached):
-#> [1] DBI_1.2.2 gridExtra_2.3 remotes_2.5.0
-#> [4] inline_0.3.19 rlang_1.1.3 magrittr_2.0.3
+#> [1] DBI_1.2.2 gridExtra_2.3 inline_0.3.19
+#> [4] rlang_1.1.3 magrittr_2.0.3 snakecase_0.11.1
#> [7] matrixStats_1.2.0 compiler_4.3.3 loo_2.7.0
#> [10] reshape2_1.4.4 systemfonts_1.0.6 vctrs_0.6.5
#> [13] pkgconfig_2.0.3 crayon_1.5.2 fastmap_1.1.1
diff --git a/docs/index.html b/docs/index.html
index 89e6ae3..1573033 100644
--- a/docs/index.html
+++ b/docs/index.html
@@ -9,9 +9,9 @@
-
+
-
+
Teleological Properties
@@ -427,8 +427,8 @@
Teleological Properties
-David Rose, Siying Zhang, Qi Han & Tobias Gerstenberg
-May 06, 2024
+David Rose, Siying Zhang & Tobias Gerstenberg
+August 06, 2024
@@ -455,17 +455,25 @@ May 06, 2024
-May 06, 2024
2 Global options
@@ -810,36 +824,64 @@ 4.3 Demographics
4.4 Plots
4.4.1 Property Means by Condition
-ggplot(data = df.exp2.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.05) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.5),
- color = "black",
- size = .5) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- theme(plot.title = element_text(size=16, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank()) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50")))
-
-ggsave(width = 5, height = 3, "../../figures/experiment2/exp2_property_by_condition_means.pdf")
-
+# Read the image file
+midpoint_creature = readPNG("../../figures/plot_additions/midpoint_creature.png")
+
+
+# Create a raster object from the image
+raster_midpoint_creature = rasterGrob(midpoint_creature, interpolate=TRUE)
+
+ggplot(data = df.exp2.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment2/exp2_property_by_condition_means.pdf")
+
4.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
@@ -893,8 +935,8 @@ 4.4.2 Plot of Actual Property Rat
width = 8)
-
-4.4.3 Expected Property Selections for Each Property Type on Catgeorization Rating
+
+4.4.3 Catgeorization Ratings for Each Individual Property
# property categorization and categorization judgment dataframe
df.exp2.property_categorization = df.exp2 %>%
mutate(participant = rep(1:100, each = 2)) %>%
@@ -944,11 +986,11 @@ 4.4.3 Expected Property Selection
df.exp2.purpose,
df.exp2.social)
-df.plot = df.exp2.property_categorization %>%
+df.each_property = df.exp2.property_categorization %>%
filter(categorization == "behavioral" & property_selected %in% c("jump", "chew", "swim", "run") | categorization == "biological" & property_selected %in% c("have hair", "have long legs", "are warm blooded", "have pointy ears") | categorization == "purpose" & property_selected %in% c("purify water", "aerate soil", "enable decomposition", "make honey") | categorization == "social" & property_selected %in% c("pair bond", "share food with group members", "follow the dominant group member", "cooperate with group members"))
#give short labels to properties for plotting
-df.plot = df.plot %>%
+df.each_property = df.each_property %>%
mutate(property_selected = str_replace_all(property_selected, "are warm blooded", "blood"),
property_selected = str_replace_all(property_selected, "have hair", "hair"),
property_selected = str_replace_all(property_selected, "have pointy ears", "ears"),
@@ -963,12 +1005,12 @@ 4.4.3 Expected Property Selection
property_selected = str_replace_all(property_selected, "pair bond", "bond"))
# rename property types
-df.plot = df.plot %>%
+df.each_property = df.each_property %>%
mutate(property_changed = str_replace_all(property_changed, "behavioral", "behavior"),
property_changed = str_replace_all(property_changed, "biological", "biology"))
-ggplot(data = df.plot,
+ggplot(data = df.each_property,
mapping = aes(x = property_selected,
y = response,
group = property_changed,
@@ -1009,11 +1051,13 @@ 4.4.3 Expected Property Selection
scales = "free")
ggsave(width = 10, height = 6, "../../figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf")
-
-## Stats
+
-
-4.4.4 Bayesian Linear Mixed Model
+
+
+4.5 Stats
+
+4.5.1 Bayesian Linear Mixed Model
fit.brm1 = brm(formula = response ~ 1 + property*condition + (1 | participant),
data = df.exp2.long,
seed = 1,
@@ -1060,8 +1104,8 @@ 4.4.4 Bayesian Linear Mixed Model
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
-
-4.4.5 Test Hypotheses
+
-
-4.5 LLM Diagnosticity
-
-4.5.1 Read in the data
+
+4.6 LLM Diagnosticity
+
+4.6.1 Read in the data
#> Rows: 80 Columns: 6
#> ── Column specification ────────────────────────────────────────────────────────
@@ -1137,8 +1181,8 @@ 4.5.1 Read in the data
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
-
-4.5.2 Wrangle
+
+4.6.2 Wrangle
-
-4.5.3 Plots
-
-4.5.3.1 Overall Property Means by Model
-ggplot(data = df.llm,
- mapping = aes(x = category,
- y = probability,
- group = category,
- color = category,
- fill = category)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.2) +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.5),
- shape = 21,
- color = "black",
- size = .5) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- # scale_y_continuous(breaks = 1:7) +
- theme(plot.title = element_text(size=16, hjust = .5),
- axis.text.x = element_blank(),
- legend.title = element_blank(),
- legend.position="bottom",
- axis.title.x = element_blank(),
- text = element_text(size = 18)) +
- facet_wrap(~ model)
+
+4.6.3 Stats
+
+4.6.3.1 Correlate participant ratings for individual properties with LLM completions
+df.each_property.means = df.each_property %>%
+ select(property_selected, categorization, response) %>%
+ rename(property = property_selected, category = categorization) %>% mutate(category = str_replace_all(category, "behavioral", "behavior"),
+ category = str_replace_all(category, "biological", "biology")) %>%
+
+ group_by(category, property) %>%
+ summarise(mean = mean(response, na.rm = TRUE))
+
+df.llm2 = df.llm %>%
+ #give short labels to properties
+ mutate(property = str_replace_all(property, "warm blooded", "blood"),
+ property = str_replace_all(property, "pointy ears", "ears"),
+ property = str_replace_all(property, "long legs", "legs"),
+ property = str_replace_all(property, "enables decomposition", "decompose"),
+ property = str_replace_all(property, "purifies water", "purify"),
+ property = str_replace_all(property, "makes honey", "honey"),
+ property = str_replace_all(property, "aerates soil", "aerate"),
+ property = str_replace_all(property, "share food with group members", "share"),
+ property = str_replace_all(property, "cooperates with group members", "cooperate"),
+ property = str_replace_all(property, "follow dominant group member", "follow"),
+ property = str_replace_all(property, "pair bond", "bond")) %>%
+ group_by(category, property, model) %>%
+ summarise(entropy_value = entropy(probability)) %>%
+ pivot_wider(names_from = model,
+ values_from = entropy_value)
-ggsave(width = 8, height = 3, "../../figures/experiment2/bert_overall_property_means.pdf")
-
+df.each_property.means %>%
+ left_join(df.llm2, by = c("category", "property")) %>%
+ ungroup() %>%
+ clean_names() %>%
+ select(-c(category, property)) %>%
+ correlate() %>%
+ shave() %>%
+ fashion()
+#> Correlation computed with
+#> • Method: 'pearson'
+#> • Missing treated using: 'pairwise.complete.obs'
+#> term mean bert_base bert_large ro_ber_ta_large
+#> 1 mean
+#> 2 bert_base -.51
+#> 3 bert_large -.69 .67
+#> 4 ro_ber_ta_large -.14 .51 .40
+
+
+4.6.3.2 Linear mixed effects model with diagnosticity and property type
+df.regression = df.each_property %>%
+ left_join(df.llm2,
+ by = c("property_selected" = "property",
+ "property_changed" = "category")) %>%
+ clean_names() %>%
+ mutate(property_changed = factor(property_changed,
+ levels = c("behavior", "biology", "purpose", "social")),
+ property_purpose = ifelse(property_changed == "purpose", 1, 0))
+
+fit.brm_property_diagnosticity = brm(formula = response ~ 1 + property_changed + bert_large + (1 | participant),
+ data = df.regression,
+ seed = 1,
+ file = "cache/brm_property_diagnosticity")
+
+fit.brm_property_diagnosticity
+#> Family: gaussian
+#> Links: mu = identity; sigma = identity
+#> Formula: response ~ 1 + property_purpose + bert_large + (1 | participant)
+#> Data: df.regression (Number of observations: 1500)
+#> Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
+#> total post-warmup draws = 4000
+#>
+#> Multilevel Hyperparameters:
+#> ~participant (Number of levels: 100)
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> sd(Intercept) 0.91 0.07 0.77 1.06 1.00 958 1434
+#>
+#> Regression Coefficients:
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> Intercept 3.05 0.27 2.53 3.60 1.00 1820 2347
+#> property_purpose 0.69 0.10 0.50 0.88 1.00 3628 3045
+#> bert_large -0.18 0.17 -0.53 0.15 1.00 3308 2693
+#>
+#> Further Distributional Parameters:
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> sigma 1.17 0.02 1.13 1.22 1.00 6094 2976
+#>
+#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
+#> and Tail_ESS are effective sample size measures, and Rhat is the potential
+#> scale reduction factor on split chains (at convergence, Rhat = 1).
+
+
+
+4.6.4 Plots
+
+4.6.4.1 Top 5 probabilites for each property by model
+ggplot(data = df.llm,
+ mapping = aes(x = category,
+ y = probability,
+ group = category,
+ color = category,
+ fill = category)) +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.7,
+ jitter.height = 0.06),
+ alpha = 0.9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(limits = c(0, 1) ) +
+ theme(plot.title = element_text(size=16, hjust = .5),
+ axis.text.x = element_blank(),
+ legend.title = element_blank(),
+ legend.position="bottom",
+ axis.title.x = element_blank(),
+ text = element_text(size = 18)) +
+ facet_wrap(~model)
+
+ggsave(width = 8, height = 3, "../../figures/experiment2/bert_overall_probabilities.pdf")
+
@@ -1189,46 +1319,46 @@ 4.5.3.1 Overall Property Means by
5 EXPERIMENT 3 (Induction)
5.1 Read in the data
-
+
5.2 Wrangle
-# catgeorization judgment dataframe
-df.exp3.long = df.exp3 %>%
- rename(condition = expCondition) %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- select(participant, comprehension_check, condition, response_behavioral: response_social) %>%
- pivot_longer(cols = response_behavioral:response_social,
- names_to = "property",
- values_to = "response") %>%
- mutate(property = str_remove_all(property, "response_"),
- property = str_replace_all(property, "behavioral", "behavior"),
- property = str_replace_all(property, "biological", "biology"),
- response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
- condition = recode(condition, "non_generic" = "specific"),
- study = rep("induction"))
+# catgeorization judgment dataframe
+df.exp3.long = df.exp3 %>%
+ rename(condition = expCondition) %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ select(participant, comprehension_check, condition, response_behavioral: response_social) %>%
+ pivot_longer(cols = response_behavioral:response_social,
+ names_to = "property",
+ values_to = "response") %>%
+ mutate(property = str_remove_all(property, "response_"),
+ property = str_replace_all(property, "behavioral", "behavior"),
+ property = str_replace_all(property, "biological", "biology"),
+ response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
+ condition = recode(condition, "non_generic" = "specific"),
+ study = rep("induction"))
5.3 Demographics
-# read in demographic data
-
-df.exp3.demographics = read_csv("../../data/experiment3/experiment3_demographics.csv")
-
-df.exp3.demographics %>%
- summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
+# read in demographic data
+
+df.exp3.demographics = read_csv("../../data/experiment3/experiment3_demographics.csv")
+
+df.exp3.demographics %>%
+ summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 34.4
-
+
#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 14.0
-
+
#> # A tibble: 5 × 2
#> # Groups: gender [5]
#> gender n
@@ -1238,9 +1368,9 @@ 5.3 Demographics
#> 3 Non-binary 3
#> 4 other_gender 1
#> 5 <NA> 1
-
+
#> # A tibble: 5 × 2
#> # Groups: race [5]
#> race n
@@ -1250,9 +1380,9 @@ 5.3 Demographics
#> 3 White 62
#> 4 other_race 2
#> 5 <NA> 3
-
+
#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
@@ -1265,100 +1395,121 @@ 5.3 Demographics
5.4 Plots
5.4.1 Property Means by Condition
-ggplot(data = df.exp3.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.05) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.5),
- color = "black",
- size = .5) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- theme(plot.title = element_text(size=16, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank()) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50")))
-
-ggsave(width = 5, height = 3, "../../figures/experiment3/exp3_property_by_condition_means.pdf")
-
+ggplot(data = df.exp3.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment3/exp3_property_by_condition_means.pdf")
+
5.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
-# create dataframe to get proportion of properties that were categorized as expected
-df.plot = df.exp3 %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- rename(condition = expCondition) %>%
- relocate(participant) %>%
- select(-c("item_0", "item_1", "error")) %>%
- pivot_longer(starts_with("item"),
- names_to = "tmp",
- values_to = "value") %>%
- separate(col = tmp,
- into = c("placeholder_a", "thing", "rank", "placeholder_b"),
- sep = "_") %>%
- group_by(rank) %>%
- mutate(row = row_number()) %>%
- pivot_wider(names_from = rank,
- values_from = value) %>%
- select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
- mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
- rename(item = property,
- response = categorization) %>%
- mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
- expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
- item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
- item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
- item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
- group_by(expected, response, item) %>%
- count(.drop = F) %>%
- mutate(proportion = n/100) %>%
- mutate(response = str_replace_all(response, "behavioral", "behavior"),
- response = str_replace_all(response, "biological", "biology")) %>%
- ungroup() %>%
- add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
-
-ggplot(data = df.plot) +
- geom_tile(aes(x = expected,
- y = response,
- fill = proportion,
- group = proportion),
- color = "black") +
-scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
- theme(legend.title = element_blank(),
- text = element_text(size = 20)) +
- xlab("Expected Categorization") +
- ylab("Actual Categorization")
-
-ggsave(filename = "../../figures/experiment3/exp3_heat_map.pdf",
- height = 5,
- width = 8)
+# create dataframe to get proportion of properties that were categorized as expected
+df.plot = df.exp3 %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ rename(condition = expCondition) %>%
+ relocate(participant) %>%
+ select(-c("item_0", "item_1", "error")) %>%
+ pivot_longer(starts_with("item"),
+ names_to = "tmp",
+ values_to = "value") %>%
+ separate(col = tmp,
+ into = c("placeholder_a", "thing", "rank", "placeholder_b"),
+ sep = "_") %>%
+ group_by(rank) %>%
+ mutate(row = row_number()) %>%
+ pivot_wider(names_from = rank,
+ values_from = value) %>%
+ select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
+ mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
+ rename(item = property,
+ response = categorization) %>%
+ mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
+ expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
+ item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
+ item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
+ item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
+ group_by(expected, response, item) %>%
+ count(.drop = F) %>%
+ mutate(proportion = n/100) %>%
+ mutate(response = str_replace_all(response, "behavioral", "behavior"),
+ response = str_replace_all(response, "biological", "biology")) %>%
+ ungroup() %>%
+ add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
+
+ggplot(data = df.plot) +
+ geom_tile(aes(x = expected,
+ y = response,
+ fill = proportion,
+ group = proportion),
+ color = "black") +
+scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
+ theme(legend.title = element_blank(),
+ text = element_text(size = 20)) +
+ xlab("Expected Categorization") +
+ ylab("Actual Categorization")
+
+ggsave(filename = "../../figures/experiment3/exp3_heat_map.pdf",
+ height = 5,
+ width = 8)
-
+
5.5 Stats
5.5.1 Bayesian Linear Mixed Model
-fit.brm2 = brm(formula = response ~ 1 + property*condition + (1 | participant),
- data = df.exp3.long,
- seed = 1,
- file = "cache/brm2")
-
-fit.brm2
+fit.brm2 = brm(formula = response ~ 1 + property*condition + (1 | participant),
+ data = df.exp3.long,
+ seed = 1,
+ file = "cache/brm2")
+
+fit.brm2
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
@@ -1401,8 +1552,8 @@ 5.5.1 Bayesian Linear Mixed Model
5.5.2 Test Hypotheses
-
+
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
@@ -1449,46 +1600,46 @@ 5.5.2 Test Hypotheses
6 EXPERIMENT 4 (Offspring)
6.1 Read in the data
-
+
6.2 Wrangle
-# catgeorization judgment dataframe
-df.exp4.long = df.exp4 %>%
- rename(condition = expCondition) %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- select(participant, comprehension_check, condition, offspring_behavioral: offspring_social) %>%
- pivot_longer(cols = offspring_behavioral:offspring_social,
- names_to = "property",
- values_to = "response") %>%
- mutate(property = str_remove_all(property, "offspring_"),
- property = str_replace_all(property, "behavioral", "behavior"),
- property = str_replace_all(property, "biological", "biology"),
- response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
- condition = recode(condition, "non_generic" = "specific"),
- study = rep("offspring"))
+# catgeorization judgment dataframe
+df.exp4.long = df.exp4 %>%
+ rename(condition = expCondition) %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ select(participant, comprehension_check, condition, offspring_behavioral: offspring_social) %>%
+ pivot_longer(cols = offspring_behavioral:offspring_social,
+ names_to = "property",
+ values_to = "response") %>%
+ mutate(property = str_remove_all(property, "offspring_"),
+ property = str_replace_all(property, "behavioral", "behavior"),
+ property = str_replace_all(property, "biological", "biology"),
+ response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
+ condition = recode(condition, "non_generic" = "specific"),
+ study = rep("offspring"))
6.3 Demographics
-# read in demographic data
-
-df.exp4.demographics = read_csv("../../data/experiment4/experiment4_demographics.csv")
-
-df.exp4.demographics %>%
- summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
+# read in demographic data
+
+df.exp4.demographics = read_csv("../../data/experiment4/experiment4_demographics.csv")
+
+df.exp4.demographics %>%
+ summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 33.9
-
+
#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 12.7
-
+
#> # A tibble: 4 × 2
#> # Groups: gender [4]
#> gender n
@@ -1497,9 +1648,9 @@ 6.3 Demographics
#> 2 Male 36
#> 3 Non-binary 1
#> 4 <NA> 2
-
+
#> # A tibble: 6 × 2
#> # Groups: race [6]
#> race n
@@ -1510,9 +1661,9 @@ 6.3 Demographics
#> 4 Native Hawaiian/Pacific Islander 2
#> 5 White 74
#> 6 other_race 5
-
+
#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
@@ -1525,100 +1676,121 @@ 6.3 Demographics
6.4 Plots
6.4.1 Property Means by Condition
-ggplot(data = df.exp4.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.05) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.5),
- color = "black",
- size = .5) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- theme(plot.title = element_text(size=16, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank()) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50")))
-
-ggsave(width = 5, height = 3, "../../figures/experiment4/exp4_property_by_condition_means.pdf")
-
+ggplot(data = df.exp4.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment4/exp4_property_by_condition_means.pdf")
+
6.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
-# create dataframe to get proportion of properties that were categorized as expected
-df.plot = df.exp4 %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- rename(condition = expCondition) %>%
- relocate(participant) %>%
- select(-c("item_0", "item_1", "error")) %>%
- pivot_longer(starts_with("item"),
- names_to = "tmp",
- values_to = "value") %>%
- separate(col = tmp,
- into = c("placeholder_a", "thing", "rank", "placeholder_b"),
- sep = "_") %>%
- group_by(rank) %>%
- mutate(row = row_number()) %>%
- pivot_wider(names_from = rank,
- values_from = value) %>%
- select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
- mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
- rename(item = property,
- response = categorization) %>%
- mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
- expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
- item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
- item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
- item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
- group_by(expected, response, item) %>%
- count(.drop = F) %>%
- mutate(proportion = n/100) %>%
- mutate(response = str_replace_all(response, "behavioral", "behavior"),
- response = str_replace_all(response, "biological", "biology")) %>%
- ungroup() %>%
- add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
-
-ggplot(data = df.plot) +
- geom_tile(aes(x = expected,
- y = response,
- fill = proportion,
- group = proportion),
- color = "black") +
-scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
- theme(legend.title = element_blank(),
- text = element_text(size = 20)) +
- xlab("Expected Categorization") +
- ylab("Actual Categorization")
-
-ggsave(filename = "../../figures/experiment4/exp4_heat_map.pdf",
- height = 5,
- width = 8)
+# create dataframe to get proportion of properties that were categorized as expected
+df.plot = df.exp4 %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ rename(condition = expCondition) %>%
+ relocate(participant) %>%
+ select(-c("item_0", "item_1", "error")) %>%
+ pivot_longer(starts_with("item"),
+ names_to = "tmp",
+ values_to = "value") %>%
+ separate(col = tmp,
+ into = c("placeholder_a", "thing", "rank", "placeholder_b"),
+ sep = "_") %>%
+ group_by(rank) %>%
+ mutate(row = row_number()) %>%
+ pivot_wider(names_from = rank,
+ values_from = value) %>%
+ select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
+ mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
+ rename(item = property,
+ response = categorization) %>%
+ mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
+ expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
+ item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
+ item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
+ item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
+ group_by(expected, response, item) %>%
+ count(.drop = F) %>%
+ mutate(proportion = n/100) %>%
+ mutate(response = str_replace_all(response, "behavioral", "behavior"),
+ response = str_replace_all(response, "biological", "biology")) %>%
+ ungroup() %>%
+ add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
+
+ggplot(data = df.plot) +
+ geom_tile(aes(x = expected,
+ y = response,
+ fill = proportion,
+ group = proportion),
+ color = "black") +
+scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
+ theme(legend.title = element_blank(),
+ text = element_text(size = 20)) +
+ xlab("Expected Categorization") +
+ ylab("Actual Categorization")
+
+ggsave(filename = "../../figures/experiment4/exp4_heat_map.pdf",
+ height = 5,
+ width = 8)
-
+
6.5 Stats
6.5.1 Bayesian Linear Mixed Model
-fit.brm3 = brm(formula = response ~ 1 + property*condition + (1 | participant),
- data = df.exp4.long,
- seed = 1,
- file = "cache/brm3")
-
-fit.brm3
+fit.brm3 = brm(formula = response ~ 1 + property*condition + (1 | participant),
+ data = df.exp4.long,
+ seed = 1,
+ file = "cache/brm3")
+
+fit.brm3
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
@@ -1661,8 +1833,8 @@ 6.5.1 Bayesian Linear Mixed Model
6.5.2 Test Hypotheses
-
+
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
@@ -1705,8 +1877,8 @@ 6.5.2 Test Hypotheses
6.5.3 Effect of statememt type
-
+
#> $emmeans
#> property = behavior:
#> condition emmean lower.HPD upper.HPD
@@ -1770,48 +1942,51 @@ 7 Session info
#> tzcode source: internal
#>
#> attached base packages:
-#> [1] stats graphics grDevices utils datasets methods base
+#> [1] grid stats graphics grDevices utils datasets methods
+#> [8] base
#>
#> other attached packages:
#> [1] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4
#> [5] purrr_1.0.2 readr_2.1.5 tidyr_1.3.1 tibble_3.2.1
-#> [9] ggplot2_3.5.0 tidyverse_2.0.0 brms_2.21.0 Rcpp_1.0.12
-#> [13] tidyjson_0.3.2 RSQLite_2.3.6 knitr_1.45 emmeans_1.10.1
-#> [17] xtable_1.8-4
+#> [9] ggplot2_3.5.1 tidyverse_2.0.0 corrr_0.4.4 janitor_2.2.0
+#> [13] brms_2.21.0 Rcpp_1.0.12 entropy_1.3.1 tidyjson_0.3.2
+#> [17] RSQLite_2.3.6 knitr_1.45 emmeans_1.10.1 ggtext_0.1.2
+#> [21] png_0.1-8 xtable_1.8-4
#>
#> loaded via a namespace (and not attached):
#> [1] DBI_1.2.2 gridExtra_2.3 inline_0.3.19
-#> [4] rlang_1.1.3 magrittr_2.0.3 matrixStats_1.2.0
-#> [7] compiler_4.3.3 loo_2.7.0 systemfonts_1.0.6
-#> [10] vctrs_0.6.5 reshape2_1.4.4 pkgconfig_2.0.3
-#> [13] crayon_1.5.2 fastmap_1.1.1 backports_1.4.1
-#> [16] labeling_0.4.3 utf8_1.2.4 rmarkdown_2.26
-#> [19] tzdb_0.4.0 ragg_1.3.0 bit_4.0.5
-#> [22] xfun_0.43 cachem_1.0.8 jsonlite_1.8.8
-#> [25] blob_1.2.4 highr_0.10 parallel_4.3.3
-#> [28] cluster_2.1.6 R6_2.5.1 bslib_0.7.0
-#> [31] stringi_1.8.3 RColorBrewer_1.1-3 StanHeaders_2.32.6
-#> [34] rpart_4.1.23 jquerylib_0.1.4 estimability_1.5
-#> [37] bookdown_0.38 assertthat_0.2.1 rstan_2.32.6
-#> [40] base64enc_0.1-3 bayesplot_1.11.1 Matrix_1.6-5
-#> [43] nnet_7.3-19 timechange_0.3.0 tidyselect_1.2.1
-#> [46] rstudioapi_0.16.0 abind_1.4-5 yaml_2.3.8
-#> [49] codetools_0.2-19 pkgbuild_1.4.4 lattice_0.22-5
-#> [52] plyr_1.8.9 withr_3.0.0 bridgesampling_1.1-2
-#> [55] posterior_1.5.0 coda_0.19-4.1 evaluate_0.23
-#> [58] foreign_0.8-86 RcppParallel_5.1.7 pillar_1.9.0
-#> [61] tensorA_0.36.2.1 checkmate_2.3.1 stats4_4.3.3
-#> [64] distributional_0.4.0 generics_0.1.3 vroom_1.6.5
-#> [67] hms_1.1.3 rstantools_2.4.0 munsell_0.5.1
-#> [70] scales_1.3.0 glue_1.7.0 Hmisc_5.1-2
-#> [73] tools_4.3.3 data.table_1.15.4 mvtnorm_1.2-4
-#> [76] grid_4.3.3 QuickJSR_1.1.3 colorspace_2.1-0
-#> [79] nlme_3.1-164 htmlTable_2.4.2 Formula_1.2-5
-#> [82] cli_3.6.2 textshaping_0.3.7 fansi_1.0.6
-#> [85] Brobdingnag_1.2-9 gtable_0.3.4 sass_0.4.9
-#> [88] digest_0.6.35 htmlwidgets_1.6.4 farver_2.1.1
-#> [91] memoise_2.0.1 htmltools_0.5.8.1 lifecycle_1.0.4
-#> [94] bit64_4.0.5
+#> [4] rlang_1.1.3 magrittr_2.0.3 snakecase_0.11.1
+#> [7] matrixStats_1.2.0 compiler_4.3.3 loo_2.7.0
+#> [10] reshape2_1.4.4 systemfonts_1.0.6 vctrs_0.6.5
+#> [13] pkgconfig_2.0.3 crayon_1.5.2 fastmap_1.1.1
+#> [16] backports_1.4.1 labeling_0.4.3 utf8_1.2.4
+#> [19] rmarkdown_2.26 markdown_1.12 tzdb_0.4.0
+#> [22] ragg_1.3.0 bit_4.0.5 xfun_0.43
+#> [25] cachem_1.0.8 jsonlite_1.8.8 blob_1.2.4
+#> [28] highr_0.10 cluster_2.1.6 parallel_4.3.3
+#> [31] R6_2.5.1 bslib_0.7.0 stringi_1.8.4
+#> [34] RColorBrewer_1.1-3 StanHeaders_2.32.6 rpart_4.1.23
+#> [37] jquerylib_0.1.4 estimability_1.5 bookdown_0.38
+#> [40] assertthat_0.2.1 rstan_2.32.6 base64enc_0.1-3
+#> [43] bayesplot_1.11.1 nnet_7.3-19 Matrix_1.6-5
+#> [46] timechange_0.3.0 tidyselect_1.2.1 rstudioapi_0.16.0
+#> [49] abind_1.4-5 yaml_2.3.8 codetools_0.2-19
+#> [52] curl_5.2.1 pkgbuild_1.4.4 plyr_1.8.9
+#> [55] lattice_0.22-5 withr_3.0.0 bridgesampling_1.1-2
+#> [58] posterior_1.5.0 coda_0.19-4.1 evaluate_0.23
+#> [61] foreign_0.8-86 RcppParallel_5.1.7 xml2_1.3.6
+#> [64] pillar_1.9.0 tensorA_0.36.2.1 checkmate_2.3.1
+#> [67] stats4_4.3.3 distributional_0.4.0 generics_0.1.3
+#> [70] vroom_1.6.5 hms_1.1.3 commonmark_1.9.1
+#> [73] rstantools_2.4.0 munsell_0.5.1 scales_1.3.0
+#> [76] glue_1.7.0 Hmisc_5.1-2 tools_4.3.3
+#> [79] data.table_1.15.4 mvtnorm_1.2-4 QuickJSR_1.1.3
+#> [82] colorspace_2.1-0 nlme_3.1-164 htmlTable_2.4.2
+#> [85] Formula_1.2-5 cli_3.6.2 textshaping_0.3.7
+#> [88] fansi_1.0.6 Brobdingnag_1.2-9 gtable_0.3.5
+#> [91] sass_0.4.9 digest_0.6.35 htmlwidgets_1.6.4
+#> [94] farver_2.1.2 memoise_2.0.1 htmltools_0.5.8.1
+#> [97] lifecycle_1.0.4 gridtext_0.1.5 bit64_4.0.5
diff --git a/figures/experiment1/exp1_top_stacked.pdf b/figures/experiment1/exp1_top_stacked.pdf
index 0019734..b63c68b 100644
Binary files a/figures/experiment1/exp1_top_stacked.pdf and b/figures/experiment1/exp1_top_stacked.pdf differ
diff --git a/figures/experiment2/bert_overall_probabilities.pdf b/figures/experiment2/bert_overall_probabilities.pdf
index 3c6fc57..6a7a24e 100644
Binary files a/figures/experiment2/bert_overall_probabilities.pdf and b/figures/experiment2/bert_overall_probabilities.pdf differ
diff --git a/figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf b/figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf
index 46db895..00fc366 100644
Binary files a/figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf and b/figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf differ
diff --git a/figures/experiment2/exp2_heat_map.pdf b/figures/experiment2/exp2_heat_map.pdf
index fb3cba6..015b02a 100644
Binary files a/figures/experiment2/exp2_heat_map.pdf and b/figures/experiment2/exp2_heat_map.pdf differ
diff --git a/figures/experiment2/exp2_property_by_condition_means.pdf b/figures/experiment2/exp2_property_by_condition_means.pdf
index a37c6e4..a2fa97d 100644
Binary files a/figures/experiment2/exp2_property_by_condition_means.pdf and b/figures/experiment2/exp2_property_by_condition_means.pdf differ
diff --git a/figures/experiment3/exp3_heat_map.pdf b/figures/experiment3/exp3_heat_map.pdf
index bcd5040..7623c6f 100644
Binary files a/figures/experiment3/exp3_heat_map.pdf and b/figures/experiment3/exp3_heat_map.pdf differ
diff --git a/figures/experiment3/exp3_property_by_condition_means.pdf b/figures/experiment3/exp3_property_by_condition_means.pdf
index acb20d4..04eb207 100644
Binary files a/figures/experiment3/exp3_property_by_condition_means.pdf and b/figures/experiment3/exp3_property_by_condition_means.pdf differ
diff --git a/figures/experiment4/exp4_heat_map.pdf b/figures/experiment4/exp4_heat_map.pdf
index 70b7bcb..36a7a68 100644
Binary files a/figures/experiment4/exp4_heat_map.pdf and b/figures/experiment4/exp4_heat_map.pdf differ
diff --git a/figures/experiment4/exp4_property_by_condition_means.pdf b/figures/experiment4/exp4_property_by_condition_means.pdf
index ead6653..5e386a0 100644
Binary files a/figures/experiment4/exp4_property_by_condition_means.pdf and b/figures/experiment4/exp4_property_by_condition_means.pdf differ
5.1 Read in the data
- +5.2 Wrangle
-# catgeorization judgment dataframe
-df.exp3.long = df.exp3 %>%
- rename(condition = expCondition) %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- select(participant, comprehension_check, condition, response_behavioral: response_social) %>%
- pivot_longer(cols = response_behavioral:response_social,
- names_to = "property",
- values_to = "response") %>%
- mutate(property = str_remove_all(property, "response_"),
- property = str_replace_all(property, "behavioral", "behavior"),
- property = str_replace_all(property, "biological", "biology"),
- response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
- condition = recode(condition, "non_generic" = "specific"),
- study = rep("induction")) # catgeorization judgment dataframe
+df.exp3.long = df.exp3 %>%
+ rename(condition = expCondition) %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ select(participant, comprehension_check, condition, response_behavioral: response_social) %>%
+ pivot_longer(cols = response_behavioral:response_social,
+ names_to = "property",
+ values_to = "response") %>%
+ mutate(property = str_remove_all(property, "response_"),
+ property = str_replace_all(property, "behavioral", "behavior"),
+ property = str_replace_all(property, "biological", "biology"),
+ response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
+ condition = recode(condition, "non_generic" = "specific"),
+ study = rep("induction")) 5.3 Demographics
-# read in demographic data
-
-df.exp3.demographics = read_csv("../../data/experiment3/experiment3_demographics.csv")
-
-df.exp3.demographics %>%
- summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))# read in demographic data
+
+df.exp3.demographics = read_csv("../../data/experiment3/experiment3_demographics.csv")
+
+df.exp3.demographics %>%
+ summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 34.4#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 14.0#> # A tibble: 5 × 2
#> # Groups: gender [5]
#> gender n
@@ -1265,9 +1368,9 @@ 5.3 Demographics
#> 3 Non-binary 3
#> 4 other_gender 1
#> 5 <NA> 1#> # A tibble: 5 × 2
#> # Groups: race [5]
#> race n
@@ -1277,9 +1380,9 @@ 5.3 Demographics
#> 3 White 62
#> 4 other_race 2
#> 5 <NA> 3#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
@@ -1292,121 +1395,121 @@ 5.3 Demographics
5.4 Plots
5.4.1 Property Means by Condition
-ggplot(data = df.exp3.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_hline(yintercept = 4, linetype = "dashed") +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.15,
- jitter.height = 0.1),
- alpha = 0.2) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.55),
- color = "black",
- size = .9) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- ggtitle("What is this creature?") +
- xlab("Property type that \n\ differed") +
- theme(plot.title = element_text(size=24, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank(),
- axis.text.x = element_text(size=16),
- axis.title.y = element_text(size=18),
- axis.text.y = element_text(size=14),
- legend.text = element_text(size=16)) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50"))) +
- coord_flip() +
- annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
- expand_limits(x = c(-Inf, 5.3)) +
-scale_y_continuous(breaks = 1:7,
- labels = c(
- "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
- "2" = "2",
- "3" = "3",
- "4" = "unsure",
- "5" = "5",
- "6" = "6",
- "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
- )) +
- theme(axis.text.x = element_markdown())
-
-ggsave(width = 8, height = 5, "../../figures/experiment3/exp3_property_by_condition_means.pdf")
-
+ggplot(data = df.exp3.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment3/exp3_property_by_condition_means.pdf")
+
5.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
-# create dataframe to get proportion of properties that were categorized as expected
-df.plot = df.exp3 %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- rename(condition = expCondition) %>%
- relocate(participant) %>%
- select(-c("item_0", "item_1", "error")) %>%
- pivot_longer(starts_with("item"),
- names_to = "tmp",
- values_to = "value") %>%
- separate(col = tmp,
- into = c("placeholder_a", "thing", "rank", "placeholder_b"),
- sep = "_") %>%
- group_by(rank) %>%
- mutate(row = row_number()) %>%
- pivot_wider(names_from = rank,
- values_from = value) %>%
- select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
- mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
- rename(item = property,
- response = categorization) %>%
- mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
- expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
- item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
- item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
- item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
- group_by(expected, response, item) %>%
- count(.drop = F) %>%
- mutate(proportion = n/100) %>%
- mutate(response = str_replace_all(response, "behavioral", "behavior"),
- response = str_replace_all(response, "biological", "biology")) %>%
- ungroup() %>%
- add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
-
-ggplot(data = df.plot) +
- geom_tile(aes(x = expected,
- y = response,
- fill = proportion,
- group = proportion),
- color = "black") +
-scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
- theme(legend.title = element_blank(),
- text = element_text(size = 20)) +
- xlab("Expected Categorization") +
- ylab("Actual Categorization")
-
-ggsave(filename = "../../figures/experiment3/exp3_heat_map.pdf",
- height = 5,
- width = 8)
+# create dataframe to get proportion of properties that were categorized as expected
+df.plot = df.exp3 %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ rename(condition = expCondition) %>%
+ relocate(participant) %>%
+ select(-c("item_0", "item_1", "error")) %>%
+ pivot_longer(starts_with("item"),
+ names_to = "tmp",
+ values_to = "value") %>%
+ separate(col = tmp,
+ into = c("placeholder_a", "thing", "rank", "placeholder_b"),
+ sep = "_") %>%
+ group_by(rank) %>%
+ mutate(row = row_number()) %>%
+ pivot_wider(names_from = rank,
+ values_from = value) %>%
+ select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
+ mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
+ rename(item = property,
+ response = categorization) %>%
+ mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
+ expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
+ item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
+ item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
+ item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
+ group_by(expected, response, item) %>%
+ count(.drop = F) %>%
+ mutate(proportion = n/100) %>%
+ mutate(response = str_replace_all(response, "behavioral", "behavior"),
+ response = str_replace_all(response, "biological", "biology")) %>%
+ ungroup() %>%
+ add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
+
+ggplot(data = df.plot) +
+ geom_tile(aes(x = expected,
+ y = response,
+ fill = proportion,
+ group = proportion),
+ color = "black") +
+scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
+ theme(legend.title = element_blank(),
+ text = element_text(size = 20)) +
+ xlab("Expected Categorization") +
+ ylab("Actual Categorization")
+
+ggsave(filename = "../../figures/experiment3/exp3_heat_map.pdf",
+ height = 5,
+ width = 8)
5.5 Stats
5.5.1 Bayesian Linear Mixed Model
-fit.brm2 = brm(formula = response ~ 1 + property*condition + (1 | participant),
- data = df.exp3.long,
- seed = 1,
- file = "cache/brm2")
-
-fit.brm2fit.brm2 = brm(formula = response ~ 1 + property*condition + (1 | participant),
+ data = df.exp3.long,
+ seed = 1,
+ file = "cache/brm2")
+
+fit.brm2#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
@@ -1449,8 +1552,8 @@ 5.5.1 Bayesian Linear Mixed Model
5.5.2 Test Hypotheses
- +#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
@@ -1497,46 +1600,46 @@ 5.5.2 Test Hypotheses
6 EXPERIMENT 4 (Offspring)
6.1 Read in the data
-
+
6.2 Wrangle
-# catgeorization judgment dataframe
-df.exp4.long = df.exp4 %>%
- rename(condition = expCondition) %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- select(participant, comprehension_check, condition, offspring_behavioral: offspring_social) %>%
- pivot_longer(cols = offspring_behavioral:offspring_social,
- names_to = "property",
- values_to = "response") %>%
- mutate(property = str_remove_all(property, "offspring_"),
- property = str_replace_all(property, "behavioral", "behavior"),
- property = str_replace_all(property, "biological", "biology"),
- response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
- condition = recode(condition, "non_generic" = "specific"),
- study = rep("offspring"))
+# catgeorization judgment dataframe
+df.exp4.long = df.exp4 %>%
+ rename(condition = expCondition) %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ select(participant, comprehension_check, condition, offspring_behavioral: offspring_social) %>%
+ pivot_longer(cols = offspring_behavioral:offspring_social,
+ names_to = "property",
+ values_to = "response") %>%
+ mutate(property = str_remove_all(property, "offspring_"),
+ property = str_replace_all(property, "behavioral", "behavior"),
+ property = str_replace_all(property, "biological", "biology"),
+ response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
+ condition = recode(condition, "non_generic" = "specific"),
+ study = rep("offspring"))
6.3 Demographics
-# read in demographic data
-
-df.exp4.demographics = read_csv("../../data/experiment4/experiment4_demographics.csv")
-
-df.exp4.demographics %>%
- summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
+# read in demographic data
+
+df.exp4.demographics = read_csv("../../data/experiment4/experiment4_demographics.csv")
+
+df.exp4.demographics %>%
+ summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 33.9
-
+
#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 12.7
-
+
#> # A tibble: 4 × 2
#> # Groups: gender [4]
#> gender n
@@ -1545,9 +1648,9 @@ 6.3 Demographics
#> 2 Male 36
#> 3 Non-binary 1
#> 4 <NA> 2
-
+
#> # A tibble: 6 × 2
#> # Groups: race [6]
#> race n
@@ -1558,9 +1661,9 @@ 6.3 Demographics
#> 4 Native Hawaiian/Pacific Islander 2
#> 5 White 74
#> 6 other_race 5
-
+
#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
@@ -1573,121 +1676,121 @@ 6.3 Demographics
6.4 Plots
6.4.1 Property Means by Condition
-ggplot(data = df.exp4.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_hline(yintercept = 4, linetype = "dashed") +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.15,
- jitter.height = 0.1),
- alpha = 0.2) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.55),
- color = "black",
- size = .9) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- ggtitle("What is this creature?") +
- xlab("Property type that \n\ differed") +
- theme(plot.title = element_text(size=24, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank(),
- axis.text.x = element_text(size=16),
- axis.title.y = element_text(size=18),
- axis.text.y = element_text(size=14),
- legend.text = element_text(size=16)) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50"))) +
- coord_flip() +
- annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
- expand_limits(x = c(-Inf, 5.3)) +
-scale_y_continuous(breaks = 1:7,
- labels = c(
- "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
- "2" = "2",
- "3" = "3",
- "4" = "unsure",
- "5" = "5",
- "6" = "6",
- "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
- )) +
- theme(axis.text.x = element_markdown())
-
-ggsave(width = 8, height = 5, "../../figures/experiment4/exp4_property_by_condition_means.pdf")
-
+ggplot(data = df.exp4.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment4/exp4_property_by_condition_means.pdf")
+
6.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
-# create dataframe to get proportion of properties that were categorized as expected
-df.plot = df.exp4 %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- rename(condition = expCondition) %>%
- relocate(participant) %>%
- select(-c("item_0", "item_1", "error")) %>%
- pivot_longer(starts_with("item"),
- names_to = "tmp",
- values_to = "value") %>%
- separate(col = tmp,
- into = c("placeholder_a", "thing", "rank", "placeholder_b"),
- sep = "_") %>%
- group_by(rank) %>%
- mutate(row = row_number()) %>%
- pivot_wider(names_from = rank,
- values_from = value) %>%
- select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
- mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
- rename(item = property,
- response = categorization) %>%
- mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
- expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
- item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
- item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
- item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
- group_by(expected, response, item) %>%
- count(.drop = F) %>%
- mutate(proportion = n/100) %>%
- mutate(response = str_replace_all(response, "behavioral", "behavior"),
- response = str_replace_all(response, "biological", "biology")) %>%
- ungroup() %>%
- add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
-
-ggplot(data = df.plot) +
- geom_tile(aes(x = expected,
- y = response,
- fill = proportion,
- group = proportion),
- color = "black") +
-scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
- theme(legend.title = element_blank(),
- text = element_text(size = 20)) +
- xlab("Expected Categorization") +
- ylab("Actual Categorization")
-
-ggsave(filename = "../../figures/experiment4/exp4_heat_map.pdf",
- height = 5,
- width = 8)
+# create dataframe to get proportion of properties that were categorized as expected
+df.plot = df.exp4 %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ rename(condition = expCondition) %>%
+ relocate(participant) %>%
+ select(-c("item_0", "item_1", "error")) %>%
+ pivot_longer(starts_with("item"),
+ names_to = "tmp",
+ values_to = "value") %>%
+ separate(col = tmp,
+ into = c("placeholder_a", "thing", "rank", "placeholder_b"),
+ sep = "_") %>%
+ group_by(rank) %>%
+ mutate(row = row_number()) %>%
+ pivot_wider(names_from = rank,
+ values_from = value) %>%
+ select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
+ mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
+ rename(item = property,
+ response = categorization) %>%
+ mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
+ expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
+ item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
+ item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
+ item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
+ group_by(expected, response, item) %>%
+ count(.drop = F) %>%
+ mutate(proportion = n/100) %>%
+ mutate(response = str_replace_all(response, "behavioral", "behavior"),
+ response = str_replace_all(response, "biological", "biology")) %>%
+ ungroup() %>%
+ add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
+
+ggplot(data = df.plot) +
+ geom_tile(aes(x = expected,
+ y = response,
+ fill = proportion,
+ group = proportion),
+ color = "black") +
+scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
+ theme(legend.title = element_blank(),
+ text = element_text(size = 20)) +
+ xlab("Expected Categorization") +
+ ylab("Actual Categorization")
+
+ggsave(filename = "../../figures/experiment4/exp4_heat_map.pdf",
+ height = 5,
+ width = 8)
-
+
6.5 Stats
6.5.1 Bayesian Linear Mixed Model
-fit.brm3 = brm(formula = response ~ 1 + property*condition + (1 | participant),
- data = df.exp4.long,
- seed = 1,
- file = "cache/brm3")
-
-fit.brm3
+fit.brm3 = brm(formula = response ~ 1 + property*condition + (1 | participant),
+ data = df.exp4.long,
+ seed = 1,
+ file = "cache/brm3")
+
+fit.brm3
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
@@ -1730,8 +1833,8 @@ 6.5.1 Bayesian Linear Mixed Model
6.5.2 Test Hypotheses
-
+
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
@@ -1774,8 +1877,8 @@ 6.5.2 Test Hypotheses
6.5.3 Effect of statememt type
-
+
#> $emmeans
#> property = behavior:
#> condition emmean lower.HPD upper.HPD
@@ -1845,13 +1948,14 @@ 7 Session info
#> other attached packages:
#> [1] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4
#> [5] purrr_1.0.2 readr_2.1.5 tidyr_1.3.1 tibble_3.2.1
-#> [9] ggplot2_3.5.1 tidyverse_2.0.0 brms_2.21.0 Rcpp_1.0.12
-#> [13] tidyjson_0.3.2 RSQLite_2.3.6 knitr_1.45 emmeans_1.10.1
-#> [17] ggtext_0.1.2 png_0.1-8 xtable_1.8-4
+#> [9] ggplot2_3.5.1 tidyverse_2.0.0 corrr_0.4.4 janitor_2.2.0
+#> [13] brms_2.21.0 Rcpp_1.0.12 entropy_1.3.1 tidyjson_0.3.2
+#> [17] RSQLite_2.3.6 knitr_1.45 emmeans_1.10.1 ggtext_0.1.2
+#> [21] png_0.1-8 xtable_1.8-4
#>
#> loaded via a namespace (and not attached):
-#> [1] DBI_1.2.2 gridExtra_2.3 remotes_2.5.0
-#> [4] inline_0.3.19 rlang_1.1.3 magrittr_2.0.3
+#> [1] DBI_1.2.2 gridExtra_2.3 inline_0.3.19
+#> [4] rlang_1.1.3 magrittr_2.0.3 snakecase_0.11.1
#> [7] matrixStats_1.2.0 compiler_4.3.3 loo_2.7.0
#> [10] reshape2_1.4.4 systemfonts_1.0.6 vctrs_0.6.5
#> [13] pkgconfig_2.0.3 crayon_1.5.2 fastmap_1.1.1
diff --git a/docs/index.html b/docs/index.html
index 89e6ae3..1573033 100644
--- a/docs/index.html
+++ b/docs/index.html
@@ -9,9 +9,9 @@
-
+
-
+
Teleological Properties
@@ -427,8 +427,8 @@
Teleological Properties
-David Rose, Siying Zhang, Qi Han & Tobias Gerstenberg
-May 06, 2024
+David Rose, Siying Zhang & Tobias Gerstenberg
+August 06, 2024
@@ -455,17 +455,25 @@ May 06, 2024
-May 06, 2024
2 Global options
@@ -810,36 +824,64 @@ 4.3 Demographics
4.4 Plots
4.4.1 Property Means by Condition
-ggplot(data = df.exp2.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.05) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.5),
- color = "black",
- size = .5) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- theme(plot.title = element_text(size=16, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank()) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50")))
-
-ggsave(width = 5, height = 3, "../../figures/experiment2/exp2_property_by_condition_means.pdf")
-
+# Read the image file
+midpoint_creature = readPNG("../../figures/plot_additions/midpoint_creature.png")
+
+
+# Create a raster object from the image
+raster_midpoint_creature = rasterGrob(midpoint_creature, interpolate=TRUE)
+
+ggplot(data = df.exp2.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment2/exp2_property_by_condition_means.pdf")
+
4.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
@@ -893,8 +935,8 @@ 4.4.2 Plot of Actual Property Rat
width = 8)
-
-4.4.3 Expected Property Selections for Each Property Type on Catgeorization Rating
+
+4.4.3 Catgeorization Ratings for Each Individual Property
# property categorization and categorization judgment dataframe
df.exp2.property_categorization = df.exp2 %>%
mutate(participant = rep(1:100, each = 2)) %>%
@@ -944,11 +986,11 @@ 4.4.3 Expected Property Selection
df.exp2.purpose,
df.exp2.social)
-df.plot = df.exp2.property_categorization %>%
+df.each_property = df.exp2.property_categorization %>%
filter(categorization == "behavioral" & property_selected %in% c("jump", "chew", "swim", "run") | categorization == "biological" & property_selected %in% c("have hair", "have long legs", "are warm blooded", "have pointy ears") | categorization == "purpose" & property_selected %in% c("purify water", "aerate soil", "enable decomposition", "make honey") | categorization == "social" & property_selected %in% c("pair bond", "share food with group members", "follow the dominant group member", "cooperate with group members"))
#give short labels to properties for plotting
-df.plot = df.plot %>%
+df.each_property = df.each_property %>%
mutate(property_selected = str_replace_all(property_selected, "are warm blooded", "blood"),
property_selected = str_replace_all(property_selected, "have hair", "hair"),
property_selected = str_replace_all(property_selected, "have pointy ears", "ears"),
@@ -963,12 +1005,12 @@ 4.4.3 Expected Property Selection
property_selected = str_replace_all(property_selected, "pair bond", "bond"))
# rename property types
-df.plot = df.plot %>%
+df.each_property = df.each_property %>%
mutate(property_changed = str_replace_all(property_changed, "behavioral", "behavior"),
property_changed = str_replace_all(property_changed, "biological", "biology"))
-ggplot(data = df.plot,
+ggplot(data = df.each_property,
mapping = aes(x = property_selected,
y = response,
group = property_changed,
@@ -1009,11 +1051,13 @@ 4.4.3 Expected Property Selection
scales = "free")
ggsave(width = 10, height = 6, "../../figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf")
-
-## Stats
+
-
-4.4.4 Bayesian Linear Mixed Model
+
+
+4.5 Stats
+
+4.5.1 Bayesian Linear Mixed Model
fit.brm1 = brm(formula = response ~ 1 + property*condition + (1 | participant),
data = df.exp2.long,
seed = 1,
@@ -1060,8 +1104,8 @@ 4.4.4 Bayesian Linear Mixed Model
#> and Tail_ESS are effective sample size measures, and Rhat is the potential
#> scale reduction factor on split chains (at convergence, Rhat = 1).
-
-4.4.5 Test Hypotheses
+
-
-4.5 LLM Diagnosticity
-
-4.5.1 Read in the data
+
+4.6 LLM Diagnosticity
+
+4.6.1 Read in the data
#> Rows: 80 Columns: 6
#> ── Column specification ────────────────────────────────────────────────────────
@@ -1137,8 +1181,8 @@ 4.5.1 Read in the data
#> ℹ Use `spec()` to retrieve the full column specification for this data.
#> ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
-
-4.5.2 Wrangle
+
+4.6.2 Wrangle
-
-4.5.3 Plots
-
-4.5.3.1 Overall Property Means by Model
-ggplot(data = df.llm,
- mapping = aes(x = category,
- y = probability,
- group = category,
- color = category,
- fill = category)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.2) +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.5),
- shape = 21,
- color = "black",
- size = .5) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- # scale_y_continuous(breaks = 1:7) +
- theme(plot.title = element_text(size=16, hjust = .5),
- axis.text.x = element_blank(),
- legend.title = element_blank(),
- legend.position="bottom",
- axis.title.x = element_blank(),
- text = element_text(size = 18)) +
- facet_wrap(~ model)
+
+4.6.3 Stats
+
+4.6.3.1 Correlate participant ratings for individual properties with LLM completions
+df.each_property.means = df.each_property %>%
+ select(property_selected, categorization, response) %>%
+ rename(property = property_selected, category = categorization) %>% mutate(category = str_replace_all(category, "behavioral", "behavior"),
+ category = str_replace_all(category, "biological", "biology")) %>%
+
+ group_by(category, property) %>%
+ summarise(mean = mean(response, na.rm = TRUE))
+
+df.llm2 = df.llm %>%
+ #give short labels to properties
+ mutate(property = str_replace_all(property, "warm blooded", "blood"),
+ property = str_replace_all(property, "pointy ears", "ears"),
+ property = str_replace_all(property, "long legs", "legs"),
+ property = str_replace_all(property, "enables decomposition", "decompose"),
+ property = str_replace_all(property, "purifies water", "purify"),
+ property = str_replace_all(property, "makes honey", "honey"),
+ property = str_replace_all(property, "aerates soil", "aerate"),
+ property = str_replace_all(property, "share food with group members", "share"),
+ property = str_replace_all(property, "cooperates with group members", "cooperate"),
+ property = str_replace_all(property, "follow dominant group member", "follow"),
+ property = str_replace_all(property, "pair bond", "bond")) %>%
+ group_by(category, property, model) %>%
+ summarise(entropy_value = entropy(probability)) %>%
+ pivot_wider(names_from = model,
+ values_from = entropy_value)
-ggsave(width = 8, height = 3, "../../figures/experiment2/bert_overall_property_means.pdf")
-
+df.each_property.means %>%
+ left_join(df.llm2, by = c("category", "property")) %>%
+ ungroup() %>%
+ clean_names() %>%
+ select(-c(category, property)) %>%
+ correlate() %>%
+ shave() %>%
+ fashion()
+#> Correlation computed with
+#> • Method: 'pearson'
+#> • Missing treated using: 'pairwise.complete.obs'
+#> term mean bert_base bert_large ro_ber_ta_large
+#> 1 mean
+#> 2 bert_base -.51
+#> 3 bert_large -.69 .67
+#> 4 ro_ber_ta_large -.14 .51 .40
+
+
+4.6.3.2 Linear mixed effects model with diagnosticity and property type
+df.regression = df.each_property %>%
+ left_join(df.llm2,
+ by = c("property_selected" = "property",
+ "property_changed" = "category")) %>%
+ clean_names() %>%
+ mutate(property_changed = factor(property_changed,
+ levels = c("behavior", "biology", "purpose", "social")),
+ property_purpose = ifelse(property_changed == "purpose", 1, 0))
+
+fit.brm_property_diagnosticity = brm(formula = response ~ 1 + property_changed + bert_large + (1 | participant),
+ data = df.regression,
+ seed = 1,
+ file = "cache/brm_property_diagnosticity")
+
+fit.brm_property_diagnosticity
+#> Family: gaussian
+#> Links: mu = identity; sigma = identity
+#> Formula: response ~ 1 + property_purpose + bert_large + (1 | participant)
+#> Data: df.regression (Number of observations: 1500)
+#> Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
+#> total post-warmup draws = 4000
+#>
+#> Multilevel Hyperparameters:
+#> ~participant (Number of levels: 100)
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> sd(Intercept) 0.91 0.07 0.77 1.06 1.00 958 1434
+#>
+#> Regression Coefficients:
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> Intercept 3.05 0.27 2.53 3.60 1.00 1820 2347
+#> property_purpose 0.69 0.10 0.50 0.88 1.00 3628 3045
+#> bert_large -0.18 0.17 -0.53 0.15 1.00 3308 2693
+#>
+#> Further Distributional Parameters:
+#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
+#> sigma 1.17 0.02 1.13 1.22 1.00 6094 2976
+#>
+#> Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
+#> and Tail_ESS are effective sample size measures, and Rhat is the potential
+#> scale reduction factor on split chains (at convergence, Rhat = 1).
+
+
+
+4.6.4 Plots
+
+4.6.4.1 Top 5 probabilites for each property by model
+ggplot(data = df.llm,
+ mapping = aes(x = category,
+ y = probability,
+ group = category,
+ color = category,
+ fill = category)) +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.7,
+ jitter.height = 0.06),
+ alpha = 0.9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(limits = c(0, 1) ) +
+ theme(plot.title = element_text(size=16, hjust = .5),
+ axis.text.x = element_blank(),
+ legend.title = element_blank(),
+ legend.position="bottom",
+ axis.title.x = element_blank(),
+ text = element_text(size = 18)) +
+ facet_wrap(~model)
+
+ggsave(width = 8, height = 3, "../../figures/experiment2/bert_overall_probabilities.pdf")
+
@@ -1189,46 +1319,46 @@ 4.5.3.1 Overall Property Means by
5 EXPERIMENT 3 (Induction)
5.1 Read in the data
-
+
5.2 Wrangle
-# catgeorization judgment dataframe
-df.exp3.long = df.exp3 %>%
- rename(condition = expCondition) %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- select(participant, comprehension_check, condition, response_behavioral: response_social) %>%
- pivot_longer(cols = response_behavioral:response_social,
- names_to = "property",
- values_to = "response") %>%
- mutate(property = str_remove_all(property, "response_"),
- property = str_replace_all(property, "behavioral", "behavior"),
- property = str_replace_all(property, "biological", "biology"),
- response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
- condition = recode(condition, "non_generic" = "specific"),
- study = rep("induction"))
+# catgeorization judgment dataframe
+df.exp3.long = df.exp3 %>%
+ rename(condition = expCondition) %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ select(participant, comprehension_check, condition, response_behavioral: response_social) %>%
+ pivot_longer(cols = response_behavioral:response_social,
+ names_to = "property",
+ values_to = "response") %>%
+ mutate(property = str_remove_all(property, "response_"),
+ property = str_replace_all(property, "behavioral", "behavior"),
+ property = str_replace_all(property, "biological", "biology"),
+ response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
+ condition = recode(condition, "non_generic" = "specific"),
+ study = rep("induction"))
5.3 Demographics
-# read in demographic data
-
-df.exp3.demographics = read_csv("../../data/experiment3/experiment3_demographics.csv")
-
-df.exp3.demographics %>%
- summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
+# read in demographic data
+
+df.exp3.demographics = read_csv("../../data/experiment3/experiment3_demographics.csv")
+
+df.exp3.demographics %>%
+ summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 34.4
-
+
#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 14.0
-
+
#> # A tibble: 5 × 2
#> # Groups: gender [5]
#> gender n
@@ -1238,9 +1368,9 @@ 5.3 Demographics
#> 3 Non-binary 3
#> 4 other_gender 1
#> 5 <NA> 1
-
+
#> # A tibble: 5 × 2
#> # Groups: race [5]
#> race n
@@ -1250,9 +1380,9 @@ 5.3 Demographics
#> 3 White 62
#> 4 other_race 2
#> 5 <NA> 3
-
+
#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
@@ -1265,100 +1395,121 @@ 5.3 Demographics
5.4 Plots
5.4.1 Property Means by Condition
-ggplot(data = df.exp3.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.05) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.5),
- color = "black",
- size = .5) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- theme(plot.title = element_text(size=16, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank()) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50")))
-
-ggsave(width = 5, height = 3, "../../figures/experiment3/exp3_property_by_condition_means.pdf")
-
+ggplot(data = df.exp3.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment3/exp3_property_by_condition_means.pdf")
+
5.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
-# create dataframe to get proportion of properties that were categorized as expected
-df.plot = df.exp3 %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- rename(condition = expCondition) %>%
- relocate(participant) %>%
- select(-c("item_0", "item_1", "error")) %>%
- pivot_longer(starts_with("item"),
- names_to = "tmp",
- values_to = "value") %>%
- separate(col = tmp,
- into = c("placeholder_a", "thing", "rank", "placeholder_b"),
- sep = "_") %>%
- group_by(rank) %>%
- mutate(row = row_number()) %>%
- pivot_wider(names_from = rank,
- values_from = value) %>%
- select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
- mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
- rename(item = property,
- response = categorization) %>%
- mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
- expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
- item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
- item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
- item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
- group_by(expected, response, item) %>%
- count(.drop = F) %>%
- mutate(proportion = n/100) %>%
- mutate(response = str_replace_all(response, "behavioral", "behavior"),
- response = str_replace_all(response, "biological", "biology")) %>%
- ungroup() %>%
- add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
-
-ggplot(data = df.plot) +
- geom_tile(aes(x = expected,
- y = response,
- fill = proportion,
- group = proportion),
- color = "black") +
-scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
- theme(legend.title = element_blank(),
- text = element_text(size = 20)) +
- xlab("Expected Categorization") +
- ylab("Actual Categorization")
-
-ggsave(filename = "../../figures/experiment3/exp3_heat_map.pdf",
- height = 5,
- width = 8)
+# create dataframe to get proportion of properties that were categorized as expected
+df.plot = df.exp3 %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ rename(condition = expCondition) %>%
+ relocate(participant) %>%
+ select(-c("item_0", "item_1", "error")) %>%
+ pivot_longer(starts_with("item"),
+ names_to = "tmp",
+ values_to = "value") %>%
+ separate(col = tmp,
+ into = c("placeholder_a", "thing", "rank", "placeholder_b"),
+ sep = "_") %>%
+ group_by(rank) %>%
+ mutate(row = row_number()) %>%
+ pivot_wider(names_from = rank,
+ values_from = value) %>%
+ select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
+ mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
+ rename(item = property,
+ response = categorization) %>%
+ mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
+ expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
+ item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
+ item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
+ item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
+ group_by(expected, response, item) %>%
+ count(.drop = F) %>%
+ mutate(proportion = n/100) %>%
+ mutate(response = str_replace_all(response, "behavioral", "behavior"),
+ response = str_replace_all(response, "biological", "biology")) %>%
+ ungroup() %>%
+ add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
+
+ggplot(data = df.plot) +
+ geom_tile(aes(x = expected,
+ y = response,
+ fill = proportion,
+ group = proportion),
+ color = "black") +
+scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
+ theme(legend.title = element_blank(),
+ text = element_text(size = 20)) +
+ xlab("Expected Categorization") +
+ ylab("Actual Categorization")
+
+ggsave(filename = "../../figures/experiment3/exp3_heat_map.pdf",
+ height = 5,
+ width = 8)
-
+
5.5 Stats
5.5.1 Bayesian Linear Mixed Model
-fit.brm2 = brm(formula = response ~ 1 + property*condition + (1 | participant),
- data = df.exp3.long,
- seed = 1,
- file = "cache/brm2")
-
-fit.brm2
+fit.brm2 = brm(formula = response ~ 1 + property*condition + (1 | participant),
+ data = df.exp3.long,
+ seed = 1,
+ file = "cache/brm2")
+
+fit.brm2
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
@@ -1401,8 +1552,8 @@ 5.5.1 Bayesian Linear Mixed Model
5.5.2 Test Hypotheses
-
+
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
@@ -1449,46 +1600,46 @@ 5.5.2 Test Hypotheses
6 EXPERIMENT 4 (Offspring)
6.1 Read in the data
-
+
6.2 Wrangle
-# catgeorization judgment dataframe
-df.exp4.long = df.exp4 %>%
- rename(condition = expCondition) %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- select(participant, comprehension_check, condition, offspring_behavioral: offspring_social) %>%
- pivot_longer(cols = offspring_behavioral:offspring_social,
- names_to = "property",
- values_to = "response") %>%
- mutate(property = str_remove_all(property, "offspring_"),
- property = str_replace_all(property, "behavioral", "behavior"),
- property = str_replace_all(property, "biological", "biology"),
- response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
- condition = recode(condition, "non_generic" = "specific"),
- study = rep("offspring"))
+# catgeorization judgment dataframe
+df.exp4.long = df.exp4 %>%
+ rename(condition = expCondition) %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ select(participant, comprehension_check, condition, offspring_behavioral: offspring_social) %>%
+ pivot_longer(cols = offspring_behavioral:offspring_social,
+ names_to = "property",
+ values_to = "response") %>%
+ mutate(property = str_remove_all(property, "offspring_"),
+ property = str_replace_all(property, "behavioral", "behavior"),
+ property = str_replace_all(property, "biological", "biology"),
+ response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
+ condition = recode(condition, "non_generic" = "specific"),
+ study = rep("offspring"))
6.3 Demographics
-# read in demographic data
-
-df.exp4.demographics = read_csv("../../data/experiment4/experiment4_demographics.csv")
-
-df.exp4.demographics %>%
- summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
+# read in demographic data
+
+df.exp4.demographics = read_csv("../../data/experiment4/experiment4_demographics.csv")
+
+df.exp4.demographics %>%
+ summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))
#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 33.9
-
+
#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 12.7
-
+
#> # A tibble: 4 × 2
#> # Groups: gender [4]
#> gender n
@@ -1497,9 +1648,9 @@ 6.3 Demographics
#> 2 Male 36
#> 3 Non-binary 1
#> 4 <NA> 2
-
+
#> # A tibble: 6 × 2
#> # Groups: race [6]
#> race n
@@ -1510,9 +1661,9 @@ 6.3 Demographics
#> 4 Native Hawaiian/Pacific Islander 2
#> 5 White 74
#> 6 other_race 5
-
+
#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
@@ -1525,100 +1676,121 @@ 6.3 Demographics
6.4 Plots
6.4.1 Property Means by Condition
-ggplot(data = df.exp4.long,
- mapping = aes(x = property,
- y = response,
- group = condition,
- color = property,
- fill = property,
- shape = condition)) +
- geom_point(position = position_jitterdodge(dodge.width = 0.5,
- jitter.width = 0.1,
- jitter.height = 0.0),
- alpha = 0.05) +
- theme(legend.position = "none") +
- stat_summary(fun.data = "mean_cl_boot",
- position = position_dodge(width = 0.5),
- color = "black",
- size = .5) +
- scale_fill_brewer(palette = "Set1") +
- scale_color_brewer(palette = "Set1") +
- scale_y_continuous(breaks = 1:7) +
- scale_shape_manual(values = c(21, 23)) +
- theme(plot.title = element_text(size=16, hjust = .5),
- legend.title = element_blank(),
- legend.position = "bottom",
- axis.title.x = element_blank()) +
- guides(fill = "none",
- color = "none",
- shape = guide_legend(override.aes = list(fill = "gray50")))
-
-ggsave(width = 5, height = 3, "../../figures/experiment4/exp4_property_by_condition_means.pdf")
-
+ggplot(data = df.exp4.long,
+ mapping = aes(x = property,
+ y = response,
+ group = condition,
+ color = property,
+ fill = property,
+ shape = condition)) +
+ geom_hline(yintercept = 4, linetype = "dashed") +
+ geom_point(position = position_jitterdodge(dodge.width = 0.5,
+ jitter.width = 0.15,
+ jitter.height = 0.1),
+ alpha = 0.2) +
+ theme(legend.position = "none") +
+ stat_summary(fun.data = "mean_cl_boot",
+ position = position_dodge(width = 0.55),
+ color = "black",
+ size = .9) +
+ scale_fill_brewer(palette = "Set1") +
+ scale_color_brewer(palette = "Set1") +
+ scale_y_continuous(breaks = 1:7) +
+ scale_shape_manual(values = c(21, 23)) +
+ ggtitle("What is this creature?") +
+ xlab("Property type that \n\ differed") +
+ theme(plot.title = element_text(size=24, hjust = .5),
+ legend.title = element_blank(),
+ legend.position = "bottom",
+ axis.title.x = element_blank(),
+ axis.text.x = element_text(size=16),
+ axis.title.y = element_text(size=18),
+ axis.text.y = element_text(size=14),
+ legend.text = element_text(size=16)) +
+ guides(fill = "none",
+ color = "none",
+ shape = guide_legend(override.aes = list(fill = "gray50"))) +
+ coord_flip() +
+ annotation_custom(raster_midpoint_creature, xmin=4.35, xmax=5.3, ymin=-Inf, ymax=Inf) +
+ expand_limits(x = c(-Inf, 5.3)) +
+scale_y_continuous(breaks = 1:7,
+ labels = c(
+ "1" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/left_creature.png' width='35' height='30'>",
+ "2" = "2",
+ "3" = "3",
+ "4" = "unsure",
+ "5" = "5",
+ "6" = "6",
+ "7" = "definitely<br><img src='https://raw.githubusercontent.com/cicl-stanford/teleological_properties/master/figures/plot_additions/right_creature.png' width='35' height='30'>"
+ )) +
+ theme(axis.text.x = element_markdown())
+
+ggsave(width = 8, height = 5, "../../figures/experiment4/exp4_property_by_condition_means.pdf")
+
6.4.2 Plot of Actual Property Ratings vs Expected Property Ratings
-# create dataframe to get proportion of properties that were categorized as expected
-df.plot = df.exp4 %>%
- mutate(participant = rep(1:100, each = 2)) %>%
- rename(condition = expCondition) %>%
- relocate(participant) %>%
- select(-c("item_0", "item_1", "error")) %>%
- pivot_longer(starts_with("item"),
- names_to = "tmp",
- values_to = "value") %>%
- separate(col = tmp,
- into = c("placeholder_a", "thing", "rank", "placeholder_b"),
- sep = "_") %>%
- group_by(rank) %>%
- mutate(row = row_number()) %>%
- pivot_wider(names_from = rank,
- values_from = value) %>%
- select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
- mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
- rename(item = property,
- response = categorization) %>%
- mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
- expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
- item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
- item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
- item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
- group_by(expected, response, item) %>%
- count(.drop = F) %>%
- mutate(proportion = n/100) %>%
- mutate(response = str_replace_all(response, "behavioral", "behavior"),
- response = str_replace_all(response, "biological", "biology")) %>%
- ungroup() %>%
- add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
-
-ggplot(data = df.plot) +
- geom_tile(aes(x = expected,
- y = response,
- fill = proportion,
- group = proportion),
- color = "black") +
-scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
- theme(legend.title = element_blank(),
- text = element_text(size = 20)) +
- xlab("Expected Categorization") +
- ylab("Actual Categorization")
-
-ggsave(filename = "../../figures/experiment4/exp4_heat_map.pdf",
- height = 5,
- width = 8)
+# create dataframe to get proportion of properties that were categorized as expected
+df.plot = df.exp4 %>%
+ mutate(participant = rep(1:100, each = 2)) %>%
+ rename(condition = expCondition) %>%
+ relocate(participant) %>%
+ select(-c("item_0", "item_1", "error")) %>%
+ pivot_longer(starts_with("item"),
+ names_to = "tmp",
+ values_to = "value") %>%
+ separate(col = tmp,
+ into = c("placeholder_a", "thing", "rank", "placeholder_b"),
+ sep = "_") %>%
+ group_by(rank) %>%
+ mutate(row = row_number()) %>%
+ pivot_wider(names_from = rank,
+ values_from = value) %>%
+ select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
+ mutate(thing = recode(thing, "0" = "first", "1" = "second")) %>%
+ rename(item = property,
+ response = categorization) %>%
+ mutate(item = str_replace_all(item, c("pair bonds" = "pair bond", "follows the dominant group member" = "follow the dominant group member", "cooperates with group members" = "cooperate with group members", "shares food with group members" = "share food with group members", "aerates soil" = "aerate soil", "makes honey" = "make honey", "purifies water" = "purify water", "enables decomposition" = "enable decomposition", "has pointy ears" = "have pointy ears", "has long legs" = "have long legs", "has hair" = "have hair", "is warm blooded" = "are warm blooded", "runs" = "run", "chews" = "chew", "swims" = "swim", "jumps" = "jump")),
+ expected = case_when(item %in% c("jump", "swim", "chew","run", "swallow", "fly", "smell", "salivate", "urinate", "digest slowly") ~ "behavior",
+ item %in% c("are warm blooded", "have hair", "have long legs", "have pointy ears", "have sharp teeth", "have a tail", "have small nostrils", "have spots", "have claws", "have large eyes") ~ "biology",
+ item %in% c("enable decomposition", "pollinate flowers", "purify water", "make honey", "aerate soil", "enable nitrogen fixation", "recycle nutrients in soil", "catch and kill insects", "produce oxygen", "eat animal carcasses") ~ "purpose",
+ item %in% c("share food with group members", "cooperate with group members", "follow the dominant group member", "pair bond", "dance before mating", "are nomadic", "sing", "mark territory", "store resources", "build shelter") ~ "social")) %>%
+ group_by(expected, response, item) %>%
+ count(.drop = F) %>%
+ mutate(proportion = n/100) %>%
+ mutate(response = str_replace_all(response, "behavioral", "behavior"),
+ response = str_replace_all(response, "biological", "biology")) %>%
+ ungroup() %>%
+ add_row(expected = "social", response = "purpose", item = "just for plotting", n = 0 , proportion = 0.00)
+
+ggplot(data = df.plot) +
+ geom_tile(aes(x = expected,
+ y = response,
+ fill = proportion,
+ group = proportion),
+ color = "black") +
+scale_fill_gradient(low = "white", high = "black", limits = c(0, 1), breaks = seq(0, 1, 0.25)) +
+ theme(legend.title = element_blank(),
+ text = element_text(size = 20)) +
+ xlab("Expected Categorization") +
+ ylab("Actual Categorization")
+
+ggsave(filename = "../../figures/experiment4/exp4_heat_map.pdf",
+ height = 5,
+ width = 8)
-
+
6.5 Stats
6.5.1 Bayesian Linear Mixed Model
-fit.brm3 = brm(formula = response ~ 1 + property*condition + (1 | participant),
- data = df.exp4.long,
- seed = 1,
- file = "cache/brm3")
-
-fit.brm3
+fit.brm3 = brm(formula = response ~ 1 + property*condition + (1 | participant),
+ data = df.exp4.long,
+ seed = 1,
+ file = "cache/brm3")
+
+fit.brm3
#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
@@ -1661,8 +1833,8 @@ 6.5.1 Bayesian Linear Mixed Model
6.5.2 Test Hypotheses
-
+
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
@@ -1705,8 +1877,8 @@ 6.5.2 Test Hypotheses
6.5.3 Effect of statememt type
-
+
#> $emmeans
#> property = behavior:
#> condition emmean lower.HPD upper.HPD
@@ -1770,48 +1942,51 @@ 7 Session info
#> tzcode source: internal
#>
#> attached base packages:
-#> [1] stats graphics grDevices utils datasets methods base
+#> [1] grid stats graphics grDevices utils datasets methods
+#> [8] base
#>
#> other attached packages:
#> [1] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4
#> [5] purrr_1.0.2 readr_2.1.5 tidyr_1.3.1 tibble_3.2.1
-#> [9] ggplot2_3.5.0 tidyverse_2.0.0 brms_2.21.0 Rcpp_1.0.12
-#> [13] tidyjson_0.3.2 RSQLite_2.3.6 knitr_1.45 emmeans_1.10.1
-#> [17] xtable_1.8-4
+#> [9] ggplot2_3.5.1 tidyverse_2.0.0 corrr_0.4.4 janitor_2.2.0
+#> [13] brms_2.21.0 Rcpp_1.0.12 entropy_1.3.1 tidyjson_0.3.2
+#> [17] RSQLite_2.3.6 knitr_1.45 emmeans_1.10.1 ggtext_0.1.2
+#> [21] png_0.1-8 xtable_1.8-4
#>
#> loaded via a namespace (and not attached):
#> [1] DBI_1.2.2 gridExtra_2.3 inline_0.3.19
-#> [4] rlang_1.1.3 magrittr_2.0.3 matrixStats_1.2.0
-#> [7] compiler_4.3.3 loo_2.7.0 systemfonts_1.0.6
-#> [10] vctrs_0.6.5 reshape2_1.4.4 pkgconfig_2.0.3
-#> [13] crayon_1.5.2 fastmap_1.1.1 backports_1.4.1
-#> [16] labeling_0.4.3 utf8_1.2.4 rmarkdown_2.26
-#> [19] tzdb_0.4.0 ragg_1.3.0 bit_4.0.5
-#> [22] xfun_0.43 cachem_1.0.8 jsonlite_1.8.8
-#> [25] blob_1.2.4 highr_0.10 parallel_4.3.3
-#> [28] cluster_2.1.6 R6_2.5.1 bslib_0.7.0
-#> [31] stringi_1.8.3 RColorBrewer_1.1-3 StanHeaders_2.32.6
-#> [34] rpart_4.1.23 jquerylib_0.1.4 estimability_1.5
-#> [37] bookdown_0.38 assertthat_0.2.1 rstan_2.32.6
-#> [40] base64enc_0.1-3 bayesplot_1.11.1 Matrix_1.6-5
-#> [43] nnet_7.3-19 timechange_0.3.0 tidyselect_1.2.1
-#> [46] rstudioapi_0.16.0 abind_1.4-5 yaml_2.3.8
-#> [49] codetools_0.2-19 pkgbuild_1.4.4 lattice_0.22-5
-#> [52] plyr_1.8.9 withr_3.0.0 bridgesampling_1.1-2
-#> [55] posterior_1.5.0 coda_0.19-4.1 evaluate_0.23
-#> [58] foreign_0.8-86 RcppParallel_5.1.7 pillar_1.9.0
-#> [61] tensorA_0.36.2.1 checkmate_2.3.1 stats4_4.3.3
-#> [64] distributional_0.4.0 generics_0.1.3 vroom_1.6.5
-#> [67] hms_1.1.3 rstantools_2.4.0 munsell_0.5.1
-#> [70] scales_1.3.0 glue_1.7.0 Hmisc_5.1-2
-#> [73] tools_4.3.3 data.table_1.15.4 mvtnorm_1.2-4
-#> [76] grid_4.3.3 QuickJSR_1.1.3 colorspace_2.1-0
-#> [79] nlme_3.1-164 htmlTable_2.4.2 Formula_1.2-5
-#> [82] cli_3.6.2 textshaping_0.3.7 fansi_1.0.6
-#> [85] Brobdingnag_1.2-9 gtable_0.3.4 sass_0.4.9
-#> [88] digest_0.6.35 htmlwidgets_1.6.4 farver_2.1.1
-#> [91] memoise_2.0.1 htmltools_0.5.8.1 lifecycle_1.0.4
-#> [94] bit64_4.0.5
+#> [4] rlang_1.1.3 magrittr_2.0.3 snakecase_0.11.1
+#> [7] matrixStats_1.2.0 compiler_4.3.3 loo_2.7.0
+#> [10] reshape2_1.4.4 systemfonts_1.0.6 vctrs_0.6.5
+#> [13] pkgconfig_2.0.3 crayon_1.5.2 fastmap_1.1.1
+#> [16] backports_1.4.1 labeling_0.4.3 utf8_1.2.4
+#> [19] rmarkdown_2.26 markdown_1.12 tzdb_0.4.0
+#> [22] ragg_1.3.0 bit_4.0.5 xfun_0.43
+#> [25] cachem_1.0.8 jsonlite_1.8.8 blob_1.2.4
+#> [28] highr_0.10 cluster_2.1.6 parallel_4.3.3
+#> [31] R6_2.5.1 bslib_0.7.0 stringi_1.8.4
+#> [34] RColorBrewer_1.1-3 StanHeaders_2.32.6 rpart_4.1.23
+#> [37] jquerylib_0.1.4 estimability_1.5 bookdown_0.38
+#> [40] assertthat_0.2.1 rstan_2.32.6 base64enc_0.1-3
+#> [43] bayesplot_1.11.1 nnet_7.3-19 Matrix_1.6-5
+#> [46] timechange_0.3.0 tidyselect_1.2.1 rstudioapi_0.16.0
+#> [49] abind_1.4-5 yaml_2.3.8 codetools_0.2-19
+#> [52] curl_5.2.1 pkgbuild_1.4.4 plyr_1.8.9
+#> [55] lattice_0.22-5 withr_3.0.0 bridgesampling_1.1-2
+#> [58] posterior_1.5.0 coda_0.19-4.1 evaluate_0.23
+#> [61] foreign_0.8-86 RcppParallel_5.1.7 xml2_1.3.6
+#> [64] pillar_1.9.0 tensorA_0.36.2.1 checkmate_2.3.1
+#> [67] stats4_4.3.3 distributional_0.4.0 generics_0.1.3
+#> [70] vroom_1.6.5 hms_1.1.3 commonmark_1.9.1
+#> [73] rstantools_2.4.0 munsell_0.5.1 scales_1.3.0
+#> [76] glue_1.7.0 Hmisc_5.1-2 tools_4.3.3
+#> [79] data.table_1.15.4 mvtnorm_1.2-4 QuickJSR_1.1.3
+#> [82] colorspace_2.1-0 nlme_3.1-164 htmlTable_2.4.2
+#> [85] Formula_1.2-5 cli_3.6.2 textshaping_0.3.7
+#> [88] fansi_1.0.6 Brobdingnag_1.2-9 gtable_0.3.5
+#> [91] sass_0.4.9 digest_0.6.35 htmlwidgets_1.6.4
+#> [94] farver_2.1.2 memoise_2.0.1 htmltools_0.5.8.1
+#> [97] lifecycle_1.0.4 gridtext_0.1.5 bit64_4.0.5
diff --git a/figures/experiment1/exp1_top_stacked.pdf b/figures/experiment1/exp1_top_stacked.pdf
index 0019734..b63c68b 100644
Binary files a/figures/experiment1/exp1_top_stacked.pdf and b/figures/experiment1/exp1_top_stacked.pdf differ
diff --git a/figures/experiment2/bert_overall_probabilities.pdf b/figures/experiment2/bert_overall_probabilities.pdf
index 3c6fc57..6a7a24e 100644
Binary files a/figures/experiment2/bert_overall_probabilities.pdf and b/figures/experiment2/bert_overall_probabilities.pdf differ
diff --git a/figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf b/figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf
index 46db895..00fc366 100644
Binary files a/figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf and b/figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf differ
diff --git a/figures/experiment2/exp2_heat_map.pdf b/figures/experiment2/exp2_heat_map.pdf
index fb3cba6..015b02a 100644
Binary files a/figures/experiment2/exp2_heat_map.pdf and b/figures/experiment2/exp2_heat_map.pdf differ
diff --git a/figures/experiment2/exp2_property_by_condition_means.pdf b/figures/experiment2/exp2_property_by_condition_means.pdf
index a37c6e4..a2fa97d 100644
Binary files a/figures/experiment2/exp2_property_by_condition_means.pdf and b/figures/experiment2/exp2_property_by_condition_means.pdf differ
diff --git a/figures/experiment3/exp3_heat_map.pdf b/figures/experiment3/exp3_heat_map.pdf
index bcd5040..7623c6f 100644
Binary files a/figures/experiment3/exp3_heat_map.pdf and b/figures/experiment3/exp3_heat_map.pdf differ
diff --git a/figures/experiment3/exp3_property_by_condition_means.pdf b/figures/experiment3/exp3_property_by_condition_means.pdf
index acb20d4..04eb207 100644
Binary files a/figures/experiment3/exp3_property_by_condition_means.pdf and b/figures/experiment3/exp3_property_by_condition_means.pdf differ
diff --git a/figures/experiment4/exp4_heat_map.pdf b/figures/experiment4/exp4_heat_map.pdf
index 70b7bcb..36a7a68 100644
Binary files a/figures/experiment4/exp4_heat_map.pdf and b/figures/experiment4/exp4_heat_map.pdf differ
diff --git a/figures/experiment4/exp4_property_by_condition_means.pdf b/figures/experiment4/exp4_property_by_condition_means.pdf
index ead6653..5e386a0 100644
Binary files a/figures/experiment4/exp4_property_by_condition_means.pdf and b/figures/experiment4/exp4_property_by_condition_means.pdf differ