library(tidyverse)
library(here)
library(knitr)
library(broom)
library(Matrix)
library(dendextend)
library(cowplot)
### Shape-texture-color plot ###
LANG_ANIMAL_DISTANCE_COLOR <- here("data/processed/animal_color_distances_language_wiki_gary.csv")
LANG_ANIMAL_DISTANCE_SHAPE<- here("data/processed/animal_shape_distances_language_wiki_gary.csv")
LANG_ANIMAL_DISTANCE_TEXTURE <- here("data/processed/animal_texture_distances_language_wiki_gary.csv")
TIDY_HUMAN_PATH <- here("data/processed/tidy_human_data.csv")
language_data <- read_csv(LANG_ANIMAL_DISTANCE_COLOR) %>%
left_join(read_csv(LANG_ANIMAL_DISTANCE_SHAPE), by = c("animal1", "animal2")) %>%
left_join(read_csv(LANG_ANIMAL_DISTANCE_TEXTURE),by = c("animal1", "animal2")) %>%
mutate_if(is.numeric, ~-.x )
human_data <- read_csv(TIDY_HUMAN_PATH)
full_sim_data <- full_join(language_data, human_data, by = c("animal1", "animal2"))
human_data_wide <- human_data %>%
unite("measure", c("participant_type", "similarity_type")) %>%
spread(measure, human_similarity)
full_sim_data_wide2 <- full_join(language_data, human_data,
by = c("animal1", "animal2")) %>%
spread(similarity_type, human_similarity) %>%
filter(animal1 < animal2)
color_cors <- full_sim_data_wide2 %>%
group_by(participant_type) %>%
nest() %>%
mutate(temp = map(data, ~ tidy(cor.test(.$language_similarity_simple_dist_color,
.$human_similarity_color, method = "spearman"))),
n = map(data, nrow),
dimension = "Color") %>%
select(-data) %>%
unnest()
texture_cors <- full_sim_data_wide2 %>%
group_by(participant_type) %>%
nest() %>%
mutate(temp = map(data, ~ tidy(cor.test(.$language_similarity_simple_dist_texture,
.$human_similarity_skin, method = "spearman"))),
n = map(data, nrow),
dimension = "Skin Texture") %>%
select(-data) %>%
unnest()
shape_cors <- full_sim_data_wide2 %>%
group_by(participant_type) %>%
nest() %>%
mutate(temp = map(data, ~ tidy(cor.test(.$language_similarity_simple_dist_shape,
.$human_similarity_shape, method = "spearman"))),
n = map(data, nrow),
dimension = "Shape") %>%
select(-data) %>%
unnest()
TAXONOMIC_PATH <- here("data/raw/taxonomy_matrix.mat")
taxonomic_data <- R.matlab::readMat(TAXONOMIC_PATH)[[2]]
LABELS <- c("shark", "swan", "flamingo", "pigeon", "crow", "elephant",
"mammoth", "sloth", "beaver", "gorilla", "bat", "rhino",
"zebra", "llama", "hippo", "killerwhale", "dolphin", "giraffe",
"sheep", "goat", "deer", "pig", "boar", "lion", "panther", "cheetah",
"skunk", "panda", "polarbear", "grizzly") %>% rev() # from SI fig s2
colnames(taxonomic_data) <- LABELS
rownames(taxonomic_data) <- LABELS
taxonomic_long <- taxonomic_data %>%
as.data.frame() %>%
rownames_to_column("animal1") %>%
gather("animal2", "similarity", -animal1) %>%
mutate(sim_type = "taxonomic_similarity")
LANGUAGE_PATH_WIKI <- here("data/processed/animal_distances_wiki_gary.csv")
language_data_wiki <- read_csv(LANGUAGE_PATH_WIKI) %>%
spread(word2, language_similarity) %>%
select(-word1)
all_corrs_mat_langs_wiki <- as.matrix(language_data_wiki)
rownames(all_corrs_mat_langs_wiki) <- colnames(language_data_wiki)
language_long_wiki <- all_corrs_mat_langs_wiki %>%
as.data.frame() %>%
rownames_to_column("animal1") %>%
gather("animal2", "similarity", -animal1) %>%
mutate(sim_type = "lang_wiki_similarity")
taxo_corr <- bind_rows(taxonomic_long, language_long_wiki) %>%
filter(animal1 < animal2) %>%
spread(sim_type, similarity) %>%
mutate(participant_type = "Ground Truth") %>%
group_by(participant_type) %>%
nest() %>%
mutate(temp = map(data, ~ tidy(cor.test(.$lang_wiki_similarity,
-.$taxonomic_similarity, method = "spearman"))),
n = map(data, nrow),
dimension = "Taxonomy") %>%
select(-data) %>%
unnest()
cor_df <- color_cors %>%
bind_rows(texture_cors) %>%
bind_rows(shape_cors) %>%
bind_rows(taxo_corr) %>%
select(-method, -alternative, -statistic) %>%
mutate(se = 1/sqrt(n-3),
estimate_se_l = estimate - se,
estimate_se_h = estimate + se,
dimension = fct_relevel(dimension, "Taxonomy", "Shape", "Skin Texture"),
participant_type = str_to_title(participant_type)) %>%
rowwise() %>%
mutate(sig = case_when(p.value < .01 ~ "**",
p.value < .05 ~ "*",
TRUE ~ ""))
ggplot(cor_df, aes(x = fct_rev(participant_type), y = estimate, fill = participant_type)) +
geom_bar(stat = "identity", position = "dodge") +
facet_grid(~dimension, drop = T, scales="free_x",space = "free_x") +
xlab("Language as predictor of...") +
geom_text(aes(y = estimate + .07, label = sig), size = 6) +
geom_linerange(aes(ymin = estimate_se_l, ymax = estimate_se_h)) +
theme_classic(base_size = 13) +
scale_fill_manual(values = c( "#0345E1", "yellow","#DB3A26")) +
scale_y_continuous(
expand = expand_scale(mult = c(0, 0.05)),
name = "Fisher's Z-transformed rho",
limits = c(0, .42)) +
theme(legend.position = "none")

kable(cor_df)
| Blind |
Color |
435 |
-0.0224499 |
0.6635005 |
0.0481125 |
-0.0705624 |
0.0256626 |
|
| Sighted |
Color |
435 |
-0.0572202 |
0.2671231 |
0.0481125 |
-0.1053327 |
-0.0091076 |
|
| Blind |
Skin Texture |
435 |
0.0870154 |
0.0911476 |
0.0481125 |
0.0389028 |
0.1351279 |
|
| Sighted |
Skin Texture |
435 |
0.0973413 |
0.0586571 |
0.0481125 |
0.0492287 |
0.1454538 |
|
| Blind |
Shape |
435 |
0.1654232 |
0.0012474 |
0.0481125 |
0.1173107 |
0.2135357 |
** |
| Sighted |
Shape |
435 |
0.0824187 |
0.1096387 |
0.0481125 |
0.0343062 |
0.1305313 |
|
| Ground Truth |
Taxonomy |
435 |
0.1206841 |
0.0189161 |
0.0481125 |
0.0725716 |
0.1687966 |
* |