library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(ggplot2)
library(lme4)
## Loading required package: Matrix
library(bootstrap)
library(grid)
library(knitr)
library(viridis)
## Loading required package: viridisLite

Quick Summary

Analyses for Nordmeyer & Frank, “Negation is only hard to process when it is not relevant or informative”. Details about these experiments can be found at https://github.com/anordmey/negatron.

This document describes the analyses and findings for Experiment 2. The “speaker” analyses are Experiment 2a and the “listener” analyses are Experiment 2b.

Participants were randomly assigned to be either speakers or listeners. Context condition indicates the proportion of characters holding items (e.g., how many of the four boys were holding apples). Context varied within subjects.

This is an example of what a trial looked like:

The experiments can be viewed here:

Speakers: http://anordmey.github.io/negatron/experiments/experiment2/speakers/negatron.html

Listeners: http://anordmey.github.io/negatron/experiments/experiment2/listeners/negatron.html

Setting up

Functions.

## number of unique subs
n.unique <- function (x) {
  length(unique(x))
}

#for bootstrapping 95% confidence intervals
theta <- function(x,xdata) {mean(xdata[x])}
ci.low <- function(x) {
  quantile(bootstrap(1:length(x),1000,theta,x)$thetastar,.025)}
ci.high <- function(x) {
  quantile(bootstrap(1:length(x),1000,theta,x)$thetastar,.975)}

Speaker condition

Prep speaker data

Load in data:

##Load in speaker data
d.speakers <- read.csv("./data/speakers_long.csv")
d.speakers$subid <- as.factor(d.speakers$subid)

genders <- d.speakers %>%
  group_by(gender) %>%
  summarize(n = n.unique(subid))

n = 233 participants in speaker condition; n = 122 female and n = 111 male.

Recode context. Context was initially coded as # of context characters with target item. Here we recode as total number of characters (including referent) with target items.

d.speakers$recode.context <- paste(as.character(d.speakers$context.condition),"/4",sep = "")
d.speakers[d.speakers$trial.type == "item",]$recode.context <- paste(as.character(d.speakers[d.speakers$trial.type == "item",]$context.condition + 1),"/4",sep="")
d.speakers$recode.context <- factor(d.speakers$recode.context)

Simplify coding scheme. In the initial coding scheme, we had multiple codes:
Several negation codes (empty, no, not, nothing, without, zero).
Several positive codes (“othernoun” is descriptions of a noun other than the target noun, e.g. “Bob has a table”).
Several other codes (“body” is descriptions of the character’s body, “clothing” is descriptions of the character’s clothing).

In the paper, we use a more conservative coding scheme, to strictly parallell the sentences seen in the listener condition.
Only instances of “no x” are coded as “negation”.
Only descriptions of the target objects are coded as “noun”.
Everything else is coded as “other”.

#toggling the commented lines will let you see how the data looks if you include other instances of negation. A discussion of how this influences the findings can be found in the speaker results section of the paper.
d.speakers$code.cat <- "Other"
d.speakers[d.speakers$coding == "no",]$code.cat <- "Negation"
#d.speakers[d.speakers$coding == "not",]$code.cat <- "Negation"
#d.speakers[d.speakers$coding == "without",]$code.cat <- "Negation"
#d.speakers[d.speakers$coding == "zero",]$code.cat <- "Negation"
#d.speakers[d.speakers$coding == "nothing",]$code.cat <- "Negation"
d.speakers[d.speakers$coding == "noun",]$code.cat <- "Noun"
d.speakers$code.cat <- factor(d.speakers$code.cat)

Speaker Plots

Table of mean probabilities:

##Means by subject
ms.speakers <- bind_rows(
  d.speakers %>% 
    group_by(recode.context, trial.type, subid) %>%
    summarise(count = mean(code.cat == "Negation"), code.cat = "Negative"),
  d.speakers %>% 
    group_by(recode.context, trial.type, subid) %>%
    summarise(count = mean(code.cat == "Noun"), code.cat = "Positive")
) %>%
  group_by(recode.context, trial.type, code.cat) %>%
  summarise(m.cih = ci.high(count),
            m.cil = ci.low(count),
            m = mean(count))

names(ms.speakers) <- c("context","trial.type","sentence.type","m.cih","m.cil","m")
ms.speakers$sentence.type <- factor(ms.speakers$sentence.type, levels=c("Negative","Positive"))

kable(ms.speakers, digits = 2)
context trial.type sentence.type m.cih m.cil m
0/4 nothing Negative 0.01 0.00 0.01
0/4 nothing Positive 0.01 0.00 0.01
1/4 item Negative 0.00 0.00 0.00
1/4 item Positive 0.95 0.91 0.93
1/4 nothing Negative 0.11 0.07 0.09
1/4 nothing Positive 0.02 0.00 0.01
2/4 item Negative 0.00 0.00 0.00
2/4 item Positive 0.68 0.58 0.63
2/4 nothing Negative 0.20 0.13 0.16
2/4 nothing Positive 0.01 0.00 0.00
3/4 item Negative 0.01 0.00 0.00
3/4 item Positive 0.59 0.49 0.54
3/4 nothing Negative 0.49 0.39 0.44
3/4 nothing Positive 0.02 0.01 0.01
4/4 item Negative 0.00 0.00 0.00
4/4 item Positive 0.45 0.35 0.40

Probability of producing a negative sentence on nothing trials (e.g., “no apples” when you see a person with nothing) or a positive sentence on item trials (e.g., “apples” when you see a person with apples):

ggplot(data = subset(ms.speakers, 
                     (sentence.type == "Negative" & trial.type == "nothing") |
                       (sentence.type == "Positive" & trial.type == "item")),
       aes(color=sentence.type, y=m, x=context)) +
  geom_line(aes(group = sentence.type), size = 1) +
  geom_linerange(aes(ymin = m.cil, ymax = m.cih), size = 1) +
  ylab("Probability") + 
  xlab("Context Condition") +
  scale_colour_grey(guide=FALSE) +
  annotate("text", x=3.5, y=.75, label="True Positive", color="grey", size=5) + 
  annotate("text", x=1.75, y=.25, label="True Negative", color="black", size=5)  +
  theme_classic(base_size = 18)

Surprisal (-log(prob)) of producing a negative sentence on nothing trials (e.g., “no apples” when you see a person with nothing) or a positive sentence on item trials (e.g., “apples” when you see a person with apples).

ggplot(data = subset(ms.speakers, 
                     (sentence.type == "Negative" & trial.type == "nothing") |
                      (sentence.type == "Positive" & trial.type == "item")),
       aes(color = sentence.type, y = -log(m), x = context)) +
  geom_line(aes(group = sentence.type), size = 1) +
  geom_linerange(aes(ymin = -log(m.cil), ymax = -log(m.cih)), size = 1) +
  ylab("Speaker Surprisal") + 
  xlab("Context Condition") + 
  scale_colour_grey(guide=FALSE) + 
  annotate("text", x=1.75, y=.75, label="True Positive", color="grey", size=5) + 
  annotate("text", x=2, y=5, label="True Negative", color="black", size=5) + 
  theme_classic(base_size = 18)

Speaker Models

First, recode context in two ways. numeric.context is the numeric proportion of characters with target items in the context. dummy.context compares the 0/4 context to all other contexts.

d.speakers$dummy.context <- 0
d.speakers[d.speakers$recode.context == "0/4",]$dummy.context <- 1

d.speakers$numeric.context <- as.numeric(as.character(factor(d.speakers$recode.context, levels=c("0/4","1/4","2/4","3/4","4/4"), labels=c(0, .25, .5, .75, 1))))

Separate analyses of true negs and true pos. Look at effect of context on probability of producing a negative sentence on a nothing trial (e.g. probability of producing true negative sentence):

d.speakers$negation <- 0
d.speakers[d.speakers$code.cat == "Negation",]$negation <- 1

#Random slopes model does not converge
#model with dummy context
model.neg.nothing <- glmer(negation ~ dummy.context + numeric.context
                + (1 | subid)
                + (1 | item),
                data=filter(d.speakers, trial.type == "nothing"), family = "binomial")
kable(summary(model.neg.nothing)$coefficients, digits = 2)
Estimate Std. Error z value Pr(>|z|)
(Intercept) -6.11 0.33 -18.45 0.00
dummy.context -1.19 0.49 -2.43 0.01
numeric.context 7.30 0.41 18.01 0.00 
#model without dummy context
model.neg.nothing_nodummy <- glmer(negation ~ numeric.context
                + (1 | subid)
                + (1 | item),
                data=filter(d.speakers, trial.type == "nothing"), family = "binomial")
kable(summary(model.neg.nothing_nodummy)$coefficients, digits = 2)
Estimate Std. Error z value Pr(>|z|)
(Intercept) -6.41 0.31 -20.40 0
numeric.context 7.76 0.37 20.96 0 
anova(model.neg.nothing_nodummy, model.neg.nothing)
## Data: filter(d.speakers, trial.type == "nothing")
## Models:
## model.neg.nothing_nodummy: negation ~ numeric.context + (1 | subid) + (1 | item)
## model.neg.nothing: negation ~ dummy.context + numeric.context + (1 | subid) + (1 | item)
##                           npar    AIC    BIC  logLik deviance  Chisq Df
## model.neg.nothing_nodummy    4 2176.7 2201.6 -1084.3   2168.7          
## model.neg.nothing            5 2171.5 2202.6 -1080.7   2161.5 7.2287  1
##                           Pr(>Chisq)   
## model.neg.nothing_nodummy              
## model.neg.nothing           0.007175 **
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Look at effect of context on probability of producing a positive sentence about the target item (i.e. “apples”) on item trials.

#Random slopes model does not converge
d.speakers$noun <- 0
d.speakers[d.speakers$code.cat == "Noun",]$noun <- 1

model.pos.item <- glmer(noun ~ numeric.context
                           + (1 | subid)
                           + (1 | item),
                           data=filter(d.speakers, trial.type == "item"), family = "binomial")
kable(summary(model.pos.item)$coefficients, digits = 2)
Estimate Std. Error z value Pr(>|z|)
(Intercept) 4.51 0.24 18.70 0
numeric.context -5.50 0.23 -23.98 0

Listener condition

Prep listener data

Load in data:

##Load in listener data
d.listeners <- read.csv("./data/listeners_long.csv")
d.listeners$subid <- as.factor(d.listeners$subid)

d.listeners$truth.value <- as.numeric(d.listeners$response)
d.listeners[d.listeners$correct == 0,]$truth.value <- 1 - as.numeric(d.listeners[d.listeners$correct == 0,]$response)
d.listeners$truth.value <- as.factor(as.logical(d.listeners$truth.value))

d.listeners$text.condition <- factor(d.listeners$text.condition,levels=c("positive","negative"), labels=c("Positive","Negative"))
d.listeners$response <- factor(d.listeners$response,levels=c("TRUE","FALSE"))

l.genders <- d.listeners %>%
  group_by(gender) %>%
  summarize(n = n.unique(subid))

n = 246 participants in listener condition; n = 124 female and n = 120male; n = 2 participants declined to state their gender.

Recode context. Context was initially coded as # of context characters with target item. Here we recode as total number of characters (including referent) with target items.

tpresent <- d.listeners %>%
  filter((text.condition == "Positive" & response == TRUE) | 
           (text.condition == "Negative" & response == FALSE)) %>%
  mutate(recode.context = paste(as.character((context.condition + 1)), "/4", sep=""))
  
tabsent <- d.listeners %>%
  filter((text.condition == "Negative" & response == TRUE) | 
           (text.condition == "Positive" & response == FALSE)) %>%
  mutate(recode.context = paste(as.character(context.condition), "/4", sep=""))

d.listeners <- rbind(tpresent, tabsent)
d.listeners$recode.context <- as.factor(d.listeners$recode.context)

Look at accuracy across trial types, then remove people with less than 80% accuracy:

#Accuracies across trial types: 
acc <- d.listeners %>%
  group_by(truth.value, text.condition) %>%
  summarize(mean = mean(correct))
kable(acc, digits = 2)
truth.value text.condition mean
FALSE Positive 0.96
FALSE Negative 0.97
TRUE Positive 0.98
TRUE Negative 0.93 
#Now reject anyone with less than 80% correct
propcorrect <- aggregate(correct~subid, data=d.listeners, mean)

reject <- propcorrect[propcorrect$correct < .8,]

for (i in reject$subid) {
    d.listeners<-d.listeners[d.listeners$subid != i,]
}

2 participants were removed for having less than 80% accuracy on the task, leaving n = 244 participants for analysis.

Remove incorrect trials & trim outliers.

#Remove incorrect
d.listeners.c <- d.listeners[d.listeners$correct == 1,]

#LogRT
qplot(data=d.listeners.c, x=rt, geom="histogram")

d.listeners.c$log.rt<-log(d.listeners.c$rt)

#trim outliers outside 3 standard deviations of the log mean
lrt <- d.listeners.c$log.rt
d.listeners.ct <- d.listeners.c[lrt < mean(lrt) + 3*sd(lrt) & lrt > mean(lrt) - 3*sd(lrt),]

qplot(data=d.listeners.ct, x=rt, geom = "histogram")

qplot(data=d.listeners.ct, x=log.rt, geom = "histogram")

Listener Plots

Table of mean RTs:

ms.listeners <- d.listeners.ct %>%
  group_by(subid, text.condition, recode.context, truth.value) %>%
  summarise(rt = mean(rt)) %>%
  group_by(text.condition, recode.context, truth.value) %>%
  summarise(cih = ci.high(rt),
            cil = ci.low(rt),
            rt = mean(rt))

names(ms.listeners) <- c("sentence.type","context","truth.value","rt.cih","rt.cil","rt")
ms.listeners$sentence.type <- factor(ms.listeners$sentence.type, levels = c("Negative", "Positive"))
ms.listeners$truth.value <- factor(ms.listeners$truth.value, levels = c(TRUE, FALSE), labels = c("True", "False"))

kable(ms.listeners, digits = 2)
sentence.type context truth.value rt.cih rt.cil rt
Positive 0/4 False 1735.56 1558.00 1643.33
Positive 1/4 False 1507.42 1360.63 1429.92
Positive 1/4 True 1313.74 1174.11 1242.44
Positive 2/4 False 1478.50 1337.96 1406.37
Positive 2/4 True 1324.52 1192.34 1258.25
Positive 3/4 False 1449.22 1309.05 1381.23
Positive 3/4 True 1399.83 1243.70 1319.92
Positive 4/4 True 1399.80 1247.83 1321.12
Negative 0/4 True 1852.22 1681.03 1764.50
Negative 1/4 False 1445.02 1295.94 1371.34
Negative 1/4 True 1525.72 1385.65 1451.42
Negative 2/4 False 1515.95 1356.52 1435.35
Negative 2/4 True 1487.43 1354.04 1421.16
Negative 3/4 False 1521.14 1362.13 1439.45
Negative 3/4 True 1490.11 1361.59 1427.78
Negative 4/4 False 1493.64 1347.79 1417.10

Plot reaction time:

#quartz()

facet_labels <- c(
  'True' = 'True Sentences', 
  'False' = 'False Sentences'
)

p <- ggplot(data = ms.listeners, aes(colour = sentence.type, y = rt, x = context)) +
  geom_line(aes(group = sentence.type), size = 1) +
  geom_errorbar(aes(ymin = rt.cil, ymax = rt.cih), width = 0, size = 1) +
  facet_wrap(~truth.value, labeller = as_labeller(facet_labels)) +
  scale_y_continuous(name = "RT (ms)", breaks = seq(1000, 2000, 100)) + 
  xlab("Context Condition") + 
  scale_colour_grey(guide= "none") + 
  theme_classic(base_size = 18) + 
  theme(strip.background = element_blank())

text_df <- data.frame(label = c("Negative", "Positive", "", ""),
                      x = c(2.5, 1.5, "", ""),
                      y = c(1700, 1350, "", ""),
                       truth.value =  c("True", "True", "False", "False"), 
                       sentence.type = c("Negative", "Positive", "Negative", "Positive"))
text_df$sentence.type <- factor(text_df$sentence.type, levels = c("Negative", "Positive"))
text_df$truth.value <- factor(text_df$truth.value, levels = c("True", "False"))
text_df$x <- as.numeric(text_df$x)
text_df$y <- as.numeric(text_df$y)

p + geom_text(
  data = text_df, 
  mapping = aes(x = x, y = y, label = label), 
  size = 5
)

Listener Models

First, recode context in two ways. numeric.context is the numeric proportion of characters with target items in the context. dummy.context compares the 0/4 context to all other contexts.

d.listeners.ct$truth.value <- factor(d.listeners.ct$truth.value,levels = c("FALSE","TRUE"))
d.listeners.ct$numeric.context <- as.numeric(as.character(factor(d.listeners.ct$recode.context, levels = c("0/4","1/4","2/4","3/4","4/4"), labels = c("0",".25",".5",".75","1"))))

d.listeners.ct$dummy.context <- 0
d.listeners.ct[d.listeners.ct$recode.context == "0/4",]$dummy.context <- 1

Look at interaction between context, sentence type, and truth value.

model1 <- lmer(rt ~ text.condition*truth.value*numeric.context 
       + (text.condition*truth.value |subid)
       + (text.condition*truth.value |item),
       data = d.listeners.ct)

kable(summary(model1)$coefficients, digits = 2)
Estimate Std. Error t value
(Intercept) 1597.74 40.80 39.16
text.conditionNegative -204.88 38.23 -5.36
truth.valueTRUE -383.75 36.32 -10.57
numeric.context -340.63 41.87 -8.14
text.conditionNegative:truth.valueTRUE 662.84 54.49 12.16
text.conditionNegative:numeric.context 377.31 59.00 6.40
truth.valueTRUE:numeric.context 453.81 58.83 7.71
text.conditionNegative:truth.valueTRUE:numeric.context -900.60 83.46 -10.79

Effect of context on true negative sentences:

model2 <- lmer(rt ~ dummy.context + numeric.context
               + (dummy.context + numeric.context | subid)
               + (dummy.context + numeric.context  | item),
               data = subset(d.listeners.ct, text.condition == "Negative" & truth.value == TRUE))

kable(summary(model2)$coefficients, digits = 2)
Estimate Std. Error t value
(Intercept) 1454.14 53.57 27.15
dummy.context 307.12 60.15 5.11
numeric.context -40.61 72.77 -0.56 
model3 <- lmer(rt ~ numeric.context
               + (numeric.context | subid)
               + (numeric.context | item),
               data = subset(d.listeners.ct, text.condition == "Positive" & truth.value == TRUE))
kable(summary(model3)$coefficients, digits = 2)
Estimate Std. Error t value
(Intercept) 1213.02 41.64 29.13
numeric.context 110.85 48.59 2.28

Compare Speakers and Listeners

Only look at true sentences:

ms.listeners <- ms.listeners[ms.listeners$truth.value == "True",]
ms.listeners <- ms.listeners[,c("context","sentence.type","rt","rt.cih","rt.cil")]

ms.speakers <- subset(ms.speakers, (sentence.type == "Negative" & trial.type == "nothing") | (sentence.type == "Positive" & trial.type == "item"))

Calculate surprisal for speakers:

ms.speakers$surprisal <- -log(ms.speakers$m)
ms.speakers$surprisal.cih <- -log(ms.speakers$m.cih)
ms.speakers$surprisal.cil <- -log(ms.speakers$m.cil)

ms.speakers <- ms.speakers[,c("context","sentence.type","surprisal","surprisal.cih","surprisal.cil")]

Merge together:

data.ms <- merge(ms.listeners, ms.speakers)

Correlation between RT and surprisal, with and without 0/4 context:

cor.test(data.ms$rt, data.ms$surprisal)
## 
##  Pearson's product-moment correlation
## 
## data:  data.ms$rt and data.ms$surprisal
## t = 9.1247, df = 6, p-value = 9.741e-05
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.8175151 0.9939911
## sample estimates:
##       cor 
## 0.9658059
data.trimmed <- subset(data.ms, context != "0/4")
cor.test(data.trimmed$rt, data.trimmed$surprisal)
## 
##  Pearson's product-moment correlation
## 
## data:  data.trimmed$rt and data.trimmed$surprisal
## t = 3.5365, df = 5, p-value = 0.01662
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.2535434 0.9766444
## sample estimates:
##      cor 
## 0.845221

Plot correlation:

mainplot <- ggplot(data.ms, aes(color=sentence.type, y=rt, x=surprisal)) + 
  geom_pointrange(aes(ymin=rt.cil, ymax=rt.cih), size=.1) + 
  geom_errorbarh(aes(xmin=surprisal.cil, xmax=surprisal.cih), size=.1) +    
  geom_point(aes(color=sentence.type)) + 
  geom_smooth(method="lm", lty="dotted", color="grey60", fill="grey") + 
  #geom_smooth(data=data.trimmed, method="lm", lty="dotted", color="gray10", fill="gray30") + 
  geom_text(aes(label=data.ms$context), hjust=-0.1, vjust=0, size=4.5) +
  #annotate("text", x=.75, y=1525, label="R^2 == .71", parse=TRUE, color="black", size=3.5) + 
  annotate("text", x=2.5, y=1650, label="R^2 == .93", parse=TRUE, color="black", size=5) + 
  annotate("text", x=.85, y=1200, label="True Positive", color="grey50", size=5) + 
  annotate("text", x=1.9, y=1550, label="True Negative", color="black", size=5) +  
  ylab("Listener Reaction Time (ms)") +  xlab("Speaker Surprisal") + 
  scale_colour_manual(values=c("black","grey50"), guide=FALSE) + 
  theme_classic(base_size = 18)

subplot <- ggplot(data.trimmed, aes(color=sentence.type, y=rt, x=surprisal)) +
  geom_pointrange(aes(ymin=rt.cil, ymax=rt.cih), size=.1) + 
  geom_errorbarh(aes(xmin=surprisal.cil, xmax=surprisal.cih), size=.1) +    
  geom_point(aes(color=sentence.type)) + 
  geom_smooth(method="lm", lty="dotted", color="grey60", fill="grey") + 
  geom_text(aes(label=data.trimmed$context), hjust=-0.1, vjust=0, size=4) +
  annotate("text", x=1.25, y=1550, label="R^2 == .71", parse=TRUE, color="black", size=4) + 
  #annotate("text", x=.75, y=1200, label="True Positive", color="grey50", size=3.5) + 
  #annotate("text", x=2, y=1300, label="True Negative", color="black", size=3.5) +  
  ylab("") +  xlab("") + 
  scale_colour_manual(values=c("black","grey50"), guide=FALSE) + 
  theme(panel.border = element_rect(fill = NA),
        panel.background = element_rect(fill = "white"))

vp <- viewport(width = 0.4, height = 0.4, x = .8, y = .35)

fullplot <- function() {
  print(mainplot)
  print(subplot, vp = vp)
 }

fullplot()

Follow up analysis: 0/4 speaker context

What are people talking about in the 0/4 context? Follow-up analysis in Experiment 2a.

d.speakers$code.cat2 <- "Other"
d.speakers[d.speakers$coding == "noun",]$code.cat2 <- "has [target item]"
d.speakers[d.speakers$coding == "no",]$code.cat2 <- "Negation (has no [target item])"
d.speakers[d.speakers$coding == "not",]$code.cat2 <- "Negation (other)"
d.speakers[d.speakers$coding == "without",]$code.cat2 <- "Negation (other)"
d.speakers[d.speakers$coding == "zero",]$code.cat2 <- "Negation (other)"
d.speakers[d.speakers$coding == "nothing",]$code.cat2 <- "Negation (other)"
d.speakers[d.speakers$coding == "color",]$code.cat2 <- "Color"
d.speakers$code.cat2 <- factor(d.speakers$code.cat2)

d.speakers_coding <- d.speakers %>%
  group_by(recode.context, trial.type, code.cat2) %>%
  summarize(n = n()) %>%
  mutate(freq = n / sum(n), 
         trial.type = factor(trial.type, levels = c("item", "nothing"), labels = c("Referent has item", "Referent has nothing")))

ggplot(d.speakers_coding, aes(x = recode.context, y = freq, fill = code.cat2)) +
  facet_wrap( ~ trial.type) +
  geom_bar(stat = "identity") +
  labs(x = "Context", y = "Frequency", fill = "Response Type") +
  scale_fill_viridis(discrete = T) +
  theme_classic(base_size = 16)

#Did speakers refer to color at all? This only slightly changes the proportions (e.g. a few participants are describing color AND negation e.g. "has a red shirt and no apples")
d.speakers_color <- d.speakers %>%
  group_by(recode.context, trial.type, color) %>%
  summarize(n = n()) %>%
  mutate(freq = n / sum(n), 
         color = factor(color, levels = c(1, 0), labels = c("described color", "did not describe color")), 
         trial.type = factor(trial.type, levels = c("item", "nothing"), labels = c("Referent has item", "Referent has nothing")))

ggplot(d.speakers_color, aes(x = recode.context, y = freq, fill = color)) +
  geom_bar(stat = "identity") +
  facet_wrap(~ trial.type) +
  labs(x = "Context", y = "Frequency", fill = "Response Type") +
  theme_classic(base_size = 18)

kable(d.speakers_coding)
recode.context trial.type code.cat2 n freq
0/4 Referent has nothing Color 833 0.8937768
0/4 Referent has nothing has [target item] 5 0.0053648
0/4 Referent has nothing Negation (has no [target item]) 6 0.0064378
0/4 Referent has nothing Negation (other) 18 0.0193133
0/4 Referent has nothing Other 70 0.0751073
1/4 Referent has item Color 35 0.0375536
1/4 Referent has item has [target item] 870 0.9334764
1/4 Referent has item Negation (other) 5 0.0053648
1/4 Referent has item Other 22 0.0236052
1/4 Referent has nothing Color 734 0.7875536
1/4 Referent has nothing has [target item] 8 0.0085837
1/4 Referent has nothing Negation (has no [target item]) 83 0.0890558
1/4 Referent has nothing Negation (other) 27 0.0289700
1/4 Referent has nothing Other 80 0.0858369
2/4 Referent has item Color 326 0.3497854
2/4 Referent has item has [target item] 585 0.6276824
2/4 Referent has item Negation (other) 2 0.0021459
2/4 Referent has item Other 19 0.0203863
2/4 Referent has nothing Color 659 0.7070815
2/4 Referent has nothing has [target item] 4 0.0042918
2/4 Referent has nothing Negation (has no [target item]) 153 0.1641631
2/4 Referent has nothing Negation (other) 34 0.0364807
2/4 Referent has nothing Other 82 0.0879828
3/4 Referent has item Color 403 0.4324034
3/4 Referent has item has [target item] 507 0.5439914
3/4 Referent has item Negation (has no [target item]) 2 0.0021459
3/4 Referent has item Negation (other) 3 0.0032189
3/4 Referent has item Other 17 0.0182403
3/4 Referent has nothing Color 372 0.3991416
3/4 Referent has nothing has [target item] 11 0.0118026
3/4 Referent has nothing Negation (has no [target item]) 408 0.4377682
3/4 Referent has nothing Negation (other) 50 0.0536481
3/4 Referent has nothing Other 91 0.0976395
4/4 Referent has item Color 526 0.5643777
4/4 Referent has item has [target item] 372 0.3991416
4/4 Referent has item Negation (has no [target item]) 1 0.0010730
4/4 Referent has item Negation (other) 5 0.0053648
4/4 Referent has item Other 28 0.0300429 
kable(d.speakers_color)
recode.context trial.type color n freq
0/4 Referent has nothing did not describe color 97 0.1040773
0/4 Referent has nothing described color 835 0.8959227
1/4 Referent has item did not describe color 782 0.8390558
1/4 Referent has item described color 150 0.1609442
1/4 Referent has nothing did not describe color 192 0.2060086
1/4 Referent has nothing described color 740 0.7939914
2/4 Referent has item did not describe color 495 0.5311159
2/4 Referent has item described color 437 0.4688841
2/4 Referent has nothing did not describe color 246 0.2639485
2/4 Referent has nothing described color 686 0.7360515
3/4 Referent has item did not describe color 438 0.4699571
3/4 Referent has item described color 494 0.5300429
3/4 Referent has nothing did not describe color 531 0.5697425
3/4 Referent has nothing described color 401 0.4302575
4/4 Referent has item did not describe color 353 0.3787554
4/4 Referent has item described color 579 0.6212446