read in data

d.raw = read.csv("../../data/associations_ppdetails_en_05_01_2015.csv")

lang.codes = read.csv("../../data/language_codes.csv") %>%
  select(ISO639.2BCode, LanguageName)

d.long = d.raw %>%
  gather("association", "word", 7:9) %>%
  mutate(word = gsub("\\bx\\b", "NA", word)) %>% # remove missing words
  spread("association", "word") %>%
  rename(a1 = asso1Clean,
         a2 = asso2Clean,
         a3 = asso3Clean) 

d.clean = d.long %>%
  left_join(lang.codes, by = c("nativeLanguage" = "ISO639.2BCode")) %>%
  filter(nativeLanguage != "eng" & nativeLanguage != "" & nativeLanguage != "99" &
          nativeLanguage != "fla" & nativeLanguage != "can"  & nativeLanguage != "nan"  &
           nativeLanguage != "pun" & nativeLanguage != "nl") %>%
  mutate(LanguageName = ifelse(grepl("^[[:upper:]]+$", nativeLanguage), "English",
                               as.character(LanguageName)),
         LanguageName = as.factor(LanguageName),
         country = ifelse(grepl("^[[:upper:]]+$", nativeLanguage), nativeLanguage, NA),
         country = as.factor(country),
         native.lang = ifelse(LanguageName == "English", "english", "other"),
         native.lang = as.factor(native.lang)) %>%
  select(-nativeLanguage)

# Get second languages and num participants, with greater than N_CUTOFF participants
N_CUTOFF <- 400

lang.dems = d.clean %>%
    group_by(userID, LanguageName, native.lang) %>%
    slice(1) %>%
    group_by(LanguageName, native.lang) %>%
    summarise(n = n()) %>%
    filter(native.lang == "other") %>%
    arrange(-n) %>%
    filter(n > N_CUTOFF) %>%
    select(-native.lang) %>%
    ungroup()

collapse across associates

d.all.ca = d.clean %>%
  filter(LanguageName %in% lang.dems$LanguageName | LanguageName == "English") %>%
  ungroup() %>%
  gather("associate.type", "associate", 6:8) %>%
  filter(cue != "NA" & associate != "NA" ) %>%
  mutate(bigram = paste(cue, associate))

Participant counts

d.all.ca %>%
  select(userID, LanguageName, native.lang) %>%
  distinct() %>%
  group_by(LanguageName,native.lang ) %>%
  summarize(n=n()) %>%
  kable()
LanguageName native.lang n
Dutch other 687
English english 62412
Finnish other 459
French other 601
German other 1176
Italian other 411
Spanish other 1071

x2

from: Manning and Schuetze (1999; pg. 171)

For each cue, compare the distribtion over associates for native and non-native speakers.

x2.scores <- d.all.ca %>%
  group_by(native.lang,cue,associate) %>%
  summarize(n = n()) %>%
  spread(native.lang, n) %>%
  filter(!is.na(english) & !is.na(other)) %>%
  group_by(cue) %>%
  do(x2 = chisq.test(rbind(.$english,.$other))$statistic,
     p = chisq.test(rbind(.$english,.$other))$p.value) %>%
  mutate(x2 = unlist(x2),
         p = unlist(p))

x2 scores

ggplot(x2.scores, aes(x = x2)) +
  geom_histogram() +
  theme_bw() +
  ggtitle("distribution of x2-scores")

Skewed, but log transforming doesn’t really help.

Top x2 scores.

x2.scores %>% 
  arrange(-x2) %>%
  select(cue) %>%
  slice (1:100) %>%
  as.list(.) 
## $cue
##   [1] cob         comprehend  spud        polar       bumble     
##   [6] locate      utensil     cuisine     up          pondering  
##  [11] annual      communicate shoot       confound    fore       
##  [16] there       drop        disgrace    hyphen      frugal     
##  [21] lavatory    embarrass   experiment  flavor      receive    
##  [26] jaguar      dungarees   spare       envious     celebration
##  [31] locale      reindeer    digit       coleslaw    warrant    
##  [36] drowsy      disciple    cents       chlorine    testament  
##  [41] cabin       searching   walk        swipe       sinus      
##  [46] latex       jogging     collision   trip        flamingo   
##  [51] mixer       tango       broom       tablespoon  Superbowl  
##  [56] myself      pesto       pass out    shrub       pancakes   
##  [61] difficulty  street      tricks      pulse       macaroni   
##  [66] terrible    viola       plea        sonnet      feet       
##  [71] components  quick       soy         procession  mourn      
##  [76] kid         possess     Sahara      curl        punctuation
##  [81] prom        stealing    hoover      plates      salami     
##  [86] for sure    hello       mayonnaise  brimstone   stream     
##  [91] snail       allow       tidy        puff        archive    
##  [96] hydrate     sphere      politeness  bashful     buttercup  
## 10050 Levels: a a few a little a lot aardvark abacus abandon ... zucchini

Many of these seem culture-y.

Predicting divergence

Now let’s see if we can predict the x2-score based on characteristics of the cue.

Join x2.scores and cues characteristics

cues.chars = read.csv ("data/cues_chars.csv")

x2.scores.full = x2.scores %>%
  left_join(cues.chars)

Frequency

Does frequency of cue predict mean t for a cue?

freq.x2s =  x2.scores.full %>%
  select(cue, x2, Lg10WF) %>%
  distinct() %>%
  filter(!is.na(Lg10WF))

ggplot(freq.x2s, aes(x = Lg10WF, y = x2)) +
  geom_smooth(method  = "lm") +
  theme_bw()

freq.x2s %>%
  ungroup() %>%
  do(tidy(cor.test(.$x2, .$Lg10WF))) %>%
  select(estimate, statistic, p.value) %>%
  kable()
estimate statistic p.value
-0.066198 -6.327729 0

Less divergence for high frequency items. But clearly not the whole effect.

Sentiment - Quant

Does sentiment of cue predict mean x2 for a cue? Sentiments from: Finn Arup Nielse

quantsent.x2s =  x2.scores.full %>%
  select(cue, x2, quant.sent) %>%
  distinct()

ggplot(quantsent.x2s, aes(x = quant.sent, y = x2)) +
  geom_smooth(method  = "lm") +
  theme_bw()

quantsent.x2s %>%
  ungroup() %>%
  do(tidy(cor.test(.$x2, .$quant.sent))) %>%
  select(estimate, statistic, p.value) %>%
  kable()
estimate statistic p.value
-0.0722092 -2.358227 0.0185431

More divergence for negative cues.

Sentiment - Qual

Sentiments from NRC Emotion Lexicon from Saif Mohammad and Peter Turney (n ~7000, but some have more than one category)

qual.sent.x2s =x2.scores.full %>%
  select(cue, x2, qual.sent) %>%
  distinct() %>%
  filter(!is.na(qual.sent)) %>%
  group_by(qual.sent) %>%
  multi_boot_standard(column = "x2")

ggplot(qual.sent.x2s, aes(fill = qual.sent, y = mean, x = reorder(qual.sent, mean))) +
    xlab("sentiment") +
    ylab("x2") +
    geom_bar(stat = "identity", position = "dodge") +
    geom_linerange(aes(ymax = ci_upper, ymin=ci_lower),
                 position = position_dodge(width = .9)) +
    theme_bw() +
    theme(legend.position="none",
          axis.text.x = element_text(angle = 90, hjust = 1))

Hard to interpret?

Part of speech

Does pos of cue predict mean x2 for a cue?

pos.x2s =  x2.scores.full %>%
  select(cue, x2, pos) %>%
  distinct() %>%
  filter(!is.na(pos)) %>%
  group_by(pos) %>%
  multi_boot_standard(column = "x2")

ggplot(pos.x2s, aes(fill = pos, y = mean, x = reorder(pos, mean))) +
    xlab("pos") +
    ylab("x2") +
    geom_bar(stat = "identity", position = "dodge") +
    geom_linerange(aes(ymax = ci_upper, ymin=ci_lower),
                 position = position_dodge(width = .9)) +
    theme_bw() +
    theme(legend.position="none",
          axis.text.x = element_text(angle = 90, hjust = 1))

Not much going on with part of speech.

Concreteness

Does concreteness of cue predict x2 for a cue?

conc.x2s =  x2.scores.full %>%
  select(cue, x2, Conc.M) %>%
  distinct()

ggplot(conc.x2s, aes(x = Conc.M, y = x2)) +
  geom_point() +
  geom_smooth(method  = "lm") +
  theme_bw()

conc.x2s %>%
  ungroup() %>%
  do(tidy(cor.test(.$x2, .$Conc.M))) %>%
  select(estimate, statistic, p.value) %>%
  kable()
estimate statistic p.value
0.1220992 11.66807 0

Effect of concreteness in the opposeite direction – More difference for cues that are more concrete.

What’s the relationship between ts and x2?

t.scores = read.csv("data/t.scors.by.cue.filtered.csv") %>%
  select(-1)

x2.scores = x2.scores %>%
  left_join(t.scores)

ggplot(x2.scores, aes(x = abs(t), y = x2)) +
  geom_point() +
  geom_smooth(method  = "lm") +
  theme_bw()

x2.scores %>%
  ungroup() %>%
  do(tidy(cor.test(.$x2, abs(.$t)))) %>%
  select(estimate, statistic, p.value) %>%
  kable()
estimate statistic p.value
0.0132916 1.324149 0.1854842

t and x2 are weakly correlated.