Input: 5. Confirmatory Factor analysis To replicate our results without item 1, delete yts_1 from the analyses 5.1 yes/no RESIST  [CODESPLIT] dataCFA1 <- na.omit(data.frame(data$id,data$yts_1, data$yts_2, data$yts_3, data$yts_4,  data$yts_5, data$yts_6,  data$yts_7, data$yts_8,  data$yts_9, data$yts_10, data$yts_11, data$yts_12, data$yts_13)) colnames (dataCFA1) <-c("id","yts_1","yts_2","yts_3","yts_4","yts_5","yts_6", "yts_7","yts_8","yts_9","yts_10","yts_11","yts_12", "yts_13") model1 <- 'EA =~ yts_1 + yts_2  + yts_3  +  yts_4  + yts_5 + yts_6  + yts_7  +  yts_8  + yts_9 + yts_10 + yts_11 +  yts_12 + yts_13' fit1 <- cfa(model1, data=dataCFA1, meanstructure=T, std.lv=T, estimator = "WLSMV", ordered = c("yts_1", "yts_2",  "yts_3",  "yts_4", "yts_5", "yts_6",  "yts_7",  "yts_8", "yts_9", "yts_10", "yts_11", "yts_12", "yts_13")) summary(fit1, fit.measures=TRUE, standardized = T) fitMeasures(fit1,c("chisq","df","pvalue","cfi","tli","rmsea", "wrmr",'rmsea.ci.lower','rmsea.ci.upper')) modindices(fit1, sort. = T)


Input: get factorscores and include them in origingal data [CODESPLIT] dataCFA1$factorscore1 <- predict(fit1) data <- left_join(data, dataCFA1,  by = "id") data$factorscore1 dataCFA3$factorscore3 <- predict(fit3) data1 <- left_join(data1, dataCFA3,  by = "record_id") data1$factorscore3 dataCFA4$factorscore4 <- predict(fit4) data1 <- left_join(data1, dataCFA4,  by = "record_id") data1$factorscore4


Input: join behDat and demDat [CODESPLIT] allData = inner_join(behDat, demDat, by = "userCode")


Input: Standardize Variables  zscoring [CODESPLIT] df_overall = df df_overall$sWM = scale(df_overall$sWM) df_overall$rtWM = scale(df_overall$rtWM) df_overall$rtDivAtt = scale(df_overall$rtDivAtt) df_overall$rtAlert = scale(df_overall$rtAlert) df_overall$sRWT = scale(df_overall$sRWT)


Input: Remove time points above 29, because not everyone attended that often   [CODESPLIT] df_overall = df_overall %>% filter(Time < 29) %>% ungroup()


Input: ensure that userCode is a factor [CODESPLIT] df_overall$userCode = as.factor(df_overall$userCode)


Input: We can also try to cluster the languages based on the feature values they have. We currently use hierarchical clustering. This will normally also reflect the PCA visualization. The output can also be compared with the family grouping of the languages.  generate the clusters [CODESPLIT] hclust_avg <- hclust(daisy(con_data)) hclust_avg <- hclust(daisy(con_data))


Input: add squares around the clusters [CODESPLIT] rect.hclust(hclust_avg , k = 4, border = 1:4) rect.hclust(hclust_avg , k = 4, border = 1:4)


Input: Extracting distances  We can extract the pairwise distance between the points of the data set. First, we can visualize the distances in a twodimensional space. Normally, we expect that this visualization matches the output of the PCA.  change the content to a distance matrix  [CODESPLIT] distances <- con_data %>% dist(method = "euclidean") distances <- con_data %>% dist(method = "euclidean")


Input: recodes ethnicity (Decline/Other category is set to missing) [CODESPLIT] sambdif<-samb %>% select(1:19, SAmb_tot, gender, ethnic) %>% mutate(ethnic_fac = rec(ethnic, rec = "1=0;; 6=NA;; else=1")) %>% convert(fct(gender, ethnic_fac)) table(sambdif$gender) # 0=women, 1=men table(sambdif$ethnic_fac) #0=EuroAm, 1=PoC


Input: reorder the list of results to match the alignment of the dendrogram [CODESPLIT] list.res.reo<-list.res[order.dendrogram(dend1)] layd<-c(10,1) tiff("Figure_hclust2.tif",width=sum(layd),height=11.5,units="cm",res=600,compression="lzw") layout(matrix(1:2,nrow=1),widths=layd) par(mar=c(3.5,1,1.5,14),mgp=c(2,0.8,0)) plot(dend1, cex = 0.8, horiz=T,xlab="Height")


Input: function to read in cleaned data and format  it as a tibble that can be used for plotting [CODESPLIT] read_data_for_plotting <- function(data_path) { dat <- read_csv(data_path, col_types = cols())


Input: create a matrix of relevant item loadings to calculate nonrefined factor (scale) scores [CODESPLIT] scaleMatrix <- data.frame(data = matrix(EFA$loadings, ncol = 6)) scaleMatrix <- lapply(scaleMatrix, function(x) ifelse(x >= 0.4, 1, ifelse(x <= -0.4, -1, NA))) scaleMatrix <- data.frame(data = scaleMatrix, row.names = colnames(mainData[, c(2:56)])) colnames(scaleMatrix) <- c("Sensory", "CognitiveDemand", "ThreatToSelf", "CrossSettings", "Safety", "States")


Input: get number of patients (from 'table_overview_of_studies.R') [CODESPLIT] df_long <- left_join(df_long, tab_study_overview %>% select(study_name, N_Patients) %>% rename(Study = study_name) %>% mutate(N_Patients = as.numeric(str_extract(N_Patients, '(\\d*)'))), by = 'Study')


Input: add error bars with standard error [CODESPLIT] plot <- plot + geom_errorbar(aes(ymin=lower,ymax=upper),width=.2) plot <- plot + ggtitle("2a) Average accuracy across four Cue Type conditions")


Input: Capture Age for Each particpant [CODESPLIT] ParticipantAge <- summarize(Summary, count = n(), Age = mean(Age, na.rm = T))


Input: EVENT VALENCE: Compare Rated Strength of Positive & Negative Events    CHECKING FOR OUTLIERS    Figure: Boxplot    Order Conditions [CODESPLIT] EventValenceRatings$Valence <- factor(EventValenceRatings$Valence, levels = c("Positive", "Negative")) BoxplotFig <- ggplot(EventValenceRatings, aes(x=Valence, y=Strength)) + theme_bw() BoxplotFig <- BoxplotFig +  geom_boxplot(aes(color = Valence, fill = Valence), outlier.size = 2.5, alpha = 0.5) BoxplotFig <- BoxplotFig + labs(x="Event Valence", y="Event Valence Ratings (-50 to 50)") + theme(title= element_text(size=14, face='bold'), axis.title.x= element_text(size=14), axis.text.x= element_text(face="bold", size=14), axis.title.y = element_text(size=14), axis.text.y= element_text(face="bold", size=14), strip.text.x= element_text(size = 14, face='bold'), strip.text.y= element_text(size = 14, face='bold'))


Input: Dotplot Valence Figure (Winsorized & ReverseCoded) [CODESPLIT] EventValenceRatings_MEANFig <- ggplot(data=EventValenceRatings_ByParticipant_MEAN, aes(x=Valence, y=Strength_ReverseCoded)) EventValenceRatings_MEANFig <- EventValenceRatings_MEANFig + stat_summary(fun=mean, geom="bar", position ="dodge", alpha=0.5, aes(fill=Valence)) EventValenceRatings_MEANFig <- EventValenceRatings_MEANFig + theme_bw() EventValenceRatings_MEANFig <- EventValenceRatings_MEANFig + geom_violin(alpha = 0.5, color='grey50')


Input: Mixed Effects Model with EventPosition as a Covariate (Linear & Quadratic)  Random Effects Structure simplified to converge:    ChainPosition removed from ChainID    SocialContext removed from Event [CODESPLIT] Analysis1GLMER <- glmer (Present~ SocialContext.C*Valence.C*ChainPosition.C + poly(EventPosition.C, 2) + (1 + Valence.C | ChainID) + (1 | Event), data=Analysis1, family=binomial) summary(Analysis1GLMER) Analysis2GLMER <- glmer (Present~ SocialContext.C*Valence.C*ChainPosition.C + poly(EventPosition.C, 2) + (1 + Valence.C | ChainID) + (1 | Event), data=Analysis2, family=binomial) summary(Analysis2GLMER)


Input: Mixed Effects Model with EventPosition as a Covariate (Linear & Quadratic)  Random Effects Structure simplified to converge:    Valence & ChainPosition removed from ChainID    SocialContext removed from Event [CODESPLIT] Analysis3GLMER <- glmer (Present~ SocialContext.C*Valence.C*ChainPosition.C + poly(EventPosition.C, 2) + (1 | ChainID) + (1 | Event), data=Analysis3, family=binomial) summary(Analysis3GLMER)


Input: VISUALISE BIAS (POSITIVE, NEGATIVE) IN EACH SocialContext      Substract Mean Positive From Mean Negative Survival Score for each SocialContext  Prediction is that Perference for Negativity Decreases first with Communicative Intent and then further with Social Interaction  Calculate Means for Positive & Negative Information  Calculate Mean Positive  Mean Negative for Each Chain  Plot  Filter  [CODESPLIT] Bias <- filter(NegativityData, Valence %in% c("Positive", "Negative"))


Input: Create a Vector of colours based on each Participant's Mean Bias Score (Positive  Negative)  Use this to Color the dot points by Value [CODESPLIT] wideBiasMEAN <- mutate(wideBiasMEAN, ColourFig = ifelse(Bias >1, "#006A40FF", ifelse(Bias <0, "#F08892FF", "#95828DFF"))) NegativityBiasFig <- ggplot(data=wideBiasMEAN, aes(x=SocialContext, y=Bias)) NegativityBiasFig <- NegativityBiasFig + stat_summary(fun.y=mean, geom="bar", position ="dodge", alpha=0.5, fill="red") NegativityBiasFig <- NegativityBiasFig + theme_bw() NegativityBiasFig <- NegativityBiasFig + geom_violin(alpha = 0.5, color='grey50')


Input: Geom_dotplot with points coloured by Value [CODESPLIT] NegativityBiasFig <- NegativityBiasFig + geom_dotplot(aes(x=SocialContext, y=Bias, fill=ColourFig), binaxis='y', stackdir='center', dotsize=0.9, alpha = 1, stroke=0.75, colour='grey15') + scale_fill_identity()


Input: Add Violin Geom to give indication or data normality [CODESPLIT] ResolutionCollapsedFig <- ResolutionCollapsedFig + geom_violin(alpha = 0.0, colour='grey50') ResolutionALLPosNegFig <- ResolutionALLPosNegFig + geom_violin(alpha = 0.5, color='grey50')


Input: Run IRT model: 3dim model for math, read  and scie, no weights  Possibility to set seeds and iteration number in the function parameter  [CODESPLIT] mod <- run.irt(pa12_resp_s, items = item.dif)


Input: function to create tick marks on a logscale [CODESPLIT] log10Tck <- function(side, type){ lim <- switch(side, x = par('usr')[1:2], y = par('usr')[3:4], stop('side argument must be "x" or "y"')) at <- floor(lim[1]) : ceiling(lim[2]) at <- 0:8 return(switch(type, minor = outer(1:9, 10^(min(at):max(at)))[,1:8], major = 10^at, stop('type argument must be "major" or "minor"') )) } if(saveFigures) cairo_ps(file = '../R_Output/Images/OriginalBFScatter.eps', onefile = TRUE, fallback_resolution = 600, width = 7.3, height = 4.16)


Input: Plot: original Bayes factor and replication effect size [CODESPLIT] plot(original.bf, replication.effectsizes, xlim    = c(1, 10^8), ylim    = c(-0.2, 1), axes    = FALSE, log     = 'x', cex     = 2, cex.lab = 1.6, pch     = 21, bg      = c('grey36', 'grey')[replication.outcomes], xlab    = 'Bayes Factor Original Study', ylab    = 'Replication Effect Size (r)')


Input: take the xaxis indices and add a jitter, proportional to the N in each level  [CODESPLIT] myjitter <- jitter(rep(i, length(thisvalues)), amount=levelProportions[i]/6) points(myjitter, thisvalues, pch=1, col=rgb(0,0,0,.9), cex = 1.5, lwd = 1.5) } graphics.off() rm(myjitter, thislevel, thisvalues, mylevels, levelProportions, nsubjects, subjects)


Input: Multiple Regression Analysis [CODESPLIT] multreg.second(Speaking ~ Vocabulary+Grammar+Writing+Reading, corr=correl, n=100) multreg.second(Y~ X1+X2+X3, corr=correl, n=100) multreg.second(Score~ Wordcount+CLI+Commas+Stopwords+Linking+WordsSentence, corr=correl, n=200) multreg(Score~ Wordcount+CLI+Commas+Stopwords+Linking+WordsSentence, data=dat1) lm.out <- lm(Score ~., dat1)


Input: Dominance Analysis (using dominanceanalysis package) [CODESPLIT] lm.cov <- lmWithCov(Score ~ Wordcount+CLI+Commas+Stopwords+Linking+WordsSentence, correl) da <- dominanceAnalysis(lm.cov) print(da)


Input: FUnctions for Cleaning   Function to generate a table with all observations within a variable and its corresponding count [CODESPLIT] check_observation <- function (df, column) { require (tidyverse) check <- df %>% group_by (as.vector(unlist(df[, column]))) %>% count () colnames(check)[1] <- column return (check) } recur.collapse <- function(df, n = ncol(df)) { #collapse function combine <- function(x,y){ if(!is.na(x)){ return(x) } else if (!is.na(y)) { return(y) } else { return(NA) } } if(n==1){ return(df[,1]) } else { return(mapply(combine, df[,n], recur.collapse(df, n-1))) } } multi_spread <- function(df, id, key, var){ require(gtools) require(tidyverse) df.list <- lapply(var, function(x){ df.temp <- spread(df[, c(id, key, x)], key, x) # spread 1 variable cname <- mixedsort(unique(as.vector(unlist(df[,key])))) # sort colnames in alphanumeric order df.temp <- df.temp[, c(id, cname)] # rename column names colnames(df.temp)[2:ncol(df.temp)]  <- paste(x, colnames(df.temp[,cname]), sep= "_") #add key to column names return(df.temp) }) df.output <- df.list[[1]] # initialise for(i in 1:(length(var)-1)){ # combine matrices together df.output <- full_join(df.output, df.list[[i+1]]) } return(as.data.frame(df.output)) }


Input: Extract posteriors of effects from Bayesian ANOVA [CODESPLIT] bestmod <- modBF[1] chains <- posterior(bestmod, iterations=50000, columnFilter="^Subject$") colnames(chains)


Input: STATISTICAL TEST: Nonparametric Spearman's correlation nonnormalized conditional entropy [CODESPLIT] cor.test(results$DATE, results$CEDenominationsMotifs, method = "spearman") rdates <- rev(dates) #dates = centuries BCE plot(results$DATE, results$CEDenominationsMotifs, xlim = c(6,4), xaxt='n', xlab = "Century BCE", ylab = "H(D|d)", main = "P2: Conditional entropy of denominantions given designs") axis(1, at = rdates, labels = rdates)


Input: ____________________________________________________________ Plots with H(D|d)  nonnormalized conditional entropy Getting statistics: mean, meadian, standard deviation among authorities per period for nonnormalized conditional entropy of denomination given designs  [CODESPLIT] N <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = length) MEAN <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = mean) MEDIAN <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = median) SD <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = sd) resultspoleis_summary <- cbind.data.frame(N, MEAN$CEDenominationsMotifs, MEDIAN$CEDenominationsMotifs, SD$CEDenominationsMotifs) colnames(resultspoleis_summary) <- c("DATE","N","MEAN","MEDIAN","SD") resultspoleis_summary$SE <- resultspoleis_summary$SD / sqrt(resultspoleis_summary$N)


Input: Getting statistics: mean, meadian, standard deviation among authorities per period for normalized conditional entropy of denomination given designs  [CODESPLIT] N <- aggregate(NormCEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = length) MEAN <- aggregate(NormCEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = mean) MEDIAN <- aggregate(NormCEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = median) SD <- aggregate(NormCEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = sd) Nresultspoleis_summary <- cbind.data.frame(N, MEAN$NormCEDenominationsMotifs, MEDIAN$NormCEDenominationsMotifs, SD$NormCEDenominationsMotifs) colnames(Nresultspoleis_summary) <- c("DATE","N","MEAN","MEDIAN","SD") Nresultspoleis_summary$SE <- Nresultspoleis_summary$SD / sqrt(Nresultspoleis_summary$N)


Input: aggregate data, zstandardize all predictor variables for the model  [CODESPLIT] recogfreq <- aggregate(cbind(correct, intrusion, new) ~ id+setsize+rsizeList+rsizeNPL, data=recogdat, FUN=sum) recogfreq$zsetsize <- (recogfreq$setsize - mean(recogfreq$setsize))/sd(recogfreq$setsize) recogfreq$zrsizeList <- (recogfreq$rsizeList - mean(recogfreq$rsizeList))/sd(recogfreq$rsizeList) recogfreq$zrsizeNPL <- (recogfreq$rsizeNPL - mean(recogfreq$rsizeNPL))/sd(recogfreq$rsizeNPL) for (sc in 1:length(scales))  { prior <- paste0("cauchy(0, ", as.character(scales[sc]), ")") fixefPrior <- c(set_prior(prior, class="b")) ranefPrior <- set_prior("gamma(1,0.04)", class="sd")


Input: Cronbach's alpha (ingroup) [CODESPLIT] iden.ing.woOutliers.a <- c("ingroup.value", "ingroup.like", "ingroup.connected") iden.ing.woOutliers <- data.all[iden.ing.woOutliers.a] cronbach(iden.ing.woOutliers)


Input: min and max age, mean and sd age, percentage of men and women  [CODESPLIT] minAge = min(df_preQ$age) maxAge = max(df_preQ$age) meanAge = mean(df_preQ$age) sdAge = sd(df_preQ$age) females = length(which(df_preQ$gender == "female")) males = length(which(df_preQ$gender == "male")) other = length(which(df_preQ$gender == "other"))


Input: Check normality with QQ plot and ShapiroWilk test  Build the linear model [CODESPLIT] model  <- lm(FW ~ condition, data = df_postQ)


Input: Question 4: pearson correlation between the different subscales [CODESPLIT] df_cor <- data.frame(df_postQ$FW, df_postQ$DU, df_postQ$DET) colnames(df_cor) <- c('FW', 'DU', 'DET') res_cor <- rcorr(as.matrix(df_cor))


Input: Visualize correlations  Insignificant correlations are leaved blank [CODESPLIT] corrplot(res_cor$r, method = 'number', type="upper", order="hclust", p.mat = res_cor$P, sig.level = 0.05, insig = "blank")


Input: Stepwise regression model [CODESPLIT] step.model <- stepAIC(full.model, direction = "both", trace = FALSE) summary(step.model) step.model <- stepAIC(full.model, direction = "both", trace = FALSE) summary(step.model) step.model <- stepAIC(full.model, direction = "both", trace = FALSE) summary(step.model)


Input: Subset the data set to use base2 instead of base1 for the individuals  that have the 2nd baseline  Extract values of frogs that have two baselines [CODESPLIT] base2_frogs <-filter(hormones, condition == "base_02")


Input: LMER testosterone by sex and condition with interaction [CODESPLIT] m1_osT <- lmer(log(t_conc_corr) ~ sex*condition + (1|id), data = hormones)


Input: Sex difference in Tlevel  Model plot wit sjPlot [CODESPLIT] plot_model(m1_osT_1, title = "", axis.title = "Fixed effect estimates", axis.labels = c("Time point\n (back home)", "Sex \n(male)"), dot.size = 5, line.size = 2, transform = NULL, sort.est = TRUE, colors = "gs", vline.color = "darkgrey")+ ylim(-0.5, 1) + theme_sjplot2(24)


Input: now the random slopes part of the model including random intercepts and slopes and their correlation: [CODESPLIT] pot.terms.with.corr=paste(c(xnames, fe.me[modes[fe.me]!="factor"]), collapse="+")#get all fixed effects terms together... pot.terms.with.corr=paste(paste("(1+", pot.terms.with.corr, "|", re, ")", sep=""), collapse="+")#... and paste random effects, brackets and all that pot.terms.with.corr=paste(c(xnames, fe.me[modes[fe.me]!="factor"]), collapse="+")#get all fixed effects terms together... pot.terms.with.corr=paste(paste("(1+", pot.terms.with.corr, "|", re, ")", sep=""), collapse="+")#... and paste random effects, brackets and all that


Input: Supplemental Material:  To check whether the participants followed gaze at all, we tested the gaze following score against chance level by running a one sample test against zero.  Children followed gaze in the additional gazefollowing task (M  3;; SD  1.66;; t(29)  9.89, p  .00, d  1.8).  Correlation GF & Difference Score  [CODESPLIT] Data$DiffSocCon <- as.numeric(Data$DiffSocCon) cor.test(Data$DS, Data$DiffSocCon, method = "pearson") #only younger


Input: use network data only for students in classrooms with at least 50% response rate [CODESPLIT] dat$nwinclude <- 0 dat[which(dat$prop_part > .50 & !is.na(dat$prop_part)),"nwinclude"] <- 1 length(unique(dat[which(dat$nwinclude == 1), "IDTESTGROUP_FDZ"]))    # 1708 classes with at least 50% response rate length(unique(dat[which(dat$nwinclude == 0), "IDTESTGROUP_FDZ"]))    # 290 classes excluded for network related analyses dat[which(dat$nwinclude == 0), c(nw_covariates,  grep("deg", names(dat), value = T))] <- NA #recode sociometric variables to NA for classes with low level of completeness length(unique(dat[which(dat$nwinclude == 0), "IDSTUD_FDZ"]))         # 5450 students without sociometric data length(unique(dat[which(dat$nwinclude == 1), "IDSTUD_FDZ"]))         # 36,920 students with sociometric data


Input: Reorder factor levels: (this will be useful once we create the plot legend) [CODESPLIT] dataset$trial_condition <- factor(dataset$trial_condition, levels = c("diff_3sg", "diff_3pl", "same_3sg", "same_3pl")) dataset$trial_condition_new <- factor(dataset$trial_condition_new, levels = c("different number", "same number"))


Input: Prepare dataframe for eyetracking analysis & graphs (package eyetrackingR required) [CODESPLIT] eyetrackingr.data <- make_eyetrackingr_data(dataset, participant_column = "participant_number", trial_column = "item_nr", time_column = "time_ms_absolute", trackloss_column = "trackloss", aoi_columns = c("average_target_sample_count_proportion", "average_distractor_sample_count_proportion"), treat_non_aoi_looks_as_missing = TRUE )


Input: Remove trackloss per trial > 50% (removed 4 trials) [CODESPLIT] eyetrackingr.data <- clean_by_trackloss(data = eyetrackingr.data, trial_prop_thresh = .5)


Input: check histogram for binning [CODESPLIT] hist(quop_use$t1_eff) quop_use$bins<-cut(quop_use$t1_eff,quantile(quop_use$t1_eff,p=seq(0,1,length=29),na.rm=T))


Input: visualize with forest plot  compare corona vs. precorona [CODESPLIT] forest(lvd$est[1:16],sei=lvd$se[1:16], ilab = cbind(c("Pre-pandemic Cohorts vs. First Pandemic Cohort",rep("",7),"Pre-pandemic Cohorts vs. Second Pandemic Cohort",rep("",7)), paste0("T",rep(1:8,2)), c("Schools Open","???","???","???","Schools Closed","???","???","Alternating Lessons", "Schools Open","???","Alternating Lessons","???","???","???","???","Schools Open")), ilab.xpos = c(-1.35,-.95,-.65), ylim = c(0,22), xlim = c(-1.7,1), slab = NA, rows = c(18:11, 8:1), at = c(-.7,-.35,0,.35,.7), xlab = "Latent Variance Differences", col=c("gray","gray", "gray","gray", "black", "black", "black", "black", "gray", "gray", "black", "black", "black", "black", "black", "gray")) forest(lmd$est[1:16],sei=lmd$se[1:16], ilab = cbind(c("Pre-pandemic Cohorts vs. First Pandemic Cohort",rep("",7),"Pre-pandemic Cohorts vs. Second Pandemic Cohort",rep("",7)), paste0("T",rep(1:8,2)), c("Schools Open","???","???","???","Schools Closed","???","???","Alternating Lessons", "Schools Open","???","Alternating Lessons","???","???","???","???","Schools Open")), ilab.xpos = c(-1.35,-.95,-.65), ylim = c(0,22), xlim = c(-1.7,1), slab = NA, rows = c(18:11, 8:1), at = c(-.7,-.35,0,.35,.7), xlab = "Standardized Latent Mean Differences", col=c("gray","gray", "gray","gray", "black", "black", "black", "black", "gray", "gray", "black", "black", "black", "black", "black", "gray"))


Input: to see how well the distances are measured [CODESPLIT] stressplot(species_matrix_short.nmds) #R2 = 0.961, linear R2 = 0.891 data.scores <- as.data.frame(scores(species_matrix_short.nmds$points)) data.scores$site <- substr(rownames(data.scores),1,6) data.scores$plots <- substr(rownames(data.scores),8,15) species.scores <- as.data.frame(scores(species_matrix_short.nmds, "species")) species.scores$species <- rownames(species.scores)


Input: now statistical test to see if communities are statistically different from one another [CODESPLIT] species_matrix2 <- species_matrix %>% mutate_if(is.numeric, ~1 * (. > 0)) sp_matrix_with_group <- species_matrix2 rownames(sp_matrix_with_group) <- rownames(species_matrix) sp_matrix_with_group$grouping <- substr(rownames(sp_matrix_with_group), 7,13) ano <- anosim(species_matrix2, distance = 'euclidean', grouping = sp_matrix_with_group$grouping) summary(ano)


Input: SEM Analysis Section   The following section sets up a series of path models. Note that this is a highly revised version of the SEM section, which  originally tried to incorporate a complex latent variable model to simultaneously test all hypotheses. I decided to break it down into  smaller, simpler models, and to focused on observedvariableonly models using the composite meausres instead. I'm not sure if that's  the "best" approach or not, but I think it at least makes for a simpler approach. The code below is thus a mixture of what I originally  wrote and the revised models.  Let's check differences between the two groups:  [CODESPLIT] t.test(Measures$Age~Measures$Normative) t.test(Measures$Adj_Income~Measures$Normative) t.test(Measures$Parent_Edu~Measures$Normative) t.test(Measures$Political~Measures$Normative) t.test(Measures$Crit_Reflection_Mean~Measures$Normative) t.test(Measures$Efficacy_Mean~Measures$Normative) t.test(Measures$Crit_Action_Mean~Measures$Normative) t.test(Measures$BLM_Activism~Measures$Normative) t.test(Measures$Militarism_Mean~Measures$Normative) t.test(Measures$EDNhComp~Measures$Normative) t.test(Measures$ACEs_Sum~Measures$Normative) t.test(Measures$MEQ_Total~Measures$Normative) t.test(Measures$Discrim_Major_Sum~Measures$Normative) t.test(Measures$Discrim_Everyday_Mean~Measures$Normative) t.test(Measures$BNSS_Mean~Measures$Normative) t.test(Measures$BNSSh_Mean~Measures$Normative) t.test(Measures$Zero_Sum_Mean~Measures$Normative) sjmisc::frq(Measures$Race, out = "v") Measures %>% group_by(Race) %>% summarise(BLM_Mean = mean(BLM_Activism)) data <- Measures %>% filter(Race %in% c("Black or African-American","White or Caucasian") & !is.na(BLM_Activism)) %>% mutate(Black = ifelse(Race == "Black or African-American", 1,0))


Input: To assess BLM Activism by race, keep in mind that the BLM measure is count data (with a lot of zeros)  A ttest therefore is not appropriate. We will use "zeroinflated Poisson regression"  [CODESPLIT] ggplot(Measures, aes(BLM_Activism)) + geom_histogram() model.zi = zeroinfl(BLM_Activism ~ Black, data = data, dist = "poisson") summary(model.zi) Descriptives3 <- Measures %>% select(Normative,Age,Adj_Income,Parent_Edu,Political,ACEs_Sum,EDNhComp,Discrim_Major_Sum,Discrim_Everyday_Mean,MEXQ_Exp, Crit_Reflection_Mean,Efficacy_Mean,Crit_Action_Mean,BLM_Activism, Militarism_Mean) %>% psych::describeBy(group="Normative") %>% as.data.frame() %>% rownames_to_column(var="Measure") %>% select(-vars) DescrNonNorm<- as.data.frame(Descriptives3[1]) %>% rownames_to_column(var="Measure") DescrNorm<- as.data.frame(Descriptives3[2]) %>% rownames_to_column(var="Measure")


Input: Write cleaned covariate files to xlsx [CODESPLIT] cleaned_group_covariates_data <- list( "cleaned_group_participant" = cleaned_group_participant_dat, "cleaned_group_instructional" = cleaned_group_instructional_dat, "cleaned_group_DV" = cleaned_group_DV_dat, "cleaned_group_race_ethnicity" = race_eth ) write_xlsx(cleaned_group_covariates_data, path = "Cleaned data/Group covariates data tables.xlsx")


Input: Weighted regression model for Ordinary People subscale score (mean) [CODESPLIT] m1.ppl.svyglm.fit <- svyglm(scipopppl ~ age + gender + education.comp + education.uni + sciprox.score + urbanity.log + languageregion.ger + languageregion.ita, design = bar.design.scipopppl, family = gaussian, na.action = na.omit) m2.ppl.svyglm.fit <- svyglm(scipopppl ~ age + gender + education.comp + education.uni + sciprox.score + urbanity.log + languageregion.ger + languageregion.ita + polorientation + religiosity, design = bar.design.scipopppl, family = gaussian, na.action = na.omit) m3.ppl.svyglm.fit <- svyglm(scipopppl ~ age + gender + education.comp + education.uni + sciprox.score + urbanity.log + languageregion.ger + languageregion.ita + polorientation + religiosity + interestscience + sciliteracy + trustscience + trustscientists, design = bar.design.scipopppl, family = gaussian, na.action = na.omit)


Input: Model assumption checks   Do some assumption checks for multiple linear regression (e.g., see Field, 2012, p. 292). These are:  (1) Multicollinearity  (2) Nonnormality/heteroscedasticity of residuals  Assumption checks (1): Multicollinearity   Specify model and inspect GVIFs  Note: The VIF (usual collinearity diagnostic) may not be applicable to models with dummy regressors  constructed from a polytomous categorical variable or polynomial regressors (Fox, 2016: 357). Fox and  Monette (1992) introduced generalized variance inflation factor (GVIF) for these cases. As  education.uni/education.comp and languageregion.ger/languageregion.ita are such dummy regressors based  on polytomous categorial variables (i.e. education and languageregion), we should compute GVIFs.  car::vif() does that automatically.  GVIFs of SciPop Score models  [CODESPLIT] car::vif(m1.scipopgoertz.svyglm.fit) %>% as.data.frame %>% rename(GVIF = deparse(substitute(.))) car::vif(m2.scipopgoertz.svyglm.fit) %>% as.data.frame %>% rename(GVIF = deparse(substitute(.))) car::vif(m3.scipopgoertz.svyglm.fit) %>% as.data.frame %>% rename(GVIF = deparse(substitute(.)))


Input: Nonnormality/heteroscedasticity of residuals of ppl Score models [CODESPLIT] distributionchecks(m1.ppl.svyglm.fit) distributionchecks(m2.ppl.svyglm.fit) distributionchecks(m3.ppl.svyglm.fit)


Input: ADDITIONAL ANALYSIS B: TESTING A USHAPED RELATIONSHIP BETWEEN SCIPOP AND POLITICAL ORIENTATION   1st test: Quadratic regression on weighted data [CODESPLIT] bar2019pop$polorientation2 <- bar2019pop$polorientation^2 bar.design <- svydesign(id = ~0, data = bar2019pop, weights = ~weight) quad.scipopgoertz.svyglm.fit <- svyglm(scipopgoertz ~ age + gender + education.comp + education.uni + sciprox.score + urbanity.log + languageregion.ger + languageregion.ita + polorientation + polorientation2 + religiosity + interestscience + sciliteracy + trustscience + trustscientists, design = bar.design, family = gaussian, na.action = na.omit) summ(model = quad.scipopgoertz.svyglm.fit, binary.inputs = "full", n.sd = 2, transform.response = F, confint = F, vifs = F, scale = F, model.info = T,  model.fit = T, digits = 4) quad.scipopgoertz.svyglm.fit$aic m0.scipopgoertz.svyglm.fit <- svyglm(scipopgoertz ~ 1, bar.design, family = gaussian, na.action = na.omit) anova(m0.scipopgoertz.svyglm.fit, quad.scipopgoertz.svyglm.fit, test = "F", method = "Wald")


Input: chisquare to compare vegan in experienced vs. not experienced for each advocacy type graphic video [CODESPLIT] data %>% xtabs(~ graphic_exp_buc + vegn_bin, .) %>% print() %>% proportions("graphic_exp_buc") graphic_tmp <- chisq.test(xtabs(~ graphic_exp_buc + vegn_bin, data))


Input: Boosted Regression Trees                          CUS BRT plot [CODESPLIT] CUS.BRT.plot <- ggplot(data = CUS.BRT, aes(x = predictors, y = influence, fill = predictor.type)) + geom_bar(stat = "identity") + geom_hline(yintercept = 5, linetype = 3, size = 1, colour = "gray60") + scale_fill_manual(values = viridis.3) + coord_flip() + labs(x = "Predictor", y = "Relative Influence") + scale_y_continuous(breaks = c(0, 10, 20, 30, 40), limits = c(0, 40)) + scale_x_discrete(limits = BRT.plot.label.limits, labels = BRT.plot.labels) + theme_pubr() + theme(legend.position = c(0.85, 0.825), legend.title = element_blank())


Input: Sets limits of the plot based on user choice [CODESPLIT] limits <- matrix(0,2,2) limits <- if (lim == 1){ limits <-u.plot.limit(min.age,max.age,lim,min.ylim,max.ylim) } else if (lim == 2){ limits <-u.plot.limit(min.age,max.age,lim,min.ylim,max.ylim) } else { limits <-u.plot.limit(min.xlim,max.xlim,lim,min.ylim,max.ylim) } limconc <-uconcplot(limits[1,1],limits[1,2],int) #sets the concordia line based on plot limts plot_limconc <- limconc[2:(nrow(limconc)-1),]


Input: BELOW CALCULATES THE ELLIPSES               calculate x/y coords that define ellipse based in input data including rho [CODESPLIT] ell.coords=list() #sets up list to write results to for(n in 1:n){ covmat <-cor2cov2((Pb7Ue[n]/2),(Pb6Ue[n]/2),rho[n]) nn <- 75 cutoff <- stats::qchisq(1-0.05,2) e <- eigen(covmat) a <- sqrt(cutoff*abs(e$values[1])) # major axis b <- sqrt(cutoff*abs(e$values[2])) # minor axis v <- e$vectors[,1] beta <- atan(v[2]/v[1]) theta <- seq(0, 2 * pi, length=nn) out <- matrix(0,nrow=nn,ncol=3) out[,1] <- Pb7U[n] + a * cos(theta) * cos(beta) - b * sin(theta) * sin(beta) out[,2] <- Pb6U[n] + a * cos(theta) * sin(beta) + b * sin(theta) * cos(beta) out[,3] <- n


Input: Functions for plotting models Extracts significance from models for chart legend [CODESPLIT] extractSign <- function (model, modeltype, MtnRanges, InclMIA = TRUE) { coef <- summary(model)$coefficients$cond SignDF <- data.frame(mtnrng = MtnRanges, main = NA, int_ao = NA, int_po = NA) if (InclMIA) { if (modeltype == "int") { if (coef[row.names(coef) == "AO:MtnRange1", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Coast - North"] <- "I"} if (coef[row.names(coef) == "AO:MtnRange2", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Coast - South"] <- "I"} if (coef[row.names(coef) == "AO:MtnRange3", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Columbia - North"] <- "I"} if (coef[row.names(coef) == "AO:MtnRange4", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Columbia - South"] <- "I"} if (coef[row.names(coef) == "AO:MtnRange5", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Rockies - North"] <- "I"} if (coef[row.names(coef) == "MtnRange1:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Coast - North"] <- "I"} if (coef[row.names(coef) == "MtnRange2:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Coast - South"] <- "I"} if (coef[row.names(coef) == "MtnRange3:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Columbia - North"] <- "I"} if (coef[row.names(coef) == "MtnRange4:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Columbia - South"] <- "I"} if (coef[row.names(coef) == "MtnRange5:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Rockies - North"] <- "I"} } } SignAOMain <- paste("AO: ", format(round(coef[row.names(coef) == "AO", 1], 3), nsmall=3), " (", format(round(coef[row.names(coef) == "AO", 4], 3), nsmall=3),")") SignPOMain <- paste("PO: ", format(round(coef[row.names(coef) == "PO", 1], 3), nsmall=3), " (", format(round(coef[row.names(coef) == "PO", 4], 3), nsmall=3),")") return(list(SignAOMain = SignAOMain, SignPOMain = SignPOMain, SignDF = SignDF)) }


Input: outlier coding M and SD per subject and item depending on distractor condition and soa (independent variables) [CODESPLIT] subj.M.SD = ddply(rawdat,.(subj,cond,soa), summarize, subj.M=mean(RT, na.rm=T), subj.SD=sd(RT, na.rm=T)) tar.M.SD = ddply(rawdat,.(targ_ID,cond,soa), summarize, tar.M=mean(RT, na.rm=T), tar.SD=sd(RT, na.rm=T)) rawdat = merge(rawdat, subj.M.SD, by=c("subj", "cond", "soa")) rawdat = merge(rawdat, tar.M.SD, by=c("targ_ID", "cond", "soa")) rawdat$subj.min = (rawdat$subj.M - 2*(rawdat$subj.SD)) rawdat$subj.max = (rawdat$subj.M + 2*(rawdat$subj.SD)) rawdat$tar.min = (rawdat$tar.M - 2*(rawdat$tar.SD)) rawdat$tar.max = (rawdat$tar.M + 2*(rawdat$tar.SD))


Input: calculate the value of the closest peer estimate and store in 'closest' [CODESPLIT] closest<-min(abs(si-firstEstimate))


Input: define Gaussians for updating  prior self (firstEstimate) [CODESPLIT] density_self <- log(dnorm(x, firstEstimate, own_sd ))


Input: 1.1. Sample 1  PTSD Symptoms (PSSI)   Run linear mixed effect model [CODESPLIT] a1_model_01_sg_pssi_outcome <- lme(pssi_end ~ pssi_s0 + sg, random = ~ 1 | id, method = "ML", na.action = na.omit, data = data_a1_pssi)


Input: Check asssumption of normality of the residuals [CODESPLIT] qqnorm(resid(a1_model_01_sg_pssi_outcome)) qqnorm(resid(a2_model_01_sg_pssi_outcome))


Input: Calculate contrasts specified in in the contrast matrix "contrast_outcome"  [CODESPLIT] a1_model_01_sg_pssi_outcome_contrasts <- glht(a1_model_01_sg_pssi_outcome, contrast_outcome) a2_model_01_sg_pssi_outcome_contrasts <- glht(a2_model_01_sg_pssi_outcome, contrast_outcome)


Input: Show contrasts without adjusting pvalues for multiple comparisons [CODESPLIT] summary(a1_model_01_sg_pssi_outcome_contrasts, test = adjusted("none")) summary(a2_model_01_sg_pssi_outcome_contrasts, test = adjusted("none"))


Input: Select estimates, standard error and pvalue  [CODESPLIT] table_a1_model_01_sg_pssi_outcome_full <- table_a1_model_01_sg_pssi_outcome_raw %>% dplyr::select(beta = estimate, se = std.error, p = p.value) table_a2_model_01_sg_pssi_outcome_full <- table_a2_model_01_sg_pssi_outcome_raw %>% dplyr::select(beta = estimate, se = std.error, p = p.value)


Input: Calculate pooled standard deviation at baseline [CODESPLIT] sd_a1_pssi_s0 <- sd(data_a1_pssi$pssi_s0, na.rm = TRUE) sd_a2_pssi_s0 <- sd(data_a2_pssi$pssi_s0, na.rm = TRUE)


Input: Calculate Cohen's d using the absolute value of the baseline adjusted difference from the linear mixed effect model [CODESPLIT] cohens_d_a1_pssi_end <- a1_pssi_end_diff / sd_a1_pssi_s0 cohens_d_a2_pssi_end <- a2_pssi_end_diff / sd_a2_pssi_s0


Input: Peer Rank Means and Standard Deviations of Conditions   Unspecified Peer Rank [CODESPLIT] round(mean(unspecified$peer.rank), 2) round(sd(unspecified$peer.rank), 2)


Input: determines and rounds (to digits as specified in digits) mean and sd of x, and then collapses them in a single entry  [CODESPLIT] xx=as.character(round(c(mean(x, na.rm=T), sd(x, na.rm=T)), digits=digits)) if(any(grepl(x=xx, pattern=".", fixed=T))>0){ xx[!grepl(x=xx, pattern=".", fixed=T)]=paste(xx[!grepl(x=xx, pattern=".", fixed=T)], "0", sep=".") xx=matrix(unlist(strsplit(as.character(xx), split=".", fixed=T)), ncol=2, byrow=T) xx[, 2]=unlist(lapply(xx[, 2], function(x){ paste(c(x, paste(c(rep("0", times=digits-nchar(x))), collapse="")), collapse="") })) xx=apply(xx, 1, paste, collapse=".") } paste(xx, collapse=sep) } c.tab<-function(x, digits=NA, n.spaces=1, add.hash=T, incl.fst=F, incl.rownames=T){


Input: wrapper for savePlot with file  "clipboard" and type  "wmf" (default;; others are possible)  [CODESPLIT] savePlot(file="clipboard", type=type) } overdisp.correction<-function(coeffs, disp.param){ coeffs[, "Std. Error"]=coeffs[, "Std. Error"]*sqrt(disp.param) coeffs[, "z value"]=coeffs[, "Estimate"]/coeffs[, "Std. Error"] coeffs[, "Pr(>|z|)"]=2*pnorm(q=-abs(coeffs[, "z value"]), mean=0, sd=1) return(coeffs) } merge.ests.ci.stab<-function(coeffs, ci=NULL, tests=NULL, stab=NULL){ ires=coeffs if(!is.null(ci)){ coeffs=cbind(coeffs, ci[rownames(coeffs), ]) } if(!is.null(tests)){ xx=outer(rownames(tests), rownames(coeffs), Vectorize(function(tt, e){ if(nchar(tt)>nchar(e)){ return(0) }else{


Input: Add the starttime (intra_scope_window[1]) to every start position (scope$start) ...  ... of the recording timestamp to get the actual start window in milliseconds [CODESPLIT] starting_times <- df$RecordingTimestamp[scope$start] + as.numeric(intra_scope_window[1]) } if (intra_scope_window[2] != "end") {


Input: set to current trial duration to 0 [CODESPLIT] current_trial_total_duration[[hn]] <- 0 } current_trial_total_looks[[hn]] <- 0 } current_first_look_duration[[hn]] <- 0 current_first_look_ending_reason[[hn]] <- "" first_looks_collection[[hn]]$found_first <- FALSE first_looks_collection[[hn]]$forced_stop <- FALSE }


Input: Return sum log likelihood. Include protection against log(0) problems [CODESPLIT] return(sum(log(pmax(like, 1e-10)))) } else {


Input: Plot posterior fit and forward simulation prediction [CODESPLIT] plot_fits <- function(stan_fit_ex, N_t, N_p, obs_times, pred_times, data_vector, S_0, D_0, M_0, filename) { sigma_hat <- median(stan_fit_ex$sigma) CO2_flux_ratios_hat_median <- rep(NA, N_t) #Pre-allocate vector for median model fit CO2_flux_ratios_pred_median <- rep(NA, N_p) sigma_hat <- median(stan_fit_ex$sigma) for (t in 1:N_t) { CO2_flux_ratios_hat_median[t] <- median(stan_fit_ex$CO2_flux_ratios_hat_vector[,t]) } for (t in 1:N_p) { CO2_flux_ratios_pred_median[t] <- median(stan_fit_ex$CO2_flux_ratios_new_vector[,t]) }


Input: fit linear mixed effects models  null model [CODESPLIT] fitlmer0 <- lmer(rating ~ 1 + (1|subject), data = dat.long1, REML = FALSE) summary(fitlmer0)


Input: the mean of each parameter across iterations. Keep dimensions for parameters and subjects [CODESPLIT] mean.params <- t(apply(sampled$samples$alpha[,,keep],1:2,mean))


Input: plot the calibration curve (Abs vs. [BSA]) with an appropriate trendline and figure caption [CODESPLIT] ggplot(bca, aes(x = BSA, y = Abs562)) +


Input: generate MPT data: [CODESPLIT] gendat <- genMPT(theta = pnorm(theta), restrictions = "model/restrictions.txt", numItems = numItems, eqnfile="model/2htsm.eqn")


Input: Recode confirm(oppose/confirm) and won(win/lost) to factors [CODESPLIT] DF$confirm <- recode(DF$confirm, `0` = "Confirmed", `1` = "Opposed") DF$won <- recode(DF$won, `0` = "Lost", `1` = "Won") DF <- DF %>% mutate(confirm = as_factor(confirm)) %>% mutate(treatment = as_factor(treatment)) %>% mutate(won = as_factor(won)) %>% mutate(majmin = as_factor(majmin)) %>% mutate(experiment = as_factor(experiment)) %>% mutate(evidence = as_factor(evidence)) summary(DF)


Input: create unique id number for each unique individual [CODESPLIT] mutate(uniq.id = group_indices(., id, experiment)) %>% mutate(uniq.id = as_factor(uniq.id)) summary(Ind_E1) M_Ind_E1 <- brm(changed ~ won*confirm + trial + (1|uniq.id), data = Ind_E1, family = "bernoulli", iter = 6000, chains = 3, cores = 3, save_all_pars = TRUE, file = "Ind_E1") summary(M_Ind_E1) plot(M_Ind_E1, ask = FALSE) pp_check(M_Ind_E1, check = "distributions") pp_check(M_Ind_E1, check = "residuals") pp_check(M_Ind_E1, "error_scatter_avg") pp_check(M_Ind_E1, check = "scatter")


Input: generates 95% confidence intervals for each beta coefficient [CODESPLIT] m.p1_decision.CI <- round(confint(m.p1_decision, parm = "beta_"), 3)


Input: exclude people who don't meet the inclusion criteria of having data for at least 3 days in each week [CODESPLIT] person_weekly_entries <- dat2019 %>% group_by(identity_id, woy)  %>% summarise(n_days = length(identity_id)) person_weekly_entries <- as.data.frame(person_weekly_entries) person_weekly_entries <- subset(person_weekly_entries, n_days >= 3)


Input: construct a maximal glmer() model  This model contains a fixed withinsubjects effect of Ambiguity (effectcoded with 0.5 amb),  and betweensubjects fixed effects for Vocabulary and ART test scores,  plus random effects by participants and items.  [CODESPLIT] Acc.max <- glmer(accuracy ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CohOnly, family = "binomial", control = glmerControl(optimizer ="bobyqa"))


Input: construct a maximal lmer() model  This model contains a fixed withinsubjects effect of Ambiguity (effectcoded with 0.5 amb),  and betweensubjects fixed effects for Vocabulary and ART test scores,  plus random effects by participants and items.  Maximal model with interactions  [CODESPLIT] TrialDwellTime.max <- lmer(logTrialDwellTime ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, REML=FALSE)


Input: _firstfixation duration   Construct a maximal lmer() model  Because not all the necessary models converge, remove correlations between  random effects for all models for the firstfixation duration measure:  [CODESPLIT] AOIKey.FF.reduced <- lmer(logFirstFixDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 | RECORDING_SESSION_LABEL) + (0 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 | item) + (0 + Vocab.Cent | item) + (0 + ART.Cent | item), data = Data.CorrTrials, REML=FALSE) AOICohcue.FF.reduced <- lmer(logFirstFixDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 | RECORDING_SESSION_LABEL) + (0 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 | item) + (0 + Vocab.Cent | item) + (0 + ART.Cent | item), data = Data.CorrTrials, REML=FALSE)


Input: _gaze duration   Construct a maximal lmer() model [CODESPLIT] AOIKey.GazeDur.max <- lmer(logGazeDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, REML=FALSE) AOICohcue.GazeDur.max <- lmer(logGazeDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, REML=FALSE) AOISpillover.GazeDur.max <- lmer(logGazeDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, REML=FALSE)


Input: _regressions out   Construct a maximal glmer() model [CODESPLIT] AOIKey.RegrOut.max <- glmer(IA_REGRESSION_OUT ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, family = "binomial", control = glmerControl(optimizer ="bobyqa")) AOICohcue.RegrOut.max <- glmer(IA_REGRESSION_OUT ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, family = "binomial", control = glmerControl(optimizer ="bobyqa")) AOISpillover.RegrOut.max <- glmer(IA_REGRESSION_OUT ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, family = "binomial", control = glmerControl(optimizer ="bobyqa")) AOISpillover.RegrOut.max <- glmer(IA_REGRESSION_OUT ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, family = "binomial", control = glmerControl(optimizer ="bobyqa"))


Input: _firstfixation duration   Construct a maximal lmer() model [CODESPLIT] AOISpillover.FF.max <- lmer(logFirstFixDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, REML=FALSE) AOIWrapUp.FF.max <- lmer(logFirstFixDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, REML=FALSE) AOICohcue.FF.max <- lmer(logFirstFixDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent  | item), data = Data.CorrTrials, REML=FALSE) AOISpillover.FF.max <- lmer(logFirstFixDur ~ 1 + Ambiguity.code  + Vocab.Cent + ART.Cent + Ambiguity.code : Vocab.Cent + Ambiguity.code : ART.Cent + (1 + Ambiguity.code | RECORDING_SESSION_LABEL) + (1 + Vocab.Cent + ART.Cent | item), data = Data.CorrTrials, REML=FALSE)


Input: Creating subsets of coins by time period and obtaining measures for each of the time periods [CODESPLIT] for (i in dates) { dsub <- (subset(df, df$DATE == i)) motifs <- cbind(dsub[318:681]) denom <- cbind(dsub[256:309]) DATE[i] <- i HDenomination[i] <- entropy(denom) HMotifs[i] <- entropy(motifs) CEDenominationsMotifs[i] <- condentropy(denom, motifs) NormCEDenominationsMotifs[i] <- condentropy(denom, motifs) / entropy(denom) CEMotifsDenominations[i] <- condentropy(motifs, denom) NormCEMotifsDenominations[i] <- condentropy(motifs, denom) / entropy(motifs) MI[i] <- mutinformation(denom, motifs) NDenominations[i] <- length(unique(dsub$DENOMINATION)) NCoins[i] <- length(unique(dsub$ID)) }


Input: STATISTICAL TESTING: nonparametric Spearman's correlation nonnormalized conditional entropy [CODESPLIT] cor.test(results$DATE, results$CEDenominationsMotifs, method = "spearman") rdates <- rev(dates) #dates = years BCE plot(results$DATE, results$CEDenominationsMotifs, xlim = c(600,330), xaxt='n', xlab = "YEAR BCE", ylab = "H(D|d)", main = "P2: Conditional entropy of denomination given designs") axis(1, at = rdates, labels = rdates)


Input: Plots with H(D|d)  nonnormalized conditional entropy Getting mean, median and standard deviation across different authorities per period for nonnormalized conditional entropy of denomination given designs  [CODESPLIT] N <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = length) MEAN <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = mean) MEDIAN <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = median) SD <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = sd) resultspoleis_summary <- cbind.data.frame(N, MEAN$CEDenominationsMotifs, MEDIAN$CEDenominationsMotifs, SD$CEDenominationsMotifs) colnames(resultspoleis_summary) <- c("DATE","N","MEAN","MEDIAN","SD") resultspoleis_summary$SE <- resultspoleis_summary$SD / sqrt(resultspoleis_summary$N)


Input: Plot mean and median H(D|d) across authorities per period [CODESPLIT] require(ggplot2) ggmean <- ggplot(resultspoleis_summary,aes(x=DATE,y=MEAN)) + labs(title =  "P2: Mean conditional entropy of denominations given designs across authorities", x = "Year BCE", y = "mean H(D|d) across authorities") + scale_x_reverse() + geom_errorbar(aes(ymin=resultspoleis_summary$MEAN-resultspoleis_summary$SE, ymax=resultspoleis_summary$MEAN+resultspoleis_summary$SE),width=.1) + geom_line() + geom_point() ggmean ggmedian <- ggplot(resultspoleis_summary,aes(x=DATE,y=MEDIAN)) + labs(title =  "P2: Median conditional entropy of denominations given designs across authorities", x = "Year BCE", y = "median H(D|d) across authorities") + scale_x_reverse() + geom_line() + geom_point() ggmedian


Input: REGRESSION ANALYSIS: GROUPING BY AUTHORITIES  nonnormalized CE [CODESPLIT] resultspoleis$AUTHORITIES <- rownames(resultspoleis) resultspoleis$DATE <- as.numeric(as.character(resultspoleis$DATE))


Input: Meanimputes missing values for a vector x   NOTE: see http://www.mailarchive.com/rhelp@rproject.org/msg58289.html   Args:    x: numeric vector   Returns:    x, with missing values replaced by mean(x)  [CODESPLIT] return(replace(x, is.na(x), mean(x, na.rm = T))) } makeConstructMatrix <- function(net, a) {


Input: how many missing data for WVSES questions? [CODESPLIT] sum(is.na(df21$WVSE1)) sum(is.na(df21$WVSE2))


Input: To log transform Years [CODESPLIT] TEST_data <- TEST_data %>% mutate(Yearslog = log(Years))


Input: Making factors for reasons based on factor analysis. This is making a new data frames that also has plans [CODESPLIT] TEST_data_withplans <- dplyr::select( TEST_data, c( 'Hierarchy':'Cooperate', 'plan_materials', 'plan_MS', 'self_MS_prestige', 'self_MS_cooper', 'self_materials_prestige', 'self_materials_cooper' ) )


Input: Word Cloud GG plot [CODESPLIT] ggwordcloudc <- function(x,y){ freqt<-count(x,y) set.seed(42) ggplot(freqt, aes( label = y, size = n, color=factor(sample.int(10,nrow(x),replace=TRUE)))) + geom_text_wordcloud(area_corr = TRUE) + scale_size_area(max_size = 24) + theme_minimal() }


Input: Calculate quantiles for eigenvalues, but only store those from simulated CF model in percentile1  [CODESPLIT] percentile <- apply(parallel$values, 2, function(x) quantile(x, .95)) min <- as.numeric(nrow(obs)) min <- (4 * min) - (min - 1) max <- as.numeric(nrow(obs)) max <- 4 * max percentile1 <- percentile[min:max] percentile <- apply(parallel$values, 2, function(x) quantile(x, .95)) min <- as.numeric(nrow(obs)) min <- (4 * min) - (min - 1) max <- as.numeric(nrow(obs)) max <- 4 * max percentile1 = percentile[min:max]


Input: Label the yaxis 'Eigenvalue' [CODESPLIT] scale_y_continuous(name = 'Eigenvalue') +


Input: Label the xaxis 'Factor Number', and ensure that it ranges from 1max  of factors, increasing by one with each 'tick' mark.  [CODESPLIT] scale_x_continuous(name = 'Factor Number', breaks = min(eigendat$num):max(eigendat$num)) +


Input: drop row without fid data and without distance burrow data [CODESPLIT] fid <- fid[!is.na(fid$FID),] fid <- fid[!is.na(fid$dist_burrow),]


Input: get probability contours for plot [CODESPLIT] kd <- ks::kde(plot_data, compute.cont=TRUE) contour_90 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["10%"])[[1]]) contour_90 <- data.frame(contour_90) contour_80 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["20%"])[[1]]) contour_80 <- data.frame(contour_80) contour_70 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["30%"])[[1]]) contour_70 <- data.frame(contour_70) contour_60 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["40%"])[[1]]) contour_60 <- data.frame(contour_60) contour_50 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["50%"])[[1]]) contour_50 <- data.frame(contour_50) contour_40 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["60%"])[[1]]) contour_40 <- data.frame(contour_40) contour_30 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["70%"])[[1]]) contour_30 <- data.frame(contour_30) contour_20 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["80%"])[[1]]) contour_20 <- data.frame(contour_20) contour_10 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["90%"])[[1]]) contour_10 <- data.frame(contour_10)


Input: pcurve pcurve(m.cor) Funnel plot, symmetry test (Egger's regression), failsafe n  [CODESPLIT] pdf("Self_control_Funnel.pdf",width=5,height=5) funnel(m.cor,xlab = "Correlation") dev.off() eggers.test(x = m.cor) fsn(yi=m.cor$TE, sei=m.cor$seTE, type="Rosenthal") plot(copas(m.cor)) copas(m.cor)


Input: H3a: stress ~ trust  set Cauchy prior (0, 1) as stated in the preregistration  [CODESPLIT] prior.coef <- brms::prior(cauchy(0,1),class='b')


Input: Fit logistic model to each individual's data to estimate PSEs [CODESPLIT] jdat$PSE <- 500 for(i in as.numeric(levels(jdat$Subject))){ dat <- subset(jdat, Subject==i) if(dat$cannot_fit[1]==0){ fit.glm <- glm(faster ~ Distort, family=binomial, data=dat) jdat$PSE[jdat$Subject==i] <- -coef(fit.glm)[1]/coef(fit.glm)[2]  #PSE is -b0/b1 } }


Input: Linear mixed effects model for graded judgments [CODESPLIT] mod_full <- lmer(GradedJudge ~ Context*(GMSI_Gen_Z + Order*Distort) + (1|Subject), data=jdat2) summary(mod_full) Anova(mod_full, type=3, test='Chisq')


Input: Custom function for weighted Likert plot [CODESPLIT] panel <- function(...){ HH::panel.likert(...) vals <- list(...) df <- data.frame(x = vals$x, y = vals$y, groups = vals$groups) grps <- as.character(df$groups) for(i in 1:length(colnames(likertscipop.df))){ grps <- sub(paste0('^', colnames(likertscipop.df)[i]), i, grps) } df <- df[order(df$y,grps),] df$correctX <- ave(df$x, df$y, FUN = function(x){ x[x < 0] <- rev(cumsum(rev(x[x < 0]))) - x[x < 0]/2 x[x > 0] <- cumsum(x[x > 0]) - x[x > 0]/2 return(x) }) subs <- sub(' Positive$', '', df$groups) collapse <- subs[-1] == subs[-length(subs)] & df$y[-1] == df$y[-length(df$y)] df$abs <- abs(df$x) df$abs[c(collapse, F)] <- df$abs[c(collapse, F)] + df$abs[c(F, collapse)] df$correctX[c(collapse, F)] <- 0 df <- df[c(T, !collapse),] df$perc <- round(ave(df$abs, df$y, FUN = function(x){x/sum(x) * 100}), 1) df$perc <- paste0(df$perc,'%') df$perc[df$perc == "0%"] <- "" lattice::panel.text(x = df$correctX, y = df$y, label = df$perc, cex = 1.2, font = 1, col = "white") }


Input: calculate mean and sd in deduplicated data set [CODESPLIT] means <- c(means, paste0(Round(mean(desc[!duplicated(desc$id), i])), " (", Round(sd(desc[!duplicated(desc$id), i])), ")")) } }


Input: For each person combine component scores F, with loading matrix B and error values E to obtain latent structure  For each person standardized the data using the withinperson mean and standard deviation  [CODESPLIT] Y = matrix(0,nrow(data),P) colnames(Y) = sprintf("Y%d",seq(1:P)) Error.var = matrix(0,nrow(data),P) colnames(Error.var) = sprintf("E%d",seq(1:P)) FB.var = matrix(0,nrow(data),P) colnames(FB.var) = sprintf("FB%d",seq(1:P)) for (i in 1:N){ n.i = which(data$ID==i) E = sqrt(var.E)*mvrnorm(length(n.i), rep(0,P), diag(P)) Y[n.i,] = F[n.i,] %*% t(B) + E Error.var[n.i,] = E FB.var[n.i,] = F[n.i,] %*% t(B) } data = cbind(data,Y) return(list(Sigma.Psi=NULL,Psi=Psi,Psi.i=NULL,lambda.max.list=NULL,Components=F,data=data, Error.var=Error.var,FB.var=FB.var)) }


Input: Statistical analysis  Make GramGender a factor with two levels (feminine, masculine)  [CODESPLIT] subset.for.plot$GramGender <- as.factor(subset.for.plot$GramGender)


Input: Summary statistics on the reported frequence of the structures [CODESPLIT] data_struc_names <- as.data.frame(sort(table(data$structures_names))) data_struc_names range(table(data$structures_names)) mean(table(data$structures_names)) sd(table(data$structures_names)) median(table(data$structures_names)) sort(table(data$structures_names))


Input: Exclude subjects who have missing values on the ability test or on selfviewed ability [CODESPLIT] mst2 <- subset(mst2, (Raven_self != "NA") & (Raven_obj != "NA") )


Input: DESCRIPTIVE STATISTICS   compute and save sample statistics (age distribution, number of females)  [CODESPLIT] age <- round(select(psych::describe(mst2_descr$age), n, min, max, mean, sd),2) age$n <- nrow(mst2_descr) sampstats <- mutate(age, female=plyr::count(mst2_descr$sex)[plyr::count(mst2_descr$sex)[,1]=="1",]["freq"] ) write.table(sampstats, file="Descriptives/age_sex_Sample_A_mst2.dat", sep="\t", row.names=FALSE)


Input: get estimated variance of tanh1 (p hat) [CODESPLIT] dvartanh <- (1-(pe^2))^2 vartanh <- v/dvartanh vartanh


Input: We have weak evidence between precohort and coronacohort groups  test for strong invariance  fit model as multigroup model [CODESPLIT] est_s <- cfa(mod_s,quop_use, estimator = "MLR", missing = "FIML", group = "corona", group.equal = c("loadings","intercepts"), cluster = "class")


Input: find the stations that have 90% of data after 2001 [CODESPLIT] Pdata_2000 <- Pdata[Dates >= "2000-01-01",] result <- rep(0,(ncol(Pdata_2000)-3)) for (i in 4:ncol(Pdata_2000)) { result[i-3] <- sum(ifelse(is.na(Pdata_2000[,i]),1,0))/nrow(Pdata_2000) }


Input: result indicates the fraction of NA data for the stations  throw out all the columns and rows where result >0.1 [CODESPLIT] Pdata_new <- Pdata_2000[,-(which(result>0.1)+3)] Stations <- Stations[-which(result>0.1),] sub_b_sp <- SpatialPoints(cbind(Subbasins$Long_, Subbasins$Lat), proj4string=CRS("+proj=longlat +datum=WGS84 +no_defs"))


Input: create dichotomous variable coded as 0  no, 1  yes  [CODESPLIT] dat[, pb_investigated_dich := ifelse(pb_investigated == "yes", 1, 0)]


Input: show ttest, cohen's d, and corrected pvals + CIs for all tests  [CODESPLIT] idx = 1 for (i in all_groups) { cat("\n") print(sprintf('TEST: %s, %s = %d', equation, grouping, i)) t <- t.test(formula = eval(parse(text = equation)), data = filter(df, .data[[grouping]] == i), paired = TRUE, conf.level = ci_level) print(t) print(sprintf('adjusted pval: %.4f', pvals_adj[idx])) d <- effsize::cohen.d(formula = eval(parse(text = paste0(equation, '| Subject(id)'))), data = filter(df, .data[[grouping]] == i), paired = TRUE) print(d)


Input: show wilcox test, cliff's d, and corrected pvals for all tests  [CODESPLIT] idx = 1 for (i in all_groups) { print(sprintf('TEST: %s, %s = %d', equation, grouping, i)) w <- wilcox.test(formula = eval(parse(text = equation)), data = filter(df, .data[[grouping]] == i), paired = TRUE) print(w) print(sprintf('adjusted pval: %.4f', pvals_adj[idx])) d <- effsize::cliff.delta(formula = eval(parse(text = equation)), data = filter(df, .data[[grouping]] == i), paired = TRUE) print(d)


Input: fit tree with quadratic model [CODESPLIT] hrstree <- semtree(fitted_quadratic_lgcm, as.data.frame(rndhrs_subset), control=semtree.control(verbose=TRUE, method="naive", missing="party", min.bucket = 500, min.N = 250, exclude.heywood = FALSE


Input: then determine which response was given  unbiased guessing probablity of 1/N [CODESPLIT] p.guess <- rep(1/n.acc, n.acc) out$R[timer.replace] <- sample(1:n.acc, size=sum(timer.replace), replace=TRUE, prob=p.guess) } out }


Input: BassAckward EFA  We use bassAckward() to get the correlations between factors from successive solutions, so that we can create the hierarchical diagrams. The correlations are contained in the "bass.ack" result (See capture.output below).  In multifactor solutions, the factors obtained from fa() and bassAckward() can be matched by their sequential order (i.e., first factor in fa() is the same as the first factor from bassAckward()).  Note: BassAckwards is consistent with faCor but not factor.scores  [CODESPLIT] bass.usm=bassAckward(usm, nfactors=7, fm='ml', cut = .45, lr=F, items=F, plot=T) bass.uss=bassAckward(uss, nfactors=8, fm='ml', cut = .45, lr=F, items=F, plot=T) bass.its=bassAckward(its, nfactors=9, fm='ml', cut = .45, lr=F, items=F, plot=T) bassAckward.diagram(bass.its, lr=T, items=F, cut=.6) capture.output(bass.usm[["bass.ack"]],file='bassAck USM.csv') capture.output(bass.uss[["bass.ack"]],file='bassAck USS.csv') capture.output(bass.its[["bass.ack"]],file='bassAck ITS.csv')


Input: In the loop below, users define the datasets and the number of solutions to obtain, and the script returns the fa() results, the structure matrices with item labels, and factor congruence coefficients across samples.  res stores complete fa results  load stores structure matrices  pv stores percent of variance accounted by the factors in each solution  fcong stores matrices with factor congruence coefficients  [CODESPLIT] for (i in 1:9) { # i = number of solutions we want for(s in seq_along(dl)) { # for each sample in "dl"... id=c('M','U','I')[s] # letter identifier for each sample: M = Mturk, U = US students, I = Italian students fa1=fa(dl[[s]],nfactors=i,fm='ml') # conduct EFA (oblimin rotation, ML estimation) pv[[s]][[i]]=fa1$Vaccounted[2,] # proportion variance accounted for by each factor colnames(fa1$Structure)=sub('ML',id,colnames(fa1$Structure)) # rename the factor labels according to sample res[[s]][[i]]=fa1 # append fa results to list load[[s]][[i]]=merge(unclass(fa.sort(fa1$Structure)), labels, by='row.names', sort=F) # attach item labels to structure loadings and append to list write.table(rbind(load[[s]][[i]],''), file=paste0("load",s,".csv"), row.names=F, sep=',', append=T) # write matrix of structure loadings to file } fcong[[paste0(i,'_USM_USS')]]=fa.congruence(res[[1]][[i]],res[[2]][[i]],structure=T)  # append factor congruence coefficients for usm and uss fcong[[paste0(i,'_USM_ITS')]]=fa.congruence(res[[1]][[i]],res[[3]][[i]],structure=T) fcong[[paste0(i,'_USS_ITS')]]=fa.congruence(res[[2]][[i]],res[[3]][[i]],structure=T) } capture.output(fcong,file='fcong.csv') capture.output(pv,file='pvaccounted.csv') rm(fa1,fcong,load,pv,res,i,s,id) # cleaning afterwards


Input: Onefactor EFA    Here, we obtain the correlations among the four factors (obliquely rotated) and use them to find the factor loadings on a general factor  We also compute and save the factor scores for the 4 factors and the general factor  4factor EFA  [CODESPLIT] fa4.usm=fa(usm[,(items),with=F], nfactors=4, fm='ml') fa4.uss=fa(uss[,(items),with=F], nfactors=4, fm='ml') fa4.its=fa(its[,(items),with=F], nfactors=4, fm='ml')


Input: 1factor EFA using the factor scores (we need these scores in order to obtain the general factor scores) [CODESPLIT] fa1.usm=fa(usm[,(fnames),with=F], nfactors=1, fm='ml') fa1.uss=fa(uss[,(fnames),with=F], nfactors=1, fm='ml') fa1.its=fa(its[,(fnames),with=F], nfactors=1, fm='ml')


Input: in case xlim is set to 0, and some value has been given to xrange, center plot symmetrically on zero, using maximal extension in case range is set to 0, and given range otherwise  [CODESPLIT] if (xlim[1]==0 & !is.null(xrange))  { if (xrange==0)  { maxext <- max(abs(min(paramSampleVec)), abs(max(paramSampleVec)))  #largest extension into positive or negative range xlim = c(-maxext, maxext)   #centers plot symmetrically on zero } else { xlim = c(-xrange, xrange) } }


Input: compute and save correlation table of selfrated and objective ability measures and outcome aggregates,  [CODESPLIT] varnames <- c("Raven","reasoning_self","MWTB","vocabulary_self","global_selfevaluation","well_being","agency_self","communion_self","agency_peer","communion_peer") outcomes_pils <- dplyr::select(pils, Z_Raven_obj, Z_Raven_self, Z_MWTB_obj, Z_MWTB_self, Z_global_selfeval, Z_well_being, Z_agency_self, Z_comm_self, Z_agency_peer, Z_comm_peer) names(outcomes_pils) <- varnames cor_aggr <- corcons(outcomes_pils) write.table(cor_aggr, file="Descriptives/correlations_aggr_Sample_B_pils.dat", sep="\t")


Input: Function 5 Stouffer test for a vector of ppvalues [CODESPLIT] stouffer=function(pp) sum(qnorm(pp),na.rm=TRUE)/sqrt(sum(!is.na(pp)))


Input: 1.4 Create family to turn t>F and z>chi2 [CODESPLIT] family=test family=ifelse(test=="t","f",family) family=ifelse(test=="z","c",family)


Input: 1.9 Take value after equal sign, the value of the teststatistic, and put it in vector "equal"  [CODESPLIT] equal=abs(as.numeric(substring(raw,eq+1)))


Input: Compute ppvalues for the half [CODESPLIT] pp33.half=ifelse(family=="f" & p<.025, (1/prop25)*(    pf(value,df1=df1,df2=df2,ncp=ncp33)-(1-prop25)),NA) pp33.half=ifelse(family=="c" & p<.025, (1/prop25)*(pchisq(value,df=df1,         ncp=ncp33)-(1-prop25)),pp33.half) pp33.half=pbound(pp33.half)


Input: remove lower triangle of correlation matrix [CODESPLIT] else if(removeTriangle[1]=="lower"){ Rnew <- as.matrix(Rnew) Rnew[lower.tri(Rnew, diag = TRUE)] <- "" Rnew <- as.data.frame(Rnew) }


Input: mean RTs by condition [CODESPLIT] pretrain_study_rt <- pretrain_study %>% filter(block == 3) %>% group_by(id, condition) %>% summarise(mean_rt = mean(rt)) %>% ungroup()


Input: show get descriptive stats (how many/what proportion of participants reach each accuracy level) [CODESPLIT] pretrain_test_acc %>% group_by(test_rep) %>% summarise(n_80 = sum(mean_acc > 0.8), n_100 = sum(mean_acc == 1), prop_100 = sum(mean_acc == 1) / length(mean_acc), prop_80 = sum(mean_acc > 0.8) / length(mean_acc)) pretrain_test_acc %>% filter(test_rep == max(pretrain_test_acc$test_rep)) %>% summarise(group_mean_acc = mean(mean_acc), group_sd_acc = sd(mean_acc))


Input: P1 COUNTED as 6 seconds until sound event to normalize across trials P2 COUNTED AS FROM SOUND ONSENT (6SECONDS) plus 9 SECONDS  15 SECONDS P3 COUNTED AS 20 SECONDS FROM P2 TO ALMOST END OF THE TRIAL  ORDER PAPAMETER  'OPA', FISHER Z TRANSFORMED ORDER PARAMETER  'FOPA' P2 processing  [CODESPLIT] OPAmedianP2<-read.csv(file="OPAmedianP2.csv", sep = "", header=FALSE) colnames(OPAmedianP2)<-c(colheaderChronos) DW_OPAmedianP2=add_column(OPAmedianP2, GR, .before = 1) FOPAmedianP2=FisherZ(OPAmedianP2) DW_FOPAmedianP2=add_column(FOPAmedianP2, GR, .before = 1) DL_OPAmedianP2=melt(DW_OPAmedianP2, id=c("GR"), measured=c("colheaderChronos")) DL_FOPAmedianP2=melt(DW_FOPAmedianP2, id=c("GR"), measured=c("colheaderChronos")) colnames(DL_OPAmedianP2)<-c("GrNr", "TrialNr","OPAmedianP2") colnames(DL_FOPAmedianP2)<-c("GrNr", "TrialNr","FOPAmedianP2")


Input: plotting correlations with qgraph [CODESPLIT] cor_graph <- qgraph(correlations)


Input: estimate regularized logistic nodewise regression network define where to binarize variables eLASSO (LASSO with EBIC model selection) listwise deletion of missing values (pairwise not possible for regressions) [CODESPLIT] Ising_net <- estimateNetwork(data, default = "IsingFit", split = split, missing = "listwise", rule = "OR")


Input: standardize the variables (to obtain standardized coefficients) [CODESPLIT] dfAD[,c("S","R","H")] <- data.frame(apply(dfAD[,c("S","R","H")], 2, scale)) dfBE[,c("S","R","H")] <- data.frame(apply(dfBE[,c("S","R","H")], 2, scale)) dfCF[,c("S","R","H")] <- data.frame(apply(dfCF[,c("S","R","H")], 2, scale))


Input: run logistic regression on each subset, and predict the probability of  outcome for each country at each wave. these data points are used for the  metaanalysis  [CODESPLIT] response <- deparse(form[[2]]) data_list <- lapply(1:nrow(sub_data), function(i) { dat <- sub_data$data[[i]] if (!all_na(dat$migrant) && !all_na(dat[[response]]) && nlevels(droplevels(dat$migrant)) > 1) { m <- glm(form, family = binomial(), data = dat) pr <- ggemmeans(m, "migrant") pr$wave <- sub_data$wave[i] pr$country <- sub_data$country[i] pr } else { NA } })


Input: Binomial test for significant improvement in accuracy. [CODESPLIT] ifelse(rf_probs > .5, 0, 1) %>% sum %>% # count number of continuous responses binom.test(., nrow(pv), p = baseline)


Input: Multiple item parameters and thresholds were in one cell. Split them into separate  columns [CODESPLIT] item.dif <- cbind(item.dif, str_split_fixed(item.dif$orig.parameter, " ", 3)) item.dif <- cbind(item.dif, str_split_fixed(item.dif$orig.threshold, " ", 2)) item.dif2 <- cbind(item.dif2, str_split_fixed(item.dif2$orig.parameter, " ", 3)) item.dif2$Tau3 <- ifelse(item.dif2$item == "CR021Q08", 0.74200, NA) item.dif2 <- cbind(item.dif2, str_split_fixed(item.dif2$orig.threshold, " ", 3))


Input: interrater reliability create dataframe of reliability statistic for each of the 10 pairs of data [CODESPLIT] interraterReliability <- data.frame(row.names = row.names(interraterData)) for (i in c(1:10)) { interraterReliability[i,1] <- cohen.kappa(cbind(t(interraterData[i ,c(1:55)]), t(interraterData[i ,c(56:110)])))$weighted.kappa }


Input: fill empty matrix with the counts significant (p < .05) per lag (rows) and per individual (column) [CODESPLIT] for (j in unique(dataset_imp$Participant)){ tempacf <- acf(dataset_imp[dataset_imp$Participant == j , -c(1,8:13)], lag.max = 60) acfmatrix[,paste0("participant", j)] <- 0 for(i in as.numeric(rownames(acfmatrix))){ tempmatrix <- tempacf$acf[i,,] tempvector <- tempmatrix[upper.tri(tempmatrix, diag = T)] acfmatrix[i,paste0("participant", j)] <- length(which(tempvector > 0.25 | tempvector < -0.25)) } }


Input: Create list with partial correlation matrices per window [CODESPLIT] pcorlist <- list() for (d in seq_len(30)) { pcorlist[[d]] <-  pcor(temp_data[temp_data$Time %in% d:(d+Window),c("Happy", "Worrying","Nervous","Act_later_regret","Act_without_thinking","Restless")])$estimate } pcorlist <- rapply(pcorlist,function(x) ifelse(x==0.00000000,0.00000001,x), how = "replace") # will be pruned


Input: Smooth with (bayesian) logistic regression [CODESPLIT] (mym<-mean(nus)) d<-list(nus=nus-mym,fur=prob.fur*10000) m<-quap(alist( fur~dbinom(10000,p), logit(p)<-a+b*nus, a~dnorm(0,1), b~dnorm(0,1) ),data=d)


Input: For home (emotional) climate items, recode values of "99" to missing.  [CODESPLIT] mutate_at(vars(contains("EDNh_Emotion")), ~ifelse(. == 99, NA, .)) %>%  # (Not sure exactly how this code works, but it does)


Input: figure < annotate_figure(figure, top  text_grob(str_c(Q_text[1]), size  8, color"black")) figure  [CODESPLIT] ggsave(str_c(ordinal_y[QN],"_random.pdf"),plot=figure,width=12,height=14) return(figure) }


Input: ordered_logistic stacked plot [CODESPLIT] N_cat <- max(d[,var_y],na.rm=T) grn <- 250 zLogM <- seq(-5,4,length.out=grn) P <- matrix(NA, nrow=grn, ncol=N_cat) for(i in 1:grn){ P[i,] <- ordered_logistic(fixef['b_X']*zLogM[i],cutpoints) } if(QN==1 | QN==4 | QN==5 | QN==8){ axis_labels <- c('fraction of responses','M-ratio') }else{ axis_labels <- c(' ',' ') } data.frame(P) -> P colnames(P) <- x_lab #str_c("p_",1:N_cat) P$zlogM <- zLogM P$logM <- P$zlogM * 2*sd(log(d$M_cov)) + mean(log(d$M_cov)) P$M <- exp(P$logM) P %>% pivot_longer(cols=x_lab, #starts_with("p_"), values_to="p", names_to="k") %>% mutate(k = as_factor(k), k = fct_rev(k)) %>% ggplot(aes(x=M, y=p, fill=k)) + scale_fill_viridis_d(name="",labels = wrap_format(20), option="rocket") + geom_area(alpha=0.8 , size=0.4, colour="black")+ themeXstack + labs(y=axis_labels[1],x=axis_labels[2])+ scale_y_continuous(breaks=seq(0,1,0.1))+ coord_cartesian(xlim=c(0.5,1.3),ylim=c(0+0.045,1-0.045))+ ggtitle(label=str_wrap(sel_Q_text,22)) -> pl_stack


Input: calculate threshold for lowest quartile [CODESPLIT] quantile(tau_squared_self)[2]] tau2_thres_publ <- dat[as_factor(primary_data) == "yes" & k_publ > k_thres, quantile(tau_squared_self_publ)[2]]


Input: now we add up all corresponding answers to create one row per participant, as in a typical ANOVA design analysis  [CODESPLIT] sdt.agg <- sdt.agg %>% group_by(Participant, type) %>% summarise(count = n()) %>% spread(type, count) sdt.agg #this is a new dataframe for the aggregate data, you can delete after.


Input: function pcor2beta gives you data from a partial correlation/network  input   pcor  a partial correlation matrix / network   output   a matrix of betas, each column corresponds to a dependent variable  so that you can get predicted values by a matrix multiplication  in the form betas %*% data  [CODESPLIT] pcor2beta <- function(pcor) { require(psych) require(corpcor) diag(pcor) <- 1 p <- ncol(pcor) betas <- matrix(0, ncol = p, nrow = p) for(i in 1:p) betas[-i,i] <- matReg(y = i, x = seq(p)[-i], C = pcor2cor(pcor))$beta betas[abs(betas) < 1e-13] <- 0 betas }


Input: extract posterior samples of omega [CODESPLIT] posterior.omega <- c(posterior.omega.check[, 1], posterior.omega.check[, 2]) posterior.omega.description.only <- c(posterior.omega.check[, 1], posterior.omega.check[, 2]) posterior.omega.description.plus.stats <- c(posterior.omega.check[, 1], posterior.omega.check[, 2])


Input: MEAN & SD FOR AMOUNT OF REM SLEEP (min) BETWEEN BASELINE AND ISOLATION [CODESPLIT] aggregate(REM~Place, data=REM_GNS, FUN=mean) aggregate(REM~Place, data=REM_GNS, FUN=sd)


Input: calculating sociality bias ratio variable  Converting the amount of dream interactions to same scale  as the amount of wake time interactions was reported [CODESPLIT] IN$int_cat<-ifelse(IN$Interactions == 0, 1, ifelse(IN$Interactions >= 1 & IN$Interactions <= 5, 2, ifelse(IN$Interactions >= 6 & IN$Interactions <= 15, 3, ifelse(IN$Interactions >= 16 & IN$Interactions <= 25, 4,5)))) IN$dream_per_sos<-IN$int_cat/IN$sos_int_prev_day hist(IN$dream_per_sos) qqnorm(IN$dream_per_sos) #skewed hist(log(IN$dream_per_sos)) qqnorm(log(IN$dream_per_sos)) #looks more normally distributed after log-transformed


Input: join predicted to test data [CODESPLIT] test_pred <- left_join(test,prediction,by="id") test_pred <- as.data.frame(test_pred) test_pred$class_var <- as.factor(test_pred$class_var) test_pred$class_var_pred <- as.factor(test_pred$class_var_pred)


Input: Computing SMD (g) and its variance [CODESPLIT] smd <- escalc(measure = "SMD", m1i = wm, m2i = mm, sd1i = wsd, sd2i = msd, n1i = wn, n2i = mn, data = smd.means, append = TRUE) smd #Two columns (yi and vi) have been added#


Input: Computing Fisher's z and its variance [CODESPLIT] zcor <- escalc(measure = "ZCOR", ri = cor, ni = sample, data = zcor.correlations, append = TRUE) zcor


Input: Obtaining the forest plot [CODESPLIT] forest(res)


Input: Analog to ANOVA: If we want to know the mean ES for each 'random' level: yes/no [CODESPLIT] res_r <- rma(yi = g, vi = var, mods = ~ factor(random)-1, data = dat) res_r


Input: Obtaining a funnel plot (model without moderators) [CODESPLIT] funnel(res, main = "Random-Effects Model")


Input: inspect potential multicollinearity using the variance inflation factor (VIF),  for the example of the criterion variable outcome_sqd  (see Fox, 2016 for a discussion of VIFs and their cutoffs)  [CODESPLIT] lm_sqd <- lm(outcome_sqd ~ X + Y + X2 + XY + Y2, data=df) vif(lm_sqd)


Input: Mixed effects logistic regression [CODESPLIT] logistic_model_1 <- glmer(instructions ~ distance + (1|ID) + (1|target) + (1|task), data = choices, family = binomial(link = "logit")) logistic_model_2 <- glmer(instructions ~ distance + (1 + distance|ID) + (1|target) + (1|task), data = choices, family = binomial(link = "logit")) logistic_model_3 <- glmer(instructions ~ distance + (1 + distance|ID) + (1|target) + (1 + distance|task), data = choices, family = binomial(link = "logit"), control = glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 100000))) model_comparison <- anova(logistic_model_1, logistic_model_2, logistic_model_3)


Input: GLMMs  results of models with year as continuous are in table 3 Model with year as continuous variable [CODESPLIT] mod1ADI<-lmer(ADImS~LAT+LONG+YEAR1+(1|STATE)+(1|ROUTE2)+(1|SITE)+(1|YEAR1),dat=datUS,REML=F) mod1ADI<-lmer(ADImS~LAT+LONG+YEAR1+(1|SITE)+(1|COUNTRY)+(1|YEAR1),dat=datEU,REML=F)


Input: familiarity x female x BL   check effect of Baseline on familiarity x gender (self) interaction [CODESPLIT] HR_test_BL = lmer(HR_EMA ~ SI_familiarity_cw * female * HR_BL_cb + female * SI_gender_partner + SIAS_cb + State_SI_Anxiety_cw + SI_count + SI_type_simple + SI_duration_cw + SI_caffeine + SI_nicotin + SI_alcohol + accel_EMA_cw + (1|Participant), data=df_interact) summary(HR_test_BL) Anova(HR_test_BL, type=3) anova(HR_A, HR_test_BL) # no difference RMSSD_test_BL = lmer(ln_RMSSD_EMA ~ SI_familiarity_cw * female * ln_RMSSD_BL_cb + female * SI_gender_partner + SIAS_cb + State_SI_Anxiety_cw + SI_count + SI_type_simple + SI_duration_cw + SI_caffeine + SI_nicotin + SI_alcohol + accel_EMA_cw + (1|Participant), data=df_interact) summary(RMSSD_test_BL) Anova(RMSSD_test_BL, type=3) anova(RMSSD_A, RMSSD_test_BL) # better


Input: let's try to create a boxplot for mpg on the  of cylinders (cyl) [CODESPLIT] ggplot(mtcars, aes(factor(cyl), mpg)) + geom_boxplot()


Input: Likelihood Ratio Tests for nested model comparison [CODESPLIT] pair1_rand_anova <- anova(pair1_rand_full, pair1_rand2, pair1_rand3) # empty model = pair1_rand2 pair1_rand_anova_tidy <- tidy(pair1_rand_anova) pair2_rand_anova <- anova(pair2_rand_full, pair2_rand2, pair2_rand3) pair2_rand_anova_tidy <- tidy(pair2_rand_anova)  # create tidy table of model parameters pair2_fixed_anova <- anova(pair2_full, pair2_fixed, pair2_fixed2, pair2_fixed3, pair2_rand2) pair2_fixed_anova_tidy <- tidy(pair2_fixed_anova)  # create tidy table of model parameters pair2_fixed_lmer <- tidy(pair2_fixed2)  # create tidy table of model parameters group1_rand_anova <- anova(group1_rand_full, group1_rand2, group1_rand3, group1_rand4) # a random intercept for each pair is significantly better than empty, otherwise all other random effects tested were not warranted group1_rand_anova_tidy <- tidy(group1_rand_anova)  # create tidy table of model parameters group1_rand_lmer <- tidy(group1_rand3)  # create tidy table of model parameters group2_rand_anova <- anova(group2_rand_full, group2_rand2, group2_rand3, group2_rand4, group2_rand5) group2_rand_anova_tidy <- tidy(group2_rand_anova)  # create tidy table of model parameters group2_rand_lmer <- tidy(group2_rand2)  # create tidy table of model parameters


Input: Fills in missing values of x with the mean of x   Args:    x: a numeric vector   Returns:    x with missing values filled in [CODESPLIT] return(replace(x, is.na(x), mean(x, na.rm = T))) } mseOfMatchingColumns <- function(nm, mat, dt) {


Input: **** 0.3.4) logisticPseudoR2s   calculates Logistic pseudo Rs (from Field et al., 2013)  input: glm object  [CODESPLIT] logisticPseudoR2s <- function(LogModel) { dev <- LogModel$deviance nullDev <- LogModel$null.deviance modelN <- length(LogModel$fitted.values) R.l <- 1 - dev / nullDev R.cs <- 1- exp ( -(nullDev - dev) / modelN) R.n <- R.cs / ( 1 - ( exp (-(nullDev / modelN)))) outdat <- data.table(R.l = R.l, R.cs = R.cs, R.n = R.n) outdat[, r.sq.print := paste(round(R.l, 3), "/", round(R.cs, 3), "/", round(R.n, 3), sep = "")] return(outdat) }


Input: for loop goes through all the files in myLists and applies addTagsTextEntry to each row in the file [CODESPLIT] for (k in 1:length(myLists)) { i <- paste("list", k, ".txt", sep = "") o <- paste("upload", k, ".txt", sep = "") f <- read.delim(i, header = FALSE, stringsAsFactors = FALSE) write("[[AdvancedFormat]]", o) apply(f, 1, addMultiChoiceSame, o) } rm(list=ls())


Input: compute mean LT per condition, group and accuracy  [CODESPLIT] LT <- ddply(data, .(rctype,group,acc_lab), summarize, mean.rt = mean(rt), se.lower = mean.rt - se(rt), se.upper = mean.rt + se(rt))


Input: Fit uni.cfa and save output in uni.cfi.fit. Use fixed factor (std.lv  TRUE), and FIML for missing data)  [CODESPLIT] uni.cfa.fit = cfa(uni.cfa, data = SSSSdat, std.lv = TRUE, missing = "ML")


Input: Request summary output from model, including fit indexes, standardized estimates, and R^2/communalities  [CODESPLIT] summary(uni.cfa.fit, fit.measures = TRUE, standardized = TRUE, rsquare=TRUE) summary(five.cfa.fit, fit.measures = TRUE, standardized = TRUE, rsquare=TRUE) summary(five.sem.parcel.corr.fit, fit.measures = TRUE, standardized = TRUE, rsquare=TRUE) summary(five.sem.parcel.reg.fit, fit.measures = TRUE, standardized = TRUE, rsquare=TRUE)


Input: We need to get an idea of how many factors are likely needed. Parallel analysis can help. Save output in object "parallel", using psych() fa.parallel function. Variables 125 (the BFI items) are to be analzyed, using maximum likelihood (ml) common factors (fa). Simulate 50 other samples of "garbage factors", using R^2s (SMC) as initial communality estimates and compare observed eigenvalues to 95th quantile of simulated "garbage factor" eigenvalues  [CODESPLIT] parallel = fa.parallel(SSSSdat[1:25], fm = 'ml', fa = 'fa', n.iter = 50, SMC = TRUE, quant = .95)


Input: Fit measurement invariance models based on five.cfa model, distinguishing by group levels of "gender". Save output in invar.output object  [CODESPLIT] invar.output = measurementInvariance(five.cfa, data = SSSSdat, group = "gender")


Input: Create function to calculate ICC from fitted model: ICC  between family variance / total family variance [CODESPLIT] calc.icc <- function(y) { sumy <- summary(y) (sumy$varcor$famnumber[1]) / (sumy$varcor$famnumber[1] + sumy$sigma^2) } calc.icc <- function(y) { sumy <- summary(y) (sumy$varcor$famnumber[1]) / (sumy$varcor$famnumber[1] + sumy$sigma^2) }


Input: ** 5.2) Poisson regression   **** 5.2.1) Full set   model 1: summary effect (absolute value) [CODESPLIT] pred.nbias.1 <- glm(nmeth_bias ~ scale(abs(MA_ES_self)), data = dat[!is.na(nmeth_bias) & k_self > k_thres, ], family = poisson) summary(pred.nbias.1) rsq.pred.nbias.1 <- logisticPseudoR2s(pred.nbias.1)


Input: ANOVA dependent variable: drift rate independent variable:masking time condition  letters task, pretest  [CODESPLIT] cv_pre_drift = cogito %>% gather(key = "maskingtime", value = "drift", cvt1_v1,cvt1_v2,cvt1_v3,cvt1_v4) %>% convert_as_factor(obs, maskingtime) aov_cv_pre <- anova_test(data = cv_pre_drift , dv = drift, wid = obs, within = maskingtime, type=3, detailed=T) get_anova_table(aov_cv_pre, correction="none")


Input: subsample of the PG without patients with schizophrenia or other psychotic disorders (F20. or F23.) [CODESPLIT] subsample_PGwithoutF20_23 <- subsample_PG[subsample_PG$F20_23==0, ]


Input: function returns raster of posterior probabilities for bivariate normal data  x is the unknown tissue of interest, will have two values, one for each isotope  m is a 2D vector, all the values in the raster for each isotope  v is the same as m, but for variances  r is a single number  the covariance. Can be vector if estimated as nonstationary  ras is a raster that will serve as a template for the final product  [CODESPLIT] calcCellProb2D <- function(x,m,v,r,ras) { pd <- 1/(2*pi*sqrt(v[,1])*sqrt(v[,2])*sqrt(1-r^2))*exp(-(1/(2*(1-r^2)))* ((x[1]-m[,1])^2/v[,1]+(x[2]-m[,2])^2/v[,2]-(2*r*(x[1]-m[,1])* (x[2]-m[,2]))/(sqrt(v[,1])*sqrt(v[,2])))) pdras <- setValues(ras,pd) return(pdras) }


Input: function returns raster of posterior probability distribution [CODESPLIT] calcPostProb <- function(x){ pp <- x/cellStats(x,sum) return(pp) }


Input: reproject the site coordinates to get the site to plot (thanks to P. Schauer) [CODESPLIT] myproj <- proj4string(origins)#get the CRS string iso.data.sp <- iso.data #make a copy coordinates(iso.data.sp) <- ~ Long + Lat #specify the coordinates proj4string(iso.data.sp) <- CRS("+proj=longlat +datum=WGS84") #project first iso.data.sp <- spTransform(iso.data.sp, myproj) #then re-project using the projection from the base map wrld_simpl2 <- wrld_simpl #make a copy wrld_simpl2 <- spTransform(wrld_simpl2, myproj) #this is to add in country borders etc. if you want to as they have the same projection issues as the site coords myproj <- proj4string(origins)#get the CRS string iso.data.sp <- iso.data #make a copy coordinates(iso.data.sp) <- ~ Long + Lat #specify the coordinates proj4string(iso.data.sp) <- CRS("+proj=longlat +datum=WGS84") #project first iso.data.sp <- spTransform(iso.data.sp, myproj) #then re-project using the projection from the base map wrld_simpl2 <- wrld_simpl #make a copy wrld_simpl2 <- spTransform(wrld_simpl2, myproj) #this is to add in country borders etc. if you want to as they have the same projection issues as the site coords myproj <- proj4string(origins)#get the CRS string iso.data.sp <- iso.data #make a copy coordinates(iso.data.sp) <- ~ Long + Lat #specify the coordinates proj4string(iso.data.sp) <- CRS("+proj=longlat +datum=WGS84") #project first iso.data.sp <- spTransform(iso.data.sp, myproj) #then re-project using the projection from the base map wrld_simpl2 <- wrld_simpl #make a copy wrld_simpl2 <- spTransform(wrld_simpl2, myproj) #this is to add in country borders etc. if you want to as they have the same projection issues as the site coords myproj <- proj4string(origins)#get the CRS string iso.data.sp <- iso.data #make a copy coordinates(iso.data.sp) <- ~ Long + Lat #specify the coordinates proj4string(iso.data.sp) <- CRS("+proj=longlat +datum=WGS84") #project first iso.data.sp <- spTransform(iso.data.sp, myproj) #then re-project using the projection from the base map wrld_simpl2 <- wrld_simpl #make a copy wrld_simpl2 <- spTransform(wrld_simpl2, myproj) #this is to add in country borders etc. if you want to as they have the same projection issues as the site coords myproj <- proj4string(origins)#get the CRS string iso.data.sp <- iso.data #make a copy coordinates(iso.data.sp) <- ~ Long + Lat #specify the coordinates proj4string(iso.data.sp) <- CRS("+proj=longlat +datum=WGS84") #project first iso.data.sp <- spTransform(iso.data.sp, myproj) #then re-project using the projection from the base map wrld_simpl2 <- wrld_simpl #make a copy wrld_simpl2 <- spTransform(wrld_simpl2, myproj) #this is to add in country borders etc. if you want to as they have the same projection issues as the site coords myproj <- proj4string(origins)#get the CRS string iso.data.sp <- iso.data #make a copy coordinates(iso.data.sp) <- ~ Long + Lat #specify the coordinates proj4string(iso.data.sp) <- CRS("+proj=longlat +datum=WGS84") #project first iso.data.sp <- spTransform(iso.data.sp, myproj) #then re-project using the projection from the base map wrld_simpl2 <- wrld_simpl #make a copy wrld_simpl2 <- spTransform(wrld_simpl2, myproj) #this is to add in country borders etc. if you want to as they have the same projection issues as the site coords myproj <- proj4string(origins)#get the CRS string iso.data.sp <- iso.data #make a copy coordinates(iso.data.sp) <- ~ Long + Lat #specify the coordinates proj4string(iso.data.sp) <- CRS("+proj=longlat +datum=WGS84") #project first iso.data.sp <- spTransform(iso.data.sp, myproj) #then re-project using the projection from the base map wrld_simpl2 <- wrld_simpl #make a copy wrld_simpl2 <- spTransform(wrld_simpl2, myproj) #this is to add in country borders etc. if you want to as they have the same projection issues as the site coords myproj <- proj4string(origins)#get the CRS string iso.data.sp <- iso.data #make a copy coordinates(iso.data.sp) <- ~ Long + Lat #specify the coordinates proj4string(iso.data.sp) <- CRS("+proj=longlat +datum=WGS84") #project first iso.data.sp <- spTransform(iso.data.sp, myproj) #then re-project using the projection from the base map wrld_simpl2 <- wrld_simpl #make a copy wrld_simpl2 <- spTransform(wrld_simpl2, myproj) #this is to add in country borders etc. if you want to as they have the same projection issues as the site coords


Input: cutting dendrogram in 3 clusters [CODESPLIT] clus3 = cutree(hcOSrenamel, 3) Women_WOCP_cluster<-plot(as.phylo(hcOSrenamel), type = "fan", tip.color = cbbPalette[clus3]) Women_WOCP_cluster


Input: calculate intercorrelations between diamonds on the betweenperson level with 95% Bootstrapped CI [CODESPLIT] between.person.diamonds = diamonds %>% group_by(user_id) %>% summarise(across(where(is.numeric), ~ mean(.x))) between.person.diamonds = between.person.diamonds %>% dplyr::select(diamonds_duty, diamonds_intellect, diamonds_adversity, diamonds_mating, diamonds_positivity, diamonds_negativity, diamonds_deception, diamonds_sociality) cors.diamonds = round(cor(between.person.diamonds, method = "pearson"),2) cors.diamonds = as.data.frame(cors.diamonds)


Input: Analysis  Linear Probability Model on Impact Factor [CODESPLIT] fit_ev_if <- lm(X1.year.Impact.Factor ~ diff_ev + factor(year), data=FullDataset) summary(fit_ev_if) # show results fit_ex_if <- lm(X1.year.Impact.Factor ~ diff_ex + factor(year), data=FullDataset) summary(fit_ex_if) # show results


Input: Tobit Model as robusntess check  assign value 0 to Impact factors for unpublished studies [CODESPLIT] FullDataset$X1.year.Impact.Factor[FullDataset$published == "No"] = 0 tobit_ev_if <- censReg( X1.year.Impact.Factor ~ diff_ev + factor(year), data = FullDataset, left = 0) summary(tobit_ev_if) tobit_ex_if <- censReg( X1.year.Impact.Factor ~ diff_ex + factor(year), data = FullDataset, left = 0) summary(tobit_ex_if)


Input: initialize standard error function [CODESPLIT] stderr <- function(x, na.rm=FALSE) { if (na.rm) x <- na.omit(x) sqrt(var(x)/length(x)) }


Input: 2019 data  zstandardize mood scores for each person [CODESPLIT] dat2019_scaled <- dat2019_complete %>% dplyr::select(identity_id, country, doy, mood, weekday) %>% group_by(identity_id)  %>% mutate_at(vars(-identity_id,-doy,-country, -weekday), scale)


Input: Run regression anlayses and save as table (make one table with mood and depression  see depression section) [CODESPLIT] m1_het <- lm(mood_change ~ gender + age + education_level + race, data = dat_het_prepost) m2_het <- lm(depression_change ~ gender + age + education_level + race, data = dat_het_prepost) tab_model(m1_het, m2_het, show.est = F, show.std = T, digits = 3, file="Mood_Depression_PrePost_Demog_std.doc")


Input: Run multilevel model analyses predicting mood scores from the the dummycoded month variable [CODESPLIT] dat2020_complete$month <- as.factor(dat2020_complete$month) summary(m1 <- lmer(depression ~ month + (1|identity_id), data = subset(dat2020_complete, country == "United States"))) summary(m2 <- lmer(depression ~ month + (1|identity_id), data = subset(dat2020_complete, country == "Germany"))) summary(m3 <- lmer(depression ~ month + (1|identity_id), data = subset(dat2020_complete, country == "United Kingdom"))) tab_model(m1,m2,m3, show.est = F, show.std = T, digits = 3, file="Depression_2020_Months.doc")


Input: Step 2: Create onehot encodings (dummy variables) [CODESPLIT] testData3 <- predict(dummies_model, testData2) testData3 <- predict(dummies_model, testData2) testData3 <- predict(dummies_model, testData2) testData3 <- predict(dummies_model, testData2) testData3 <- predict(dummies_model, testData2)


Input: function to generate output csv files for a list of response IDs  inputs: dataset, list of response IDs  outputs: csv files named with response IDs  [CODESPLIT] multi_response <- function(dataset, IDs_list) { for (i in IDs_list) { participant_response <- single_response(dataset, i) csv_name <- str_c(i, ".csv", sep = "") write.csv(participant_response, csv_name) } }


Input: Means and SDs of proportional looking time to novel object in the preferential looking phase  condition 1 [CODESPLIT] mean(dfX_base$PrefLook_LT_Object_Nov_PROP[which(dfX_base$Condition == "Con1")], na.rm = TRUE)


Input: calculate mode of a vector [CODESPLIT] mode.knn =  function(x){ uniq.x = unique(x) uniq.x = uniq.x[which(!is.na(uniq.x))] knn = uniq.x[which.max(tabulate(match(x, uniq.x)))] return(knn) }


Input: find [k] neigherst neigbors and impute by their mode [CODESPLIT] impute.knn = function(y, k){ t = which(is.na(y)) if(length(t) == 0){ return(y) }else{ is = 1:length(t) for(i in is){ if(i > k){ look.at = y[(t[i]-k):(t[i]+k)] y[t[i]] = mode.knn(look.at) } if(i <= k){ look.at = y[1:(t[i]+k)] y[t[i]] = mode.knn(look.at) } } return(y) } }


Input: get categorical data information then look up the variables in the process  in categorical_data so we can get the number of categories for each variable in the process  this would be achieved by categories[cat_indices[i]] for variable i in the process [CODESPLIT] categories <- as.integer(mplus.get.group.attribute(file,'categorical_data','categories')) catvars <- mplus.get.group.attribute(file,'categorical_data','var_names') vartypes <- as.integer(mplus.get.group.attribute(file,'categorical_data','vtype')) if (series) { categories <- as.integer(mplus.get.group.attribute(file,'categorical_data','categories')) catvars <- mplus.get.group.attribute(file,'categorical_data','var_names') vartypes <- as.integer(mplus.get.group.attribute(file,'categorical_data','vtype')) if (series) {


Input: get indices and names of the variables in the series [CODESPLIT] var_indices <- mplus.get.group.attribute(file,cstr2,'var_indices') var_names <- mplus.get.group.attribute(file,cstr2,'var_names') cat_indices <- pmatch(var_names, catvars, nomatch=0) cat_indices <- as.integer(cat_indices) var_indices <- mplus.get.group.attribute(file,cstr2,'var_indices') var_names <- mplus.get.group.attribute(file,cstr2,'var_names') cat_indices <- as.integer(pmatch(var_names, catvars, nomatch=0))


Input: extract correlations between selfreported scores (observational level!) [CODESPLIT] self.reported.scores = c("duty", "intellect", "mating", "positivity", "sociality") l = "mating" for(i in self.reported.scores[1:length(self.reported.scores)-1]){ data_phi = ftable(data[,c(paste0("diamonds_", l), paste0("diamonds_", self.reported.scores[which(self.reported.scores == i)+1]))]) print(paste(l, "and", self.reported.scores[which(self.reported.scores == i)+1])) print(phi(data_phi)) }


Input: generate unique study identifier, format and annotate data  [CODESPLIT] d$id <- paste0(d$First_Author,", ", d$Year) d$Year <- as.numeric(substr(d$Year,1,4)) d$ids <- NA for(i in d$id) d[d$id == i,"ids"] <- 1:dim(d[d$id == i,"ids"])[1] d$ids <- as.character(d$ids) d$Age <- (as.numeric(d$Age_M) - 30) / 20 d$energy_renew <- d$energy_renew1 + d$energy_renew2 find_cCode <- Vectorize(function(i) which(unlist(Map(function(x) sum(d[i,grepl("SVS",names(d))] - f[x,grepl("SVS",names(f))]), 1:dim(f)[1])) == 0)) d$Ccode <- f$Ccode[find_cCode(1:dim(d)[1])]


Input: to make sure that effects are tested from complex to simple, we reverse the order of the vector containing the to be tested effects:  [CODESPLIT] effects_to_test = rev(effects_to_test)


Input: combine model matrix and data to include participant id and DV: [CODESPLIT] new_data = data.frame(dplyr::select(data, contains(c(group, DV_variables, by))), model_matrix)


Input: check if retention is a number from 0 to 1 [CODESPLIT] if (retention < 0 || retention > 1) { stop('Retention value is not a number from 0 to 1.') }


Input: construct a maximal glmer() model  This model contains code for Ambiguity effect,  plus random effects by participants and items.  [CODESPLIT] Acc.Modality.max <- glmer(Correct ~ 1 + Ambiguity.code + (1 + Ambiguity.code | Ã¯..ID) + (1   | Item), data = Data.DisambTask.AmbvsUnamb, family = "binomial", control = glmerControl(optimizer ="bobyqa"))


Input: create a histogram of the residuals [CODESPLIT] hist(rawResiduals) hist(invResiduals) hist(logResiduals)


Input: construct a maximal lmer() model  This model contains a fixed withinsubjects effect of Ambiguity (effectcoded with 0.5 amb)  plus random effects by participants and items. [CODESPLIT] RT.max <- lmer(logRT ~ 1 + Ambiguity.code + (1 + Ambiguity.code | Ã¯..ID) + (1   | Item), data = Data.DisambTask.AmbvsUnamb, REML=FALSE)


Input: construct a maximal glmer() model  This model contains codes for Modality effects,  plus random effects by participants and items.  [CODESPLIT] Acc.Modality.max <- glmer(Correct ~ 1 + Modality.code1 + Modality.code2 + (1 + Modality.code1 + Modality.code2 | Ã¯..ID) + (1   | Item), data = Data.DisambTask.Amb, family = "binomial", control = glmerControl(optimizer ="bobyqa")) Acc.Modality.max <- glmer(True.Positive ~ 1 + Modality.code2 + (1 + Modality.code2 | ID) + (1   | Item), data = Data.ListAndRead, family = "binomial", control = glmerControl(optimizer ="bobyqa")) Acc.Modality.max <- glmer(True.Positive ~ 1 + Modality.code3 + (1 + Modality.code3 | ID) + (1   | Item), data = Data.ListAndRSVP, family = "binomial", control = glmerControl(optimizer ="bobyqa")) Acc.Modality.max <- glmer(True.Positive ~ 1 + Modality.code3 + (1 + Modality.code3 | ID) + (1   | Item), data = Data.ReadAndRSVP, family = "binomial", control = glmerControl(optimizer ="bobyqa"))


Input: construct a maximal glmer() model  This model contains codes for run effects,  plus random effects by participants and items.  [CODESPLIT] Acc.Run.max <- glmer(Correct ~ 1 + Run.code1 + Run.code2 + (1 + Run.code1 + Run.code2 | Ã¯..ID) + (1   | Item), data = Data.DisambTask.Amb, family = "binomial", control = glmerControl(optimizer ="bobyqa")) Acc.Run.max <- glmer(True.Positive ~ 1 + Run.code1 + Run.code2 + (1 + Run.code1 + Run.code2 | ID) + (1   | Item), data = Data.RecMem, family = "binomial", control = glmerControl(optimizer ="bobyqa"))


Input: run a onesample ttest comparing accuracy to chance level (0.5) [CODESPLIT] t.test(Data.List$True.Positive, mu=0.5) t.test(Data.Read$True.Positive, mu=0.5) t.test(Data.RSVP$True.Positive, mu=0.5)


Input: abbreviate first names to match with abbreviations in publication list [CODESPLIT] stats_persons <- lapply(stats_persons, function(x){ x[2]<-str_sub(x[2], 1, 1) x }) stats_persons <- lapply(stats_persons, function(x)paste(x[1], x[2], sep = ","))


Input: Load the data [CODESPLIT] load('../Relative Effectiveness Data - final.Rdata')


Input: Print a txt and csv file with the results ' ' @param stats_to_print the tibble/table to print ' @param name_file name of the file to write ' ' @return 2 files with the results (txt and csv) [CODESPLIT] print_result <- function(stats_to_print, name_file){ knitr::kable( stats_to_print, format = "rst")  %>% cat( file = here('results', str_c(name_file, '.txt', sep = "")), sep = "\n") stats_to_print %>% write_csv(file = here('results', str_c(name_file, '.csv', sep = ""))) }


Input: convert degrees of freedom into numeric variables and store in new variable [CODESPLIT] ScienceStatus$df.numerator.value = as.numeric(as.character(ScienceStatus$df.numerator)) ScienceStatus$df.denominator.value = as.numeric(as.character(ScienceStatus$df.denominator))


Input: Assigning numeric values to variable labels which were stored in CSV [CODESPLIT] ScienceStatus$coding.difficulty_r = revalue(ScienceStatus$coding.difficulty, c("Very Easy"="1", "Moderately Easy"="2", "Slightly Easy"="3", "Neither Difficult nor Easy"="4", "Slightly Difficult"="5", "Moderately Difficult"="6", "Very Difficult"="7")) ScienceStatus$coding.difficulty_r = as.numeric(as.character(ScienceStatus$coding.difficulty_r))


Input: Calcuate EXACT pvalue from the stats reported in the paper (Posthoc) [CODESPLIT] ScienceStatus_J$Calc.Pvalue<-(rowSums(cbind(ScienceStatus_J$T.pvalue_calc, ScienceStatus_J$F.pvalue_calc, ScienceStatus_J$rg.pvalue_calc, ScienceStatus_J$r.pvalue_calc,ScienceStatus_J$chi.pvalue_calc), na.rm = TRUE) + ifelse(is.na(ScienceStatus_J$T.pvalue_calc) & is.na(ScienceStatus_J$F.pvalue_calc) & is.na(ScienceStatus_J$rg.pvalue_calc) & is.na(ScienceStatus_J$r.pvalue_calc) & is.na(ScienceStatus_J$chi.pvalue_calc), NA, 0))


Input: PCurve Graph      Calculated from statistic and DF   By Paper [CODESPLIT] P.By.Paper<-ddply(ScienceStatus_SP, .(article.id,yearcat), summarize, Pmean.calc = stouffer.P(Calc.Pvalue.Clean), PMedian.calc = median(Calc.Pvalue.Clean))