Experiment 3 was designed to eliminate the potential confounds of Experiment 2’s design by comparing extraction from RCs in three different environments: the pivot of an existential, within a predicate nominal, and within a transitive object.
This experiment returns to the length by complexity design utilized by Sprouse, Wagers, and Phillips (2012) and adds an additional environment factor with three levels, shown below. This resulted in a 3×2×2 design, with 12 conditions per item. A sample item is shown in 2.
# Pull in formatted results
raw_results_mt <- read.csv("results_mturk/20180704/20180704_results_formatted_fixed.csv")
# Rename 1st column header b/c of excel issue
colnames(raw_results_mt)[1] <- "date_received"
# Make subject a factor
raw_results_mt$subject %<>% as.factor
# Separate experiment and filler data
raw_results_mt %>% subset(item_type == "experimental") %>% droplevels -> experiment_data_mt
raw_results_mt %>% subset(item_type == "filler") %>% droplevels -> filler_data_mt
The following table summarizes the ratings data for each participant (based on filler sentences only), including the mean ratings they gave to expected grammatical fillers and expected ungrammatical fillers.
# Look at the results by participant, get means for both grammatical and ungrammatical fillers
filler_data_mt %>% group_by(subject) %>%
summarize(mean_rating = mean(rating),
sd_rating = sd(rating),
n = n(),
se_rating = sd_rating/sqrt(n),
mean_gramm = mean(rating[expected_gramm == "gramm"]),
mean_ungramm = mean(rating[expected_gramm == "ungramm"])) -> worker_summary
print(worker_summary)
Participants will be excluded whose average rating for ungrammatical fillers is greater than or equal to their average rating for grammatical fillers. The following code chunk identifies these participants.
worker_summary %>% subset(mean_ungramm >= mean_gramm) -> excluded_1
print(excluded_1)
Here’s a visual representation of the participants’ average filler ratings. Each point represents the average z-scores for a participant’s grammatical/ungrammatical filler ratings. Participants 377 and 387 stand out since the red point (average z-scored rating for grammatical fillers) is below the blue point (for ungrammatical fillers).
filler_data_mt %>%
group_by(subject) %>%
mutate(z_score = scale(rating)) %>%
group_by(subject, expected_gramm) %>%
summarize(mean_z_score = mean(z_score)) %>%
ggplot(aes(y = mean_z_score,
x = subject)) +
geom_point(aes(col = expected_gramm)) +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5))
The following table summarizes the average ratings for each condition.
# Remove data from subjects 377, 387 in the raw data
raw_results_mt %>% subset(subject != "377") %>% subset(subject != "387") %>% droplevels -> raw_results_mt_cln
# ...then separate fillers and experimental sentences
raw_results_mt_cln %>% subset(item_type == "experimental") %>% droplevels -> experiment_data_mt_cln
raw_results_mt_cln %>% subset(item_type == "filler") %>% droplevels -> filler_data_mt_cln
# Reorder context factor levels to mirror discussion (object, predicate, existential)
experiment_data_mt_cln$context <- relevel(experiment_data_mt_cln$context, "predicate")
experiment_data_mt_cln$context <- relevel(experiment_data_mt_cln$context, "object")
# Reorder dep_length factor levels to standard (baseline first)
experiment_data_mt_cln$dep_length <- relevel(experiment_data_mt_cln$dep_length, "short")
# Reorder ec_type factor levels to standard (baseline first)
experiment_data_mt_cln$ec_type <- relevel(experiment_data_mt_cln$ec_type, "non-island")
# Make sure ratings data is numeric so it can be averaged
experiment_data_mt_cln$rating %<>% as.numeric
# Group together by conditions to get averages for each condition
experiment_data_mt_cln %>% group_by(context, ec_type, dep_length) %>%
summarize(mean_rating = mean(rating),
sd_rating = sd(rating),
n = n(),
se_rating = sd_rating/sqrt(n)) -> descriptive_summary_mt
# Save this summary for use in external scripts
# saveRDS(descriptive_summary_mt, file="expt3_descriptive_summary.rds")
print(descriptive_summary_mt)
The following table visualizes the ratings data. Error bars represent standard errors.
descriptive_summary_mt %>%
ggplot(aes(x = dep_length,
y = mean_rating,
ymin = 1,
ymax = 6,
colour = ec_type,
group = ec_type)) -> descriptive_plot_mt
descriptive_plot_mt + facet_grid(.~context) +
labs(title = "Ratings by context (MTurk)",
x = "Dependency length",
y = "Mean rating",
colour = "Dependency length") +
scale_color_discrete("Embedded clause type", labels = c("island", "non-island")) +
geom_errorbar(aes(ymin = mean_rating - se_rating,
ymax = mean_rating + se_rating),
width = 0.15) +
geom_point(aes(col = ec_type),
size = 2) +
scale_y_continuous(breaks = seq(1:6)) +
theme(panel.grid.minor = element_blank()) -> descriptive_plot_mt
print(descriptive_plot_mt)
The following code z-scores the ratings so that they are comparable across experiments. To do this, we start with both experimental and filler data, and group by subject. Each subject’s rating is then z-scored, and the z-scores for each condition are averaged after ungrouping by subject.
# Copy the data to a new data frame for safe-keeping of the original
raw_results_mt_cln -> raw_results_mt_cln_shrt
# Paste the ec_type and dep_length columns together so that conditions (ignoring context) are represented by a single cell in the data frame
raw_results_mt_cln_shrt$ec_typeXdep_length <- paste(raw_results_mt_cln_shrt$ec_type, "x", raw_results_mt_cln_shrt$dep_length)
# Get z-scores
raw_results_mt_cln_shrt %>%
group_by(subject) %>% # Group raw results by subject
mutate(z_rating = scale(rating)) %>% # Get z-scores for each subject's ratings
ungroup %>% # Bring subjects back together
subset(item_type == "experimental") %>% droplevels %>% # Remove fillers
group_by(context, ec_typeXdep_length, item_set) %>% # Group by condition and item set
summarize(mean_z_rating = mean(z_rating)) %>% # Get the mean z-score for each condition per item set
group_by(context, ec_typeXdep_length) %>% # Group this summary by condition
summarize(mean_z_ratings = mean(mean_z_rating)) -> summary_zscores # Get the mean of the mean z-scores
print(summary_zscores)
Now, we’ll calculate the DDs using the summary table from above. Subtracting the island|long average from the non-island|long average yields the combined cost of complexity and extracting out of an island. This difference is called D1. Subtracting the island|short average from the non-island|short average yields D2, which represents the isolated cost of complexity. D1-D2 then yields the isolated cost of extracting out of the island. Each difference is given for each environment considered in this experiment.
# Make table for DDs by making the conditions into columns & filling in the cells with the avg'd z-scores
z_DDs <- summary_zscores %>% spread(ec_typeXdep_length, mean_z_ratings)
# Calculate differences
z_DDs$D1 <- z_DDs$`non-island x long` - z_DDs$`island x long`
z_DDs$D2 <- z_DDs$`non-island x short` - z_DDs$`island x short`
z_DDs$DD <- z_DDs$D1 - z_DDs$D2
# Make the column names shorter so they'll all fit in the same table
colnames(z_DDs)[colnames(z_DDs) == "island x long"] <- "isl x long"
colnames(z_DDs)[colnames(z_DDs) == "island x short"] <- "isl x shrt"
colnames(z_DDs)[colnames(z_DDs) == "non-island x long"] <- "nonisl x long"
colnames(z_DDs)[colnames(z_DDs) == "non-island x short"] <- "nonisl x shrt"
options(digits = 3)
print(z_DDs)
Set the contrasts appropriately for each factor
# Helmert contrast for three-level factor
contrasts(experiment_data_mt_cln$context) <- "contr.helmert"
# Assigning contrasts in above way doesn't group the factors appropriately (it would be more appropriate to group existential and predicate factors together, and to compare the two of these to the object factor)
# Assign contrasts manually (the first row is fine; I want to switch the second and third rows' values)
contrasts(experiment_data_mt_cln$context)[1,] <- c(0, 2)
contrasts(experiment_data_mt_cln$context)[2,] <- c(1, -1)
contrasts(experiment_data_mt_cln$context)[3,] <- c(-1, -1)
# Relabel contrast column names for context factor
dimnames(contrasts(experiment_data_mt_cln$context))[[2]] <- c("BE", "TRANSITIVITY")
# Check again
contrasts(experiment_data_mt_cln$context)
BE TRANSITIVITY
object 0 2
predicate 1 -1
exist -1 -1
# Fix contrasts for dep_length factor
contrasts(experiment_data_mt_cln$dep_length) <- c(-0.5, 0.5)
# Check
contrasts(experiment_data_mt_cln$dep_length)
[,1]
short -0.5
long 0.5
# Fix contrasts for ec_type factor
contrasts(experiment_data_mt_cln$ec_type) <- c(-0.5, 0.5)
# Check
contrasts(experiment_data_mt_cln$ec_type)
[,1]
non-island -0.5
island 0.5
# Make ratings a factor
experiment_data_mt_cln$rating %<>% as.factor
experiment_data_mt_cln$subject %<>% as.factor
# Save data for use elsewhere
saveRDS(experiment_data_mt_cln, "expt3_data_cln.rds")
# Simple effects analysis
timeinit <- Sys.time()
clm(rating ~ context * dep_length * ec_type, data = experiment_data_mt_cln) -> clm_analysis_expt3_mt
timeend <- Sys.time()
timeend - timeinit
Time difference of 1.07 secs
summary(clm_analysis_expt3_mt)
formula: rating ~ context * dep_length * ec_type
data: experiment_data_mt_cln
Coefficients:
Estimate Std. Error z value Pr(>|z|)
contextBE -0.4029 0.0544 -7.41 1.3e-13 ***
contextTRANSITIVITY -0.2428 0.0312 -7.78 7.4e-15 ***
dep_length1 -0.9581 0.0895 -10.70 < 2e-16 ***
ec_type1 -0.4736 0.0882 -5.37 7.9e-08 ***
contextBE:dep_length1 0.2519 0.1078 2.34 0.019 *
contextTRANSITIVITY:dep_length1 0.0465 0.0618 0.75 0.452
contextBE:ec_type1 0.2143 0.1077 1.99 0.047 *
contextTRANSITIVITY:ec_type1 -0.0786 0.0618 -1.27 0.203
dep_length1:ec_type1 -0.7264 0.1760 -4.13 3.7e-05 ***
contextBE:dep_length1:ec_type1 0.0554 0.2153 0.26 0.797
contextTRANSITIVITY:dep_length1:ec_type1 -0.2808 0.1236 -2.27 0.023 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Threshold coefficients:
Estimate Std. Error z value
1|2 -2.6015 0.0922 -28.23
2|3 -1.2755 0.0606 -21.06
3|4 -0.4613 0.0527 -8.75
4|5 0.3668 0.0523 7.02
5|6 1.3992 0.0626 22.37
The following code chunk was run on the UCSC hummingbird cluster using the data saved above.
# Read in the data saved from personal computer
readRDS("expt3_data_cln.rds") -> expt3_data_cln
# Perform a mixed effects analysis by subjects and by items
clmm(data = expt3_data_cln,
formula = rating ~ context * ec_type * dep_length +
(1 + context * ec_type * dep_length | subject) +
(1 + context * ec_type * dep_length | item_set)
) -> expt3_clmm_full
# Save clmm analysis
saveRDS(object = expt3_clmm_full, file = "expt3_clmm_full.rds")
The following code chunk summarizes the results of the clmm analysis run on the cluster.
# Pull in full clmm that was run on the hummingbird cluster
readRDS("expt3_clmm_full.rds") -> clmm_3_analysis_expt3
summary(clmm_3_analysis_expt3)
Cumulative Link Mixed Model fitted with the Laplace approximation
formula: rating ~ context * ec_type * dep_length + (1 + context * ec_type *
dep_length | subject) + (1 + context * ec_type * dep_length | item_set)
data: expt3_data_cln
Random effects:
Groups Name Variance Std.Dev. Corr
subject (Intercept) 5.602 2.367
contextobject 2.709 1.646 -0.497
contextpredicate 2.793 1.671 -0.274 0.504
ec_typenon-island 2.555 1.598 -0.365 0.069 0.564
dep_lengthshort 4.942 2.223 -0.491 -0.253 0.242
contextobject:ec_typenon-island 3.833 1.958 0.487 -0.640 -0.406
contextpredicate:ec_typenon-island 3.794 1.948 0.218 -0.363 -0.838
contextobject:dep_lengthshort 2.531 1.591 0.578 -0.519 -0.350
contextpredicate:dep_lengthshort 3.390 1.841 0.179 -0.056 -0.684
ec_typenon-island:dep_lengthshort 3.949 1.987 -0.209 0.192 -0.387
contextobject:ec_typenon-island:dep_lengthshort 5.251 2.291 0.121 0.129 0.046
contextpredicate:ec_typenon-island:dep_lengthshort 8.124 2.850 0.432 -0.107 0.359
item_set (Intercept) 0.587 0.766
contextobject 0.262 0.512 0.202
contextpredicate 0.392 0.626 -0.648 0.279
ec_typenon-island 0.406 0.637 0.742 0.290 -0.084
dep_lengthshort 0.465 0.682 -0.589 0.347 0.798
contextobject:ec_typenon-island 1.234 1.111 -0.861 -0.305 0.614
contextpredicate:ec_typenon-island 0.269 0.519 -0.712 -0.249 0.620
contextobject:dep_lengthshort 0.786 0.887 0.070 -0.821 -0.616
contextpredicate:dep_lengthshort 0.619 0.787 0.688 -0.397 -0.620
ec_typenon-island:dep_lengthshort 0.758 0.871 -0.018 -0.441 0.342
contextobject:ec_typenon-island:dep_lengthshort 5.579 2.362 -0.008 0.278 -0.259
contextpredicate:ec_typenon-island:dep_lengthshort 4.078 2.019 -0.163 0.186 -0.374
0.855
-0.620 -0.324
-0.855 -0.512 0.654
-0.387 -0.277 0.751 0.473
-0.837 -0.633 0.540 0.824 0.490
-0.791 -0.547 0.473 0.723 0.171 0.817
0.158 -0.035 -0.557 -0.295 -0.695 -0.397 -0.430
0.544 0.204 -0.371 -0.578 -0.014 -0.709 -0.904 0.399
-0.184
-0.700 0.650
-0.480 0.175 0.644
-0.362 -0.590 0.111 0.046
0.621 -0.764 -0.704 -0.371 0.353
0.299 0.036 0.275 0.422 0.186 0.266
-0.158 -0.380 -0.441 -0.019 -0.186 0.069 -0.723
-0.662 -0.052 0.061 -0.199 0.182 -0.448 -0.853 0.493
Number of groups: subject 46, item_set 36
Coefficients:
Estimate Std. Error z value Pr(>|z|)
contextBE -0.7346 0.1046 -7.03 2.1e-12 ***
contextTRANSITIVITY -0.4327 0.0626 -6.92 4.7e-12 ***
ec_type1 0.7973 0.1411 5.65 1.6e-08 ***
dep_length1 1.7243 0.2470 6.98 2.9e-12 ***
contextBE:ec_type1 -0.3824 0.1967 -1.94 0.052 .
contextTRANSITIVITY:ec_type1 0.0966 0.1080 0.89 0.371
contextBE:dep_length1 -0.4487 0.1806 -2.49 0.013 *
contextTRANSITIVITY:dep_length1 -0.0781 0.0959 -0.81 0.415
ec_type1:dep_length1 -1.2935 0.2872 -4.50 6.7e-06 ***
contextBE:ec_type1:dep_length1 0.2203 0.3764 0.59 0.558
contextTRANSITIVITY:ec_type1:dep_length1 -0.4544 0.2109 -2.15 0.031 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Threshold coefficients:
Estimate Std. Error z value
1|2 -4.432 0.329 -13.47
2|3 -2.369 0.308 -7.69
3|4 -0.976 0.302 -3.23
4|5 0.552 0.301 1.83
5|6 2.467 0.309 7.99
# Subset the island extraction cases from the data
experiment_data_mt_cln %>%
subset(dep_length == "long" & ec_type == "island") %>%
droplevels %>%
ggplot(aes(rating)) +
geom_histogram(stat = "count") +
facet_grid(.~context) -> resp_dist_hist
Ignoring unknown parameters: binwidth, bins, pad
print(resp_dist_hist)
if('package:dplyr' %in% search()) {
detach(package:dplyr, unload = TRUE)
} else {}
library(plyr)
library(mixtools)
mixtools package, version 1.1.0, Released 2017-03-10
This package is based upon work supported by the National Science Foundation under Grant No. SES-0518772.
library(gridExtra)
filler_data_mt_cln$rating %<>% as.numeric
filler_data_ungramm <- subset(filler_data_mt_cln, expected_gramm == "ungramm")$rating
filler_data_gramm <- subset(filler_data_mt_cln, expected_gramm == "gramm")$rating
experiment_data_mt_cln$rating %<>% as.numeric
data_object <- subset(experiment_data_mt_cln, context == "object" & dep_length == "long" & ec_type == "island")$rating
data_predicate <- subset(experiment_data_mt_cln, context == "predicate" & dep_length == "long" & ec_type == "island")$rating
data_existential <- subset(experiment_data_mt_cln, context == "exist" & dep_length == "long" & ec_type == "island")$rating
## These functions and those defined in following chunks are due to Brian Dillon, via Jed Pizarro-Guevara. ##
# Define functions to create discrete and gradient models.
# create.discrete/gradient returns the parameters of a multinomial distribution over responses.
# It takes grammatical and ungrammatical reference sets (actual data), pi (relative weight of ungrammatical distribution), and N (number of data points to be sampled in estimating the distribution)
# These functions have been modified to work for data on a 6-point Likert scale, instead of 7-point.
create.discrete = function(gram.ref, ungram.ref, pi, num = length(gram.ref), smooth = T) {
samples.discrete = c(
sample(gram.ref, round((1-pi)*num), replace = T),
sample(ungram.ref, round(pi*num), replace = T)
)
if (smooth) {
prob.discrete = (tabulate(samples.discrete, nbins = 6)+1)/(length(samples.discrete)+6)
} else {
prob.discrete = (tabulate(samples.discrete, nbins = 6))/(length(samples.discrete))
}
return(prob.discrete)
}
create.gradient = function(gram.ref, ungram.ref, pi, num = length(gram.ref), smooth = T) {
samples.gradient = round(
(1-pi)*sample(gram.ref, num, replace = T)+pi*sample(ungram.ref, num, replace = T)
)
if (smooth) {
prob.gradient = (tabulate(samples.gradient, nbins = 6)+1)/(length(samples.gradient)+6)
} else {
prob.gradient = (tabulate(samples.gradient, nbins = 6))/(length(samples.gradient))
}
return(prob.gradient)
}
# Define functions to determine the fit of a given value of pi for the dataset
# fit.gradient/discrete.pi is a function used to maximize pi parameter given a dataset. It takes the same parameters as the mixture creating functions, plus a test parameter. Test is the test distribution to be modeled.
# fit.gradient/discrete.pi returns the RMSD (root-mean-square deviation) between the mean of the mixture and admixture model and the empirical mean of the test distribution.
fit.gradient.pi = function(pi, gram.ref, ungram.ref, test) {
gradient.model = create.gradient(gram.ref, ungram.ref, pi, smooth = F)
gradient.mean = sum(gradient.model*c(1:6))
test.mean = mean(test)
rmsd = (gradient.mean-test.mean)^2
return(rmsd)
}
fit.discrete.pi = function(pi, gram.ref, ungram.ref, test) {
discrete.model = create.discrete(gram.ref, ungram.ref, pi)
discrete.mean = sum(discrete.model*c(1:6))
test.mean = mean(test)
rmsd = (discrete.mean-test.mean)^2
return(rmsd)
}
# Define the main simulation function
compare.models = function(gram.dist, ungram.dist, test.dist, chisquare = T) {
optim.discrete.pi = optimize(fit.discrete.pi, interval = c(0, 1), gram.ref = gram.dist, ungram.ref = ungram.dist, test = test.dist)
for (i in c(1:5)) {
cur.discrete.pi = optimize(fit.discrete.pi, interval = c(0, 1), gram.ref = gram.dist, ungram.ref = ungram.dist, test = test.dist)
if (cur.discrete.pi$objective < optim.discrete.pi$objective) {
optim.discrete.pi = cur.discrete.pi
}
}
discrete.pi = optim.discrete.pi$minimum
optim.gradient.pi = optimize(fit.gradient.pi, interval = c(0, 1), gram.ref = gram.dist, ungram.ref = ungram.dist, test = test.dist)
for (i in c(1:5)) {
cur.gradient.pi = optimize(fit.gradient.pi, interval = c(0, 1), gram.ref = gram.dist, ungram.ref = ungram.dist, test = test.dist)
if (cur.gradient.pi$objective < optim.gradient.pi$objective) {
optim.gradient.pi = cur.gradient.pi
}
}
gradient.pi = optim.gradient.pi$minimum
discrete.model = create.discrete(gram.dist, ungram.dist, discrete.pi)
gradient.model = create.gradient(gram.dist, ungram.dist, gradient.pi)
discrete.mean = sum(discrete.model*c(1:6))
gradient.mean = sum(gradient.model*c(1:6))
# Next step, calculate BIC of test data under each model.
K = length(discrete.model)-1 ### # of free params in multinomial model... doesn't really matter for BIC difference score, is constant across models.
discrete.bic = -2*sum(dmultinom(tabulate(test.dist, nbins = 6), prob = discrete.model, log = T))+K*log(length(test.dist))
gradient.bic = -2*sum(dmultinom(tabulate(test.dist, nbins = 6), prob = gradient.model, log = T))+K*log(length(test.dist))
# Next step, convert BIC to BF
bf = exp(-.5*(discrete.bic-gradient.bic))
# Wrap it up
my.fit = {}
my.fit[["Discrete"]] = discrete.model
my.fit[["Gradient"]] = gradient.model
my.fit[["Test"]] = (tabulate(test.dist, nbins = 6))/(length(test.dist))
my.fit[["Data mean"]] = mean(test.dist)
my.fit[["Discrete predicted mean"]] = discrete.mean
my.fit[["Gradient predicted mean"]] = gradient.mean
my.fit[["Discrete BIC"]] = discrete.bic
my.fit[["Gradient BIC"]] = gradient.bic
my.fit[["BF"]] = bf
my.fit[["Stats"]] = c(discrete.mean, gradient.mean, discrete.pi, gradient.pi, discrete.bic-gradient.bic, bf, discrete.mean, gradient.mean)
if (chisquare) {
# Calculate X2 values under two models
# simulate.p.value set to T because of very low expected counts on some models
chisq.discrete = chisq.test(tabulate(test.dist, nbins = 6), p = discrete.model, simulate.p.value = T)
chisq.gradient = chisq.test(tabulate(test.dist, nbins = 6), p = gradient.model, simulate.p.value = T)
my.fit[["Discrete Chisq"]] = chisq.discrete
my.fit[["Gradient Chisq"]] = chisq.gradient
}
my.fit[["pi"]] = c(discrete.pi, gradient.pi)
return(my.fit)
}
summary.figure = function(my.fit) {
par(mfrow = c(3, 1))
max = max(c(my.fit$Test, my.fit$Discrete, my.fit$Discrete))
max = ceiling(max*10)/10
barplot(my.fit$Test, main = "Test Distribution", ylim = c(0, max))
barplot(my.fit$Discrete, main = "Discrete Distribution", ylim = c(0, max))
barplot(my.fit$Gradient, main = "Gradient Distribution", ylim = c(0, max))
}
# Run the simulation on the transitive object cases
# Use ungrammatical fillers as ungram.ref, and grammatical fillers as gram.ref
# Use transitive object condition as test
# gram.ref, ungram.ref, test
#sim_object <- compare.models(filler_data_gramm, filler_data_ungramm, data_object)
#sim_object
#summary.figure(sim_object)
outcomes_object <- {}
sim_object.discrete <- {}
sim_object.gradient <- {}
for (i in c(1:500)) {
sim_object = compare.models(filler_data_gramm, filler_data_ungramm, data_object)
outcomes_object <- cbind(outcomes_object, sim_object$Stats)
sim_object.discrete <- cbind(sim_object.discrete, sim_object$Discrete)
sim_object.gradient <- cbind(sim_object.gradient, sim_object$Gradient)
}
paste(round(c(mean(outcomes_object[2,]), # mean predicted means under gradient
mean(outcomes_object[4,]), # mean gradient pi
mean(outcomes_object[1,]), # mean predicted means under discrete
mean(outcomes_object[3,]), # mean discrete pi
mean(outcomes_object[5,]), # mean BIC difference
range(outcomes_object[5,]), # range of BIC difference
mean(outcomes_object[6,])), # mean Bayes factor
digits=2)) -> results.sim_object
results.sim_object %>% t %>% data.frame -> results.sim_object
colnames(results.sim_object) <- c("Gradient_mean", "Gradient_pi", "Discrete_mean", "Discrete_pi", "BIC_mean", "BIC_min" ,"BIC_max", "BF")
print(results.sim_object)
### See how many have BIC > 0 ###
outcomes_object[5,] %>% data.frame -> outcomes.sim_object
outcomes.sim_object %>% subset(. > 0) %>% nrow
[1] 374
# Run the simulation on the predicate cases
# Use ungrammatical fillers as ungram.ref, and grammatical fillers as gram.ref
# Use predicate condition as test
# gram.ref, ungram.ref, test
#sim_predicate <- compare.models(filler_data_gramm, filler_data_ungramm, data_object)
#sim_predicate
#summary.figure(sim_predicate)
outcomes_predicate <- {}
sim_predicate.discrete <- {}
sim_predicate.gradient <- {}
for (i in c(1:500)) {
sim_predicate = compare.models(filler_data_gramm, filler_data_ungramm, data_predicate)
outcomes_predicate <- cbind(outcomes_predicate, sim_predicate$Stats)
sim_predicate.discrete <- cbind(sim_predicate.discrete, sim_predicate$Discrete)
sim_predicate.gradient <- cbind(sim_predicate.gradient, sim_predicate$Gradient)
}
paste(round(c(mean(outcomes_predicate[2,]), # mean predicted means under gradient
mean(outcomes_predicate[4,]), # mean gradient pi
mean(outcomes_predicate[1,]), # mean predicted means under discrete
mean(outcomes_predicate[3,]), # mean discrete pi
mean(outcomes_predicate[5,]), # mean BIC difference
range(outcomes_predicate[5,]), # range of BIC difference
mean(outcomes_predicate[6,])), # mean Bayes factor
digits=2)) -> results.sim_predicate
results.sim_predicate %>% t %>% data.frame -> results.sim_predicate
colnames(results.sim_predicate) <- c("Gradient_mean", "Gradient_pi", "Discrete_mean", "Discrete_pi", "BIC_mean", "BIC_min" ,"BIC_max", "BF")
print(results.sim_predicate)
### See how many have BIC > 0 ###
outcomes_predicate[5,] %>% data.frame -> outcomes.sim_predicate
outcomes.sim_predicate %>% subset(. > 0) %>% nrow
[1] 0
# Run the simulation on the existential cases
# Use ungrammatical fillers as ungram.ref, and grammatical fillers as gram.ref
# Use existential condition as test
# gram.ref, ungram.ref, test
#sim_existential <- compare.models(filler_data_gramm, filler_data_ungramm, data_object)
#sim_existential
#summary.figure(sim_existential)
outcomes_existential <- {}
sim_existential.discrete <- {}
sim_existential.gradient <- {}
for (i in c(1:500)) {
sim_existential = compare.models(filler_data_gramm, filler_data_ungramm, data_existential)
outcomes_existential <- cbind(outcomes_existential, sim_existential$Stats)
sim_existential.discrete <- cbind(sim_existential.discrete, sim_existential$Discrete)
sim_existential.gradient <- cbind(sim_existential.gradient, sim_existential$Gradient)
}
paste(round(c(mean(outcomes_existential[2,]), # mean predicted means under gradient
mean(outcomes_existential[4,]), # mean gradient pi
mean(outcomes_existential[1,]), # mean predicted means under discrete
mean(outcomes_existential[3,]), # mean discrete pi
mean(outcomes_existential[5,]), # mean BIC difference
range(outcomes_existential[5,]), # range of BIC difference
mean(outcomes_existential[6,])), # mean Bayes factor
digits=2)) -> results.sim_existential
results.sim_existential %>% t %>% data.frame -> results.sim_existential
colnames(results.sim_existential) <- c("Gradient_mean", "Gradient_pi", "Discrete_mean", "Discrete_pi", "BIC_mean", "BIC_min" ,"BIC_max", "BF")
print(results.sim_existential)
### See how many have BIC > 0 ###
outcomes_existential[5,] %>% data.frame -> outcomes.sim_existential
outcomes.sim_existential %>% subset(. > 0) %>% nrow
[1] 0
Sprouse, Jon, Matthew W. Wagers, and Colin Phillips. 2012. “A test of the relation between working memory capacity and syntactic island effects.” Language 88 (1): 82–123.