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)

##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 1. The “speaker” analyses are Experiment 1a and the “listener” analyses are Experiment 1b.

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/experiment1/speakers/negatron.html

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

Setting up

Function.

## 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 = 283 participants in speaker condition; n = 120 female and n = 161 male; 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.

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.04 0.01 0.02
0/4 nothing Positive 0.02 0.01 0.01
1/4 item Negative 0.00 0.00 0.00
1/4 item Positive 0.99 0.97 0.98
1/4 nothing Negative 0.47 0.38 0.42
1/4 nothing Positive 0.03 0.01 0.02
2/4 item Negative 0.01 0.00 0.01
2/4 item Positive 0.98 0.95 0.97
2/4 nothing Negative 0.55 0.46 0.50
2/4 nothing Positive 0.03 0.01 0.02
3/4 item Negative 0.01 0.00 0.01
3/4 item Positive 0.97 0.94 0.96
3/4 nothing Negative 0.61 0.52 0.57
3/4 nothing Positive 0.03 0.00 0.01
4/4 item Negative 0.01 0.00 0.00
4/4 item Positive 0.93 0.89 0.91

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=.9, label="True Positive", color="grey", size=5) + 
  annotate("text", x=3, y=.4, 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=2.5, y=.3, label="True Positive", color="grey", size=5) + 
  annotate("text", x=1.75, y=3.75, 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) -1.19 0.22 -5.49 0
dummy.context -4.83 0.29 -16.51 0
numeric.context 2.30 0.25 9.25 0 
#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) -3.20 0.18 -17.42 0
numeric.context 5.59 0.21 26.81 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 3963.5 3989.1 -1977.7   3955.5          
## model.neg.nothing            5 3477.8 3509.9 -1733.9   3467.8 487.63  1
##                           Pr(>Chisq)    
## model.neg.nothing_nodummy               
## model.neg.nothing          < 2.2e-16 ***
## ---
## 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) 6.29 0.37 17.12 0
numeric.context -2.87 0.33 -8.63 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 = 188 participants in listener condition; n = 95 female and n = 92male; n = 1 participant 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.95
FALSE Negative 0.96
TRUE Positive 0.98
TRUE Negative 0.92 
#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 = 186 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 1642.31 1456.11 1542.43
Positive 1/4 False 1390.24 1240.35 1314.22
Positive 1/4 True 1217.88 1084.46 1149.24
Positive 2/4 False 1459.71 1298.78 1380.60
Positive 2/4 True 1255.99 1103.22 1174.98
Positive 3/4 False 1412.85 1249.84 1331.40
Positive 3/4 True 1257.47 1110.17 1181.91
Positive 4/4 True 1328.76 1173.46 1248.52
Negative 0/4 True 1757.86 1586.36 1673.34
Negative 1/4 False 1351.88 1180.03 1261.04
Negative 1/4 True 1436.78 1289.53 1360.13
Negative 2/4 False 1432.41 1284.75 1358.60
Negative 2/4 True 1468.35 1313.80 1391.80
Negative 3/4 False 1417.03 1265.41 1342.56
Negative 3/4 True 1443.91 1278.33 1352.41
Negative 4/4 False 1398.25 1245.77 1320.76

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, 1.3, "", ""),
                      y = c(1700, 1200, "", ""),
                       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) 1482.80 42.04 35.27
text.conditionNegative -205.14 37.22 -5.51
truth.valueTRUE -371.51 37.13 -10.00
numeric.context -237.61 43.17 -5.50
text.conditionNegative:truth.valueTRUE 691.54 53.25 12.99
text.conditionNegative:numeric.context 310.38 60.94 5.09
truth.valueTRUE:numeric.context 366.44 60.66 6.04
text.conditionNegative:truth.valueTRUE:numeric.context -838.51 86.67 -9.68

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) 1371.56 49.54 27.69
dummy.context 331.31 54.06 6.13
numeric.context -4.01 74.28 -0.05 
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) 1113.85 44.31 25.14
numeric.context 123.28 54.27 2.27

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 = 7.0343, df = 6, p-value = 0.0004124
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.7165720 0.9901375
## sample estimates:
##       cor 
## 0.9443809
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 = 6.26, df = 5, p-value = 0.001526
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  0.6487303 0.9915805
## sample estimates:
##       cor 
## 0.9417257

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.75, y=1750, label="R^2 == .89", parse=TRUE, color="black", size=5) + 
  annotate("text", x=.85, y=1200, label="True Positive", color="grey50", size=5) + 
  annotate("text", x=1.3, y=1500, 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=.5, y=1450, label="R^2 == .89", 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 = NA), 
        plot.background = element_rect(fill = NA, color = NA), 
        plot.margin = margin(0, 0, 0, 0))

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

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

fullplot()