Teleological Properties
David Rose, Siying Zhang & Tobias Gerstenberg
August 06, 2024
1 Load packages
library("xtable") # for saving tables
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 else 2 Global options
3 EXPERIMENT 1 (Property Categorization)
3.1 Read in the data
3.2 Wrangle
# filter out incompletes and debugs
df.exp1.data = df.exp1.data %>%
filter(status %in% 3:5,
codeversion == "experiment1")
# !str_detect(mode, "debug"))
# demographic information
df.exp1.demographics = df.exp1.data$datastring %>%
enter_object("questiondata") %>%
gather_object("index") %>%
append_values_string("value") %>%
as_tibble() %>%
rename(participant = document.id) %>%
pivot_wider(names_from = index,
values_from = value) %>%
mutate(time = difftime(df.exp1.data$endhit,
df.exp1.data$beginhit,
units = "mins"))
# judgments
df.exp1.long = df.exp1.data$datastring %>%
as.tbl_json() %>%
enter_object("data") %>%
gather_array("order") %>%
enter_object("trialdata") %>%
gather_object("index") %>%
append_values_string("value") %>%
as_tibble() %>%
rename(participant = document.id) %>%
pivot_wider(names_from = index,
values_from = value) %>%
na.omit()
# remove participants who didn't pass attention check items
# (who did not select either biological or purpose for attention check items
# "have bones" and "have DNA")
df.exp1.long = df.exp1.long %>%
group_by(participant) %>%
filter(!any(item == "have DNA" & response =="social" |
item == "have DNA" & response == "behavioral" |
item == "have bones" & response == "social" |
item == "have bones" & response == "behavioral")) %>%
ungroup() %>%
filter(!(item %in% c("have bones", "have DNA")))3.3 Demographics
#> [1] 1 2 3 4 5 6 8 9 10 11 12 13 14 15 16 18 19 20 21 22 23 25 26 27 28
#> [26] 29 30 32 33 34 35 36 37 38 39 41 42 43 44 45 46 47 48 49 50 51 52 54 55 56df.exp1.demographics = df.exp1.demographics %>%
# remove participants from demographics who failed the comprehension check
filter(!(participant %in% c("7", "17", "24", "31", "40", "53"))) %>%
select(participant, age : ethnicity) %>%
mutate(gender = str_to_lower(gender),
gender = str_replace(gender, "^m$", "male"),
race = str_to_lower(race))
df.exp1.demographics %>%
summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 36.4#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 9.88#> # A tibble: 3 × 2
#> # Groups: gender [3]
#> gender n
#> <chr> <int>
#> 1 female 15
#> 2 male 33
#> 3 <NA> 2#> # A tibble: 9 × 2
#> # Groups: race [9]
#> race n
#> <chr> <int>
#> 1 "" 1
#> 2 "american" 1
#> 3 "asian" 1
#> 4 "asian indian" 1
#> 5 "black" 2
#> 6 "caucasian" 4
#> 7 "latino" 1
#> 8 "white" 37
#> 9 <NA> 2#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
#> <chr> <int>
#> 1 hispanic 5
#> 2 non-hispanic 43
#> 3 <NA> 23.4 Plots
3.4.1 Plot of the top four properties for each category
df.exp1.top_items = df.exp1.long %>%
filter(!item == "pollinate flowers") %>%
count(item, response) %>%
arrange(response, desc(n)) %>%
group_by(response) %>%
slice_head(n = 4) %>%
mutate(rank = n():1) %>%
ungroup()
df.plot = df.exp1.long %>%
count(item, response) %>%
left_join(df.exp1.top_items %>%
mutate(type = response) %>%
select(-c(n, response)),
by = c("item")) %>%
na.omit() %>%
mutate(type = factor(type,
levels = c("behavior", "biology", "purpose", "social"))) %>%
mutate(type = recode(type,
"behavior" = "Top behavioral properties",
"biology" = "Top biological properties",
"purpose" = "Top purposeful properties",
"social" = "Top social properties"))
#give short labels to properties for plotting
df.plot = df.plot %>%
mutate(item = str_replace_all(item, "are warm blooded", "blood"),
item = str_replace_all(item, "have hair", "hair"),
item = str_replace_all(item, "have pointy ears", "ears"),
item = str_replace_all(item, "have long legs", "legs"),
item = str_replace_all(item, "enable decomposition", "decompose"),
item = str_replace_all(item, "purify water", "purify"),
item = str_replace_all(item, "make honey", "honey"),
item = str_replace_all(item, "aerate soil", "aerate"),
item = str_replace_all(item, "share food with group members", "share"),
item = str_replace_all(item, "cooperate with group members", "cooperate"),
item = str_replace_all(item, "follow the dominant group member", "follow"),
item = str_replace_all(item, "pair bond", "bond"))
ggplot(data = df.plot,
mapping = aes(x = reorder(item, rank),
y = n,
fill = response)) +
geom_col(width = 0.75,
color = "black",
position = position_fill(reverse = TRUE)) +
scale_y_continuous(labels = c("0%", "25%", "50%", "75%", "100%")) +
coord_flip(expand = F) +
facet_wrap(~type,
ncol = 2,
scales = "free") +
labs(title = element_blank(),
y = element_blank()) +
scale_fill_brewer(palette = "Set1") +
theme(plot.title = element_text(hjust = 0.5,
size = 16,
face = "bold"),
text = element_text(size = 16),
strip.text = element_text(size = 16,
margin = margin(b = 0.3,
t = 0.1,
unit = "cm")),
strip.background = element_blank(),
axis.title.y = element_blank(),
legend.position = "bottom",
legend.title = element_blank(),
plot.margin = margin(t = 0.5,
b = 0.2,
l = 0.2,
r = 1,
unit = "cm"))
ggsave(filename = "../../figures/experiment1/exp1_top_stacked.pdf",
height = 4,
width = 8)
4 EXPERIMENT 2 (Transformation)
4.2 Wrangle
# catgeorization judgment dataframe
df.exp2.long = df.exp2 %>%
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("transformation")) 4.3 Demographics
# read in demographic data
df.exp2.demographics = read_csv("../../data/experiment2/experiment2_demographics.csv")
df.exp2.demographics %>%
summarise(age_mean = mean(as.numeric(age), na.rm = TRUE))#> # A tibble: 1 × 1
#> age_mean
#> <dbl>
#> 1 34.1#> # A tibble: 1 × 1
#> age_sd
#> <dbl>
#> 1 11.8#> # A tibble: 3 × 2
#> # Groups: gender [3]
#> gender n
#> <chr> <int>
#> 1 Female 48
#> 2 Male 48
#> 3 Non-binary 4#> # A tibble: 4 × 2
#> # Groups: race [4]
#> race n
#> <chr> <int>
#> 1 Asian 14
#> 2 Black/African American 6
#> 3 White 76
#> 4 other_race 4#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
#> <chr> <int>
#> 1 Hispanic 14
#> 2 Non-Hispanic 85
#> 3 <NA> 14.4 Plots
4.4.1 Property Means by Condition
# 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
# create dataframe to get proportion of properties that were categorized as expected
df.plot = df.exp2 %>%
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/experiment2/exp2_heat_map.pdf",
height = 5,
width = 8)
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)) %>%
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) %>%
mutate(thing = recode(thing, "0" = "first", "1" = "second"),
pair = rep(c("first", "second"), each = 8, times = 100)) %>%
select(-c("workerid", "proliferate.condition", "placeholder_a", "placeholder_b", "row")) %>%
pivot_longer(cols = response_behavioral:response_social,
names_to = "property_changed",
values_to = "response") %>%
mutate(property_changed = str_remove_all(property_changed, "response_"),
response = recode(response, `0` = 1, `1` = 2, `2` = 3, `3` = 4, `4` = 5, `5` = 6, `6` = 7),
condition = recode(condition, "non_generic" = "specific")) %>%
rename(property_selected = property) %>%
mutate(property = recode(thing, "first" = "original", "second" = "new")) %>%
select(-thing) %>%
relocate(response, .after = last_col()) %>%
mutate(property_selected = str_replace_all(property_selected, 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")))
df.exp2.bio = df.exp2.property_categorization %>%
filter(property_changed == "biological" & categorization == "biological")
df.exp2.behavior = df.exp2.property_categorization %>%
filter(property_changed == "behavioral" & categorization == "behavioral")
df.exp2.social = df.exp2.property_categorization %>%
filter(property_changed == "social" & categorization == "social")
df.exp2.purpose = df.exp2.property_categorization %>%
filter(property_changed == "purpose" & categorization == "purpose")
df.exp2.property_categorization = df.exp2.behavior %>%
bind_rows(df.exp2.bio,
df.exp2.purpose,
df.exp2.social)
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.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"),
property_selected = str_replace_all(property_selected, "have long legs", "legs"),
property_selected = str_replace_all(property_selected, "enable decomposition", "decompose"),
property_selected = str_replace_all(property_selected, "purify water", "purify"),
property_selected = str_replace_all(property_selected, "make honey", "honey"),
property_selected = str_replace_all(property_selected, "aerate soil", "aerate"),
property_selected = str_replace_all(property_selected, "share food with group members", "share"),
property_selected = str_replace_all(property_selected, "cooperate with group members", "cooperate"),
property_selected = str_replace_all(property_selected, "follow the dominant group member", "follow"),
property_selected = str_replace_all(property_selected, "pair bond", "bond"))
# rename property types
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.each_property,
mapping = aes(x = property_selected,
y = response,
group = property_changed,
color = property_changed,
fill = property_changed)) +
geom_point(position = position_jitterdodge(dodge.width = 0.5,
jitter.width = 0.3,
jitter.height = 0.1),
alpha = 0.1) +
stat_summary(fun.data = "mean_cl_boot",
position = position_dodge(width = 0.5),
shape = 21,
color = "black",
size = .9) +
scale_fill_brewer(palette = "Set1") +
scale_color_brewer(palette = "Set1") +
scale_y_continuous(breaks = 1:7) +
theme(plot.title = element_text(hjust = 0.5,
size = 18,
face = "bold"),
text = element_text(size = 18),
strip.text = element_text(size = 18,
margin = margin(b = 0.3,
t = 0.1,
unit = "cm")),
axis.title.y = element_blank(),
axis.title.x = element_blank(),
strip.background = element_blank(),
legend.position = "none",
legend.title = element_blank(),
plot.margin = margin(t = 0.5,
b = 0.2,
l = 0.2,
r = 1,
unit = "cm")) +
coord_flip() +
facet_wrap(~property_changed,
scales = "free")
ggsave(width = 10, height = 6, "../../figures/experiment2/exp2_expected_property_selections_for_property_type_ratings.pdf")
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,
file = "cache/brm1")
fit.brm1#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
#> Data: df.exp2 (Number of observations: 796)
#> 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.85 0.08 0.71 1.01 1.00 1670 2978
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
#> Intercept 2.99 0.09 2.81 3.17 1.00 1671
#> property1 -0.20 0.08 -0.34 -0.05 1.00 6998
#> property2 0.02 0.07 -0.13 0.17 1.00 6524
#> property3 0.54 0.07 0.40 0.68 1.00 6303
#> condition1 0.06 0.10 -0.14 0.25 1.00 1808
#> property1:condition1 0.12 0.08 -0.02 0.27 1.00 8216
#> property2:condition1 0.05 0.08 -0.11 0.19 1.00 7384
#> property3:condition1 -0.07 0.08 -0.22 0.08 1.00 7842
#> Tail_ESS
#> Intercept 2569
#> property1 3084
#> property2 3056
#> property3 3132
#> condition1 2511
#> property1:condition1 3212
#> property2:condition1 2774
#> property3:condition1 2597
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 1.21 0.03 1.15 1.28 1.00 6417 3211
#>
#> 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.5.2 Test Hypotheses
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
#> behavior 2.97 2.61 3.29
#> biology 3.11 2.78 3.47
#> purpose 3.51 3.19 3.87
#> social 2.59 2.25 2.93
#>
#> condition = specific:
#> property emmean lower.HPD upper.HPD
#> behavior 2.61 2.26 2.92
#> biology 2.91 2.59 3.25
#> purpose 3.54 3.21 3.88
#> social 2.67 2.33 2.99
#>
#> Point estimate displayed: median
#> HPD interval probability: 0.95
#>
#> $contrasts
#> condition = generic:
#> contrast estimate lower.HPD upper.HPD
#> behavior - biology -0.1440 -0.4956 0.1993
#> behavior - purpose -0.5491 -0.9012 -0.2205
#> behavior - social 0.3811 0.0395 0.7263
#> biology - purpose -0.4026 -0.7392 -0.0710
#> biology - social 0.5299 0.2034 0.8859
#> purpose - social 0.9298 0.5751 1.2491
#>
#> condition = specific:
#> contrast estimate lower.HPD upper.HPD
#> behavior - biology -0.2946 -0.6111 0.0586
#> behavior - purpose -0.9313 -1.2594 -0.5799
#> behavior - social -0.0617 -0.3959 0.2799
#> biology - purpose -0.6380 -0.9889 -0.3236
#> biology - social 0.2373 -0.1115 0.5541
#> purpose - social 0.8712 0.5406 1.2094
#>
#> Point estimate displayed: median
#> HPD interval probability: 0.954.6 LLM Diagnosticity
4.6.1 Read in the data
#> Rows: 80 Columns: 6
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (5): property, category, question, answer, model
#> dbl (1): probability
#>
#> ℹ 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.#> Rows: 80 Columns: 6
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (5): model, property, category, question, answer
#> dbl (1): probability
#>
#> ℹ 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.#> Rows: 80 Columns: 6
#> ── Column specification ────────────────────────────────────────────────────────
#> Delimiter: ","
#> chr (5): model, property, category, question, answer
#> dbl (1): probability
#>
#> ℹ 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.6.2 Wrangle
df.llm = df.bert_base %>%
bind_rows(df.bert_large,
df.roberta_large)
df.llm = df.llm %>%
mutate(category = str_replace_all(category, "biological", "biology"),
model = str_replace_all(model, "bert_base", "BERT-base"),
model = str_replace_all(model, "bert_large", "BERT-large"),
model = str_replace_all(model, "roberta_large", "RoBERTa-large"))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 .404.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")
5 EXPERIMENT 3 (Induction)
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")) 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))#> # 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
#> <chr> <int>
#> 1 Female 57
#> 2 Male 38
#> 3 Non-binary 3
#> 4 other_gender 1
#> 5 <NA> 1#> # A tibble: 5 × 2
#> # Groups: race [5]
#> race n
#> <chr> <int>
#> 1 Asian 20
#> 2 Black/African American 13
#> 3 White 62
#> 4 other_race 2
#> 5 <NA> 3#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
#> <chr> <int>
#> 1 Hispanic 10
#> 2 Non-Hispanic 87
#> 3 <NA> 35.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")
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)
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#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
#> Data: df.exp3 (Number of observations: 798)
#> 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.89 0.08 0.75 1.04 1.00 1656 2865
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
#> Intercept 3.11 0.10 2.92 3.30 1.00 1167
#> property1 -0.39 0.07 -0.53 -0.26 1.00 6374
#> property2 0.19 0.07 0.06 0.34 1.00 6769
#> property3 0.68 0.07 0.54 0.82 1.00 6569
#> condition1 -0.09 0.10 -0.29 0.10 1.00 1146
#> property1:condition1 0.01 0.07 -0.12 0.16 1.00 8268
#> property2:condition1 0.01 0.07 -0.13 0.15 1.00 7574
#> property3:condition1 -0.07 0.07 -0.21 0.07 1.00 6779
#> Tail_ESS
#> Intercept 1708
#> property1 2643
#> property2 2839
#> property3 3473
#> condition1 2004
#> property1:condition1 3221
#> property2:condition1 3232
#> property3:condition1 3006
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 1.15 0.03 1.09 1.21 1.00 6713 3610
#>
#> 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).5.5.2 Test Hypotheses
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
#> behavior 2.64 2.32 2.98
#> biology 3.22 2.87 3.53
#> purpose 3.63 3.31 3.98
#> social 2.58 2.27 2.93
#>
#> condition = specific:
#> property emmean lower.HPD upper.HPD
#> behavior 2.79 2.47 3.13
#> biology 3.39 3.06 3.73
#> purpose 3.95 3.60 4.27
#> social 2.67 2.35 3.01
#>
#> Point estimate displayed: median
#> HPD interval probability: 0.95
#>
#> $contrasts
#> condition = generic:
#> contrast estimate lower.HPD upper.HPD
#> behavior - biology -0.5805 -0.891 -0.2563
#> behavior - purpose -0.9902 -1.297 -0.6524
#> behavior - social 0.0572 -0.263 0.3601
#> biology - purpose -0.4103 -0.723 -0.0673
#> biology - social 0.6405 0.318 0.9512
#> purpose - social 1.0463 0.751 1.3717
#>
#> condition = specific:
#> contrast estimate lower.HPD upper.HPD
#> behavior - biology -0.5943 -0.926 -0.2684
#> behavior - purpose -1.1564 -1.489 -0.8627
#> behavior - social 0.1275 -0.189 0.4507
#> biology - purpose -0.5606 -0.877 -0.2572
#> biology - social 0.7221 0.408 1.0423
#> purpose - social 1.2828 0.957 1.5883
#>
#> Point estimate displayed: median
#> HPD interval probability: 0.956 EXPERIMENT 4 (Offspring)
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")) 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))#> # 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
#> <chr> <int>
#> 1 Female 62
#> 2 Male 36
#> 3 Non-binary 1
#> 4 <NA> 2#> # A tibble: 6 × 2
#> # Groups: race [6]
#> race n
#> <chr> <int>
#> 1 American Indian/Alaska Native 1
#> 2 Asian 11
#> 3 Black/African American 8
#> 4 Native Hawaiian/Pacific Islander 2
#> 5 White 74
#> 6 other_race 5#> # A tibble: 3 × 2
#> # Groups: ethnicity [3]
#> ethnicity n
#> <chr> <int>
#> 1 Hispanic 12
#> 2 Non-Hispanic 88
#> 3 <NA> 16.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")
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)
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#> Family: gaussian
#> Links: mu = identity; sigma = identity
#> Formula: response ~ 1 + property * condition + (1 | participant)
#> Data: df.exp4 (Number of observations: 799)
#> 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.81 0.07 0.68 0.96 1.00 1499 2409
#>
#> Regression Coefficients:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
#> Intercept 3.07 0.09 2.89 3.25 1.00 1316
#> property1 -0.18 0.06 -0.31 -0.06 1.00 7258
#> property2 0.05 0.06 -0.08 0.17 1.00 6271
#> property3 0.41 0.06 0.29 0.53 1.00 7033
#> condition1 0.20 0.09 0.02 0.37 1.00 1220
#> property1:condition1 0.06 0.07 -0.07 0.19 1.00 8882
#> property2:condition1 -0.01 0.07 -0.14 0.12 1.00 7343
#> property3:condition1 -0.00 0.06 -0.12 0.12 1.00 6978
#> Tail_ESS
#> Intercept 1441
#> property1 2613
#> property2 2984
#> property3 3095
#> condition1 1643
#> property1:condition1 3030
#> property2:condition1 2762
#> property3:condition1 3189
#>
#> Further Distributional Parameters:
#> Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
#> sigma 1.05 0.03 1.00 1.11 1.00 5728 2874
#>
#> 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).6.5.2 Test Hypotheses
#> $emmeans
#> condition = generic:
#> property emmean lower.HPD upper.HPD
#> behavior 3.14 2.82 3.43
#> biology 3.29 2.98 3.60
#> purpose 3.67 3.38 3.98
#> social 2.94 2.64 3.26
#>
#> condition = specific:
#> property emmean lower.HPD upper.HPD
#> behavior 2.62 2.33 2.94
#> biology 2.93 2.63 3.23
#> purpose 3.28 2.99 3.58
#> social 2.64 2.35 2.97
#>
#> Point estimate displayed: median
#> HPD interval probability: 0.95
#>
#> $contrasts
#> condition = generic:
#> contrast estimate lower.HPD upper.HPD
#> behavior - biology -0.1527 -0.47068 0.1379
#> behavior - purpose -0.5247 -0.81759 -0.2420
#> behavior - social 0.2037 -0.09763 0.4733
#> biology - purpose -0.3783 -0.67456 -0.0914
#> biology - social 0.3560 0.07348 0.6527
#> purpose - social 0.7333 0.44289 1.0230
#>
#> condition = specific:
#> contrast estimate lower.HPD upper.HPD
#> behavior - biology -0.3039 -0.59719 -0.0205
#> behavior - purpose -0.6579 -0.95537 -0.3717
#> behavior - social -0.0193 -0.33143 0.2722
#> biology - purpose -0.3536 -0.64413 -0.0677
#> biology - social 0.2833 -0.00151 0.5846
#> purpose - social 0.6384 0.35735 0.9298
#>
#> Point estimate displayed: median
#> HPD interval probability: 0.956.5.3 Effect of statememt type
#> $emmeans
#> property = behavior:
#> condition emmean lower.HPD upper.HPD
#> generic 3.14 2.82 3.43
#> specific 2.62 2.33 2.94
#>
#> property = biology:
#> condition emmean lower.HPD upper.HPD
#> generic 3.29 2.98 3.60
#> specific 2.93 2.63 3.23
#>
#> property = purpose:
#> condition emmean lower.HPD upper.HPD
#> generic 3.67 3.38 3.98
#> specific 3.28 2.99 3.58
#>
#> property = social:
#> condition emmean lower.HPD upper.HPD
#> generic 2.94 2.64 3.26
#> specific 2.64 2.35 2.97
#>
#> Point estimate displayed: median
#> HPD interval probability: 0.95
#>
#> $contrasts
#> property = behavior:
#> contrast estimate lower.HPD upper.HPD
#> generic - specific 0.521 0.0948 0.956
#>
#> property = biology:
#> contrast estimate lower.HPD upper.HPD
#> generic - specific 0.364 -0.0805 0.783
#>
#> property = purpose:
#> contrast estimate lower.HPD upper.HPD
#> generic - specific 0.392 -0.0415 0.815
#>
#> property = social:
#> contrast estimate lower.HPD upper.HPD
#> generic - specific 0.291 -0.1371 0.707
#>
#> Point estimate displayed: median
#> HPD interval probability: 0.957 Session info
#> R version 4.3.3 (2024-02-29)
#> Platform: aarch64-apple-darwin20 (64-bit)
#> Running under: macOS Ventura 13.2
#>
#> Matrix products: default
#> BLAS: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRblas.0.dylib
#> LAPACK: /Library/Frameworks/R.framework/Versions/4.3-arm64/Resources/lib/libRlapack.dylib; LAPACK version 3.11.0
#>
#> locale:
#> [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
#>
#> time zone: America/Los_Angeles
#> tzcode source: internal
#>
#> attached base packages:
#> [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.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 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