Input: exclude NAs from data [CODESPLIT] data <- data[complete.cases(data$average), ] summary(data) nrow(data)


Input: 2. compare model indices (ICC, conditional and margina RÂ²)  [CODESPLIT] tab_model(model0.1, model1, model1_full) tab_model(model0.1, model2, model2_full) tab_model(model0.2, model3, model3_full)


Input: Plot robust model 1  get predicted Values for different levels of rsa_socialresources [CODESPLIT] gg_model1 <- ggpredict(model1_robust, c("daycount[0, 25, 50, 75]", "rsa_socialresources[meansd]", "diagnosis"))


Input: count of articles that generated data using experimental techniques (includes articles that use both, percentage calculated using total empirical articles)  [CODESPLIT] GenerateData[2,2] <- sum(MMCPSR_emp$EHPdata) GenerateData[2,3] <- sum(MMCPSR_emp$EHPdata)/nrow(MMCPSR_emp)


Input: Data organization   Rename columns/variable names to make it simpler variable names [CODESPLIT] colnames(srmadata) srmadata <- srmadata %>% rename(assessors = 2, journal = 3, pubyear = 4, pubmonth = 5, study.title = 6, pmid = 7, regist = 8, regist.num = 9, protocol = 10, title.ident = 11, ab.sources = 12, ab.eleg.crit = 13, ab.particip = 14, ab.interv = 15, ab.effect = 16, ab.included = 17, ab.outcome = 18, in.picos = 19, me.database = 20, me.search.avai = 21, me.grey.lit = 22, me.date.just = 23, me.lang.num = 24, me.picos.desc = 25, me.sele.dup = 26, me.extr.dup = 27, me.rob.desc = 28, me.rob.dup = 29, me.stat.desc = 30, me.heterog = 31, item.removed01 = 32, re.flowdia = 33, re.ssizes = 34, re.picos.desc = 35, re.lengths = 36, re.estim.desc = 37, re.meta.studies = 38, re.rob = 39, re.deviations = 40, di.spin = 41, di.rob.studies = 42, di.limitations = 43, data.statem = 44, fund.statem = 45, funders = 46, coi.statem = 47)


Input: Redefine columns types to factor [CODESPLIT] srmadata <- data.frame(srmadata) srmadata %>% mutate_if(is.character, as.factor) %>% str()


Input: Add labels to variables in participant dataframe;; then, generate table  [CODESPLIT] table1::label(participant$ab.particip) <- "Description of participants (ab)" table1::label(participant$re.picos.desc) <- "Detailed studies' characteristics" table1::table1(~ab.particip + re.picos.desc, data = participant)


Input: HISTOGRAM   Generate a histogram of density of scores achieved by the 104 assessed studies  Create a 0 or 1 dataset, where No0 and Yes1, with respective study IDs (variable "id")  [CODESPLIT] id <- (1:104) allbinary <- data.frame(id, transparency, completenessbinary, participant, intervention, outcome, rigorbinary, appraisalbinary) allbinary[allbinary == "Yes"] <- "1" allbinary[allbinary == "No"] <- "0" lapply(allbinary,as.numeric)


Input: Set the dataframe as numeric so that we can sum up recommended practices for each study (variable "yes.score")  [CODESPLIT] allbinary[] <- lapply(allbinary, function(x) as.numeric(as.character(x)))


Input: Create a new dataframe (binarytotalsdf) with a new variable (yes.score) that reflects the number of recommended practices from each study [CODESPLIT] binary-scoredf <- allbinary %>% mutate(yes.score = regist + protocol + me.search.avai + data.statem + + title.ident + + ab.sources + ab.eleg.crit + ab.included + in.picos + me.picos.desc + re.flowdia + + re.ssizes + re.lengths + fund.statem + coi.statem + ab.particip + re.picos.desc + + ab.interv + re.picos.desc + ab.outcome + me.stat.desc + me.heterog + re.estim.desc + + re.meta.studies + me.grey.lit + me.date.just + me.lang.num + me.sele.dup + me.extr.dup + + me.rob.desc + me.rob.dup +re.rob + re.deviations + di.spin + di.rob.studies + + di.limitations)


Input: Create the histogram [CODESPLIT] histplot.score <- ggplot(binary-scoredf, aes(x=yes.score)) + geom_histogram(binwidth=1, color="black", fill="lightblue") histplot.score + scale_x_continuous(name="Number of recommended practices (max: 36 items)", breaks=seq(0,36,2)) + scale_y_continuous(name="Frequency of publications", limits=c(0, 20)) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_line(colour = "black"))


Input: Load data: data file "hfp" contains individuallevel foraging return data (kcal) at the daily level along with the date, unique camp id, age, sex, and unique person id.  [CODESPLIT] hfp <- read.csv("food_pro_data.csv", as.is=T) h <- hfp[hfp$age > 5,] h$age_z <- (h$age-mean(h$age, na.rm=T))/sd(h$age, na.rm=T) h$month <- month(ymd(h$date))


Input: Plot the marginal/conditional effects for predicted values and probability of zerodays [CODESPLIT] p <- conditional_effects(hadza_lognormal_returns_model, effects=c("age_z:sex"))  # includes the hurdle component p2 <- conditional_effects(hadza_lognormal_returns_model, effects=c("age_z:sex"), dpar="hu") # to see the hurdle component (Pr zero-days) plot(p)[[1]] + scale_x_continuous(breaks = c(-1, 0, 1, 2), labels= round(c(-1, 0, 1, 2)*sd(h$age, na.rm=T) + mean(h$age, na.rm=T))) + ggplot2::labs(x="Age", y="kcal/day") +ggplot2::lims(y=c(0,6500)) + theme_classic() plot(p2)[[1]] + ggplot2::lims(y=c(0,1)) + labs(x="Age", y="Probability of zero day\n(hurdle component of model)") + theme_classic() + scale_x_continuous(breaks = c(-1, 0, 1, 2), labels= round(c(-1, 0, 1, 2)*sd(h$age, na.rm=T) + mean(h$age, na.rm=T)))


Input: Calculate overall mean standard length (Ls) [CODESPLIT] Ls <- mean(standard.length, na.rm = TRUE)


Input: Generate Psi of an AR(1) model [CODESPLIT] Psi = diag(p) diag(Psi) = runif(p,b.ar.min,b.ar.max) return(Psi) }


Input: We use the R package qgraph to visualize our matrix [CODESPLIT] if (!require(qgraph)) install.packages("qgraph");; require(qgraph)


Input: VISUALIZE YOUR NETWORKS  Make sure you have the right package: qgraph [CODESPLIT] if (!require(qgraph)) install.packages("qgraph");; require(qgraph)


Input: load source functions and data  generates four data sets: FF, FS, SF, SS  [CODESPLIT] source("prep-Exp1-data.r") source("pmwg-DIC.r")


Input: estimate model independently for each condition in the experiment [CODESPLIT] for(condition in names(all.data)) { cat("\n\n\n\nEstimating model for: ", condition, "\n\n") fnam <- paste0("Exp1-LBA-", model.par, "-", condition, ".RData")


Input: Then write loop to go through all Scopus IDs, adding the output to the first dataframe  NOTE: create 'output' folder in your working directory before running the following code  [CODESPLIT] for (i in 1:length(authors)){ tryCatch({ #using tryCatch () to go around error https://stackoverflow.com/questions/14748557/skipping-error-in-for-loop. So here it skips the authorIDs with an error and keeps going res = retrievalByAuthorID(authors[i], apik) M2 = res$M output <- rbind(M,M2) write.csv(output, paste0(output$AU_ID[1],".csv"), row.names=F) #creates seperate csv's for each Scopus ID }, error=function(e){}) }


Input: Select first letter of first name + surname [CODESPLIT] for(i in names(x)){ firstname = word(x[[i]],-1) initial = substring(firstname, 1, 1) surname = word(x[[i]],-2) surname[is.na(surname)] <- "" tot = as.data.frame(paste(initial, surname,sep = ".")) tot[tot=="."]="" x[[i]] <- tot  #join first and last name with a full stop }


Input: Add a column per author, indicating which papers belong to them (0 or 1)  [CODESPLIT] authors = as.character(unique(authorswithAPInotworking$author.name)) x[is.na(x)]="" for(i in (authors)){ x$i = rowSums(x == i) colnames(x)[colnames(x) == 'i'] <- i } ncol.new = ncol(x)


Input: Have a look at distribution first and last years, to look at outliers  [CODESPLIT] hist(as.numeric(new$first.year)) hist(as.numeric(new$last.year))


Input: Add position of word in sentence (prefabricated list made in Python) [CODESPLIT] positionlist <- read.delim("U:/surfdriveRU/Thesis analyse/LMM analyse/positionlist.txt", header = FALSE) eyetrackingdata$position <- positionlist$V1


Input: density plotting function [CODESPLIT] denschart3 <- function (x, labels = NULL, groups = NULL, gdata = NULL, cex = par("cex"), pt.cex = cex, bg = par("bg"), color = "grey20", colorHPDI ="grey60", HPDI=0.9, vline = NULL, gcolor = par("fg"), lcolor = "gray", xlim = range(unlist(x)), yvals = 1:length(x), yextra=0.7, main = NULL, xlab = NULL, ylab = NULL, height=0.7 , border=NA, adjust=1, ...) { opar <- par("mai", "mar", "cex", "yaxs") on.exit(par(opar)) par(cex = cex, yaxs = "i") if (!is.list(x)) stop("'x' must be a list of vectors or matrices") n <- length(x) glabels <- NULL if (is.list(x)) { if (is.null(labels)) labels <- names(x) if (is.null(labels)) labels <- as.character(1L:n) labels <- rep_len(labels, n)


Input: Data wrangling    recode values for missing data (9, 999) in whole dataset as NA  [CODESPLIT] data <- data %>% mutate_all(~na_if(., -999)) data <- data %>% mutate_all(~na_if(., -9))


Input: Moderated regression    center variables [CODESPLIT] data$ls.1c <- data$ls.1 - 3.57 data$sc.c  <- scale(data$sc,   center = T, scale = F) data$mob.c <- scale(data$mob,  center = T, scale = F) data$age.c <- scale(data$age,  center = T, scale = F)


Input: get standardised regression coefficients [CODESPLIT] lm.beta(fit1) lm.beta(fit2)


Input: Plots Moderated regression [CODESPLIT] psych::describe(data[c("sc", "mob")]) interact_plot(fit1, pred = mob.c, modx =sc.c, #partial.residuals = TRUE, interval = TRUE, int.width = 0.95, modx.values = c(-1.48, 0, 1.48), colors = c("#D9ED92", "#52B69A", "#1E6091"), modx.labels = c("Low (- 1SD)", "Middle (Mean)", "High (+ 1SD)"), legend.main = "Perceived status loss") + labs(y = "Predicted life satisfaction", x = "Upward mobility beliefs") + guides(fill = guide_legend(title = "Perceived status loss")) + coord_cartesian(ylim = c(1,7)) + scale_y_continuous(expand = c(0, 0), breaks = c(1,2,3,4,5,6,7)) + scale_x_continuous(expand = c(0.05, 0.05), breaks = c(-2.94,-1.94, -0.94, 0.06, 1.06, 2.06, 3.06), labels = c(0,1,2,3,4,5,6)) + theme_classic(base_size = 15) + theme( axis.title = element_text(colour = "black", size = 19, margin = margin(t = 0, r = 15, b = 0, l = 0)), axis.text.x  = element_text(colour = "black", size = 19, margin = margin(t = 15, r = 0, b = 0, l = 0)), axis.text.y  = element_text(colour = "black", size = 19), legend.position = c(0.7,0.85), legend.title = element_text(size = 17), legend.text = element_text(size = 17), legend.key.width = unit(1,"cm") ) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank())


Input: get diffs  get rownumbers in order to get the corresponding RecordingTime [CODESPLIT] rownums_parent <- fi_pairs$fiend[latencies[[curr_colname]][[curr_hitname]]$fi_pairs[[1]]] rownums_successor <- fi_pairs$fistart[latencies[[curr_colname]][[curr_hitname]]$fi_pairs[[2]]]


Input: Funnel plot  carry out trimandfill analysis [CODESPLIT] taf<-trimfill(m.random,main="", ma.fixed = FALSE, fixed = FALSE, random = TRUE, label=F)


Input: draw funnel plot with missing studies filled in [CODESPLIT] funnel(taf, legend=TRUE) summary(trimfill(m.random))


Input: create container variable to store results [CODESPLIT] if(exists("data.full") == 0){ subject <- c(1:50) mean.3SD <- NA sd.3SD <- NA min.3SD <- NA max.3SD <- NA container.3SD <- data.frame(subject, mean.3SD, sd.3SD, min.3SD, max.3SD) } container.3SD$mean.3SD[i] <- mean(data.3SD$rt) container.3SD$sd.3SD[i] <- sd(data.3SD$rt) container.3SD$min.3SD[i] <- container.3SD$mean.3SD[i] - 3*container.3SD$sd.3SD[i] container.3SD$max.3SD[i] <- container.3SD$mean.3SD[i] + 3*container.3SD$sd.3SD[i]


Input: setting up colors and line types for plots [CODESPLIT] ns=unique(qms$name) nl=length(ns) disp=data.frame(name=ns,lty=rep(1:9,nl)[1:nl]) disp$col=ifelse(grepl('Hit|Rod',disp$name),'#880101','#aaaaaa') disp$lty[grepl('Hit|Rod',disp$name)]=1:2


Input: plot the results of the vector fits  color ages > 85 in red [CODESPLIT] col <- c("gray", "red")[1 + (age >= 85)] main <- "PCoA of Pollen: pollen and independent vectors fitted onto ordination" plot(poln.ord$points, pch = 21, type = "p", xlab = paste0("PCoA I (", round(var.expl[1] * 100, 1), "%)"), ylab = paste0("PCoA II (", round(var.expl[2] * 100, 1), "%)"), main = main, col = "black", bg = col, cex = 1.5, xaxt = "n", yaxt = "n", bty = "n") axis(1, at = seq(-0.5, 1, by = 0.25)) axis(2, at = seq(-1, 0.25, by = 0.25)) legend(0.5, -0.85, pch = c(21, 21, NA), lty = c(NA, NA, 1), lwd = c(NA, NA, 2), col = c("black", "black", "light blue"), pt.bg =  c("gray","red", NA), cex = 1.25, legend = c("Post 85k", "Pre 85k", "Lake Level"))


Input: create categorical variables [CODESPLIT] share <- to_factor( share, select = c("health_past3months", "wave", "gender", "covid_affected", "partnerinhh", "covid_regime_si3", "covid_regime_ch3") ) share$stringency_index <- share$global_covid_regime_si3


Input: Overall mean of Social factors [CODESPLIT] share_all <- data_filter(share, !is.na(health_past3months))


Input: Model comparison   apply hierarchical versions of CC, EWA, LMM, and motivational EWA models  [CODESPLIT] setwd("SET TO MODEL FILE DIRECTORY") data <- list("groupSize", "ngroups", "ntrials", "ntokens", "pi", "vals","c","Gc","c_choice_index","Ga") #data inputted into jags params <- c("mu_c") #parameters we'll track in jags samplesCC <- jags(data, inits=NULL, params, model.file ="CC_group.txt", n.chains=3, n.iter=5000, n.burnin=1000, n.thin=1) params <- c("mu_c") #parameters we'll track in jags samplesEWA <- jags(data, inits=NULL, params, model.file ="EWA_group.txt", n.chains=3, n.iter=5000, n.burnin=1000, n.thin=1) params <- c("nu_c") #parameters we'll track in jags samplesLMM <- jags(data, inits=NULL, params, model.file ="LMM_group.txt", n.chains=3, n.iter=5000, n.burnin=1000, n.thin=1)


Input: Number of subjects in each group  Create a group variable according to each cluster condition [CODESPLIT] if (size == 1){ N.size = N/K n.group = unlist(lapply(1:K, function(k) rep(k,N.size))) } if (size == 2){ if (K == 2){ N.1 = 0.10*N N.2 = N - N.1 n.group = c(rep(1,N.1),rep(2,N.2)) } if (K == 4){ N.1 = 0.10*N N.rest = N - N.1 N.size = N.rest/(K-1) n.group = c(rep(1,N.1),rep(2,N.size),rep(3,N.size),rep(4,N.size)) }} if (size == 3){ if (K == 2){ N.1 = 0.6*N N.2 = N - N.1 n.group = c(rep(1,N.1),rep(2,N.2)) } if (K == 4){ if (N == 20){ N.1 = 0.6*N N.rest = N - N.1 N.size = floor(N.rest/(K-1)) n.group = c(rep(1,N.1),rep(2,N.size),rep(3,N.size+1),rep(4,N.size+1)) } else{ N.1 = 0.6*N N.rest = N - N.1 N.size = N.rest/(K-1) n.group = c(rep(1,N.1),rep(2,N.size),rep(3,N.size),rep(4,N.size)) }}}


Input: Create variable subjno  Scramble data so people appear unordered in the final dataset [CODESPLIT] ID = expand.grid(1:T,1:N)[,2] data = cbind(data,ID) p = ncol(Psi[[1]]) Y = matrix(0,nrow(data),p) colnames(Y) = sprintf("Y%d",seq(1:p))


Input: Frequency plot [CODESPLIT] top.freqs = sort(colSums(data.table), decreasing = T)[1:40] cex.val = 1.6 cairo_pdf('pdfs/top_freq_segments.pdf', width = 16, height = 10) par(family = "Doulos SIL") plot(top.freqs ~ seq_along(top.freqs), xlab = 'Frequency rank', ylab = 'Frequency', xlim = c(1, 40), type = 'n', xaxt = 'n', cex.lab = cex.val, cex.axis = cex.val) axis(1, at = seq_along(top.freqs), labels = seq_along(top.freqs), cex.axis = 1.1) lines(seq_along(top.freqs), top.freqs, lty = 2, col = 'grey') text(seq_along(top.freqs), top.freqs, labels = names(top.freqs), cex = 2) dev.off()


Input: Contrast between countries as a new variable [CODESPLIT] d$CountC<-as.numeric(as.integer(as.factor(d$Country))-1.5) table(d$Country,d$CountC)


Input: Estimated Marginal Means Model 3 [CODESPLIT] m1 <- ggemmeans(model3, c("welle [1:4 by=.2]", "isced")) m2 <- ggemmeans(model3, c("welle [1:4 by=.2]", "aee_oecd_between_z2")) m3 <- ggemmeans(model3, c("welle [1:4 by=.2]", "lone6_between_z2")) m1$Model = "ISCED" levels(m1$group) <- c("low", "middle", "high") m2$Model = "Income" levels(m2$group) <- c("-1 SD", "Mean", "+1 SD") m3$Model = "Loneliness" levels(m3$group) <- c("-1 SD", "Mean", "+1 SD") create_plot(m1, title = "(a) PF and Education") create_plot(m2, title = "(b) PF and Income") create_plot(m3, title = "(c) PF and Loneliness")


Input: Matrix with correlations and pvalues [CODESPLIT] Cormatrix1 <- data.frame(matrix(NA,nrow = 15, ncol = 15)) for(i in 1:14){ for(j in (i+1):15){ Cormatrix1[i,j] <- round(cor(Cordata[,i], Cordata[,j]), digits=2) Cormatrix1[j,i] <- round(cor.test(Cordata[,i], Cordata[,j])$p.value, digits=2) } } Cormatrix1


Input: Matrix with correlations and significance stars [CODESPLIT] Cormatrix2 <- data.frame(matrix(NA,nrow = 15, ncol = 15)) for(i in 1:14){ for(j in (i+1):15){ Cormatrix2[i,j] <- round(cor(Cordata[,i], Cordata[,j]), digits=2) Cormatrix2[j,i] <- ifelse(cor.test(Cordata[,i], Cordata[,j])$p.value<=0.05, "*", "no") } } Cormatrix2


Input: Generate Psi matrix for each cluster [CODESPLIT] for (n in 1:length(N)){ for (t in 1:length(T)){ for (p in 1:length(P)){ for (k in 1:length(K)){ for (d in 1:length(diff)){ for (r in 1:R){ Psi.list = lapply(1:K[k], function(kl) Psi.Matrix.Diff(P[p],b.ar.min,b.ar.max,b.cr.min,b.cr.max,d))


Input: Load training and testing set [CODESPLIT] load(file = paste("Data_Block_Cluster_MVAR_RE_N_",N[n],"_T_",T[t],"_P_",P[p],"_K_",K[k], "_Diff_",diff[d],"_size_",size[s],"_R_",r,".RData",sep = "")) MSE.MVAR.PS.Sys = MSE.Sys(data.list,P[p]) save(MSE.MVAR.PS.Sys, file = paste("MSE_MVAR_Cluster_MVAR_RE_N_",N[n],"_T_",T[t],"_P_",P[p],"_K_",K[k], "_Diff_",diff[d],"_size_",size[s],"_R_",r,".RData",sep = ""))


Input: standardize the model inputs, excluding the response and random effects  [CODESPLIT] d_std <- stand(d, cols = f2) # use the fitting function for convenience


Input: > Left panel: QQplot (uniform distribution)  > Right panel: Residuals against predicted values;; shaded (due to sample size) with extreme residuals colored red, and   3) MAIN EFFECTS OF KEY VARIABLES   FormatInfo  [CODESPLIT] emmip(CorResult, ~FormatInfo, type = "response", CIs = TRUE) (emm <- emmeans(CorResult, specs = ~FormatInfo, type = "response")) pairs(emm) EffPlotData_CorrFormat <- summary(emm)  ## Data for Fig. 3


Input: Rescale order of variables on yaxis (for BRT figures) [CODESPLIT] BRT.plot.label.limits <- c("site.centrality", "mean.annual.flow", "basin.area", "site.long", "site.lat", "pct.ISC", "pct.urb", "pct.ag", "pct.for", "ALG.cover", "NAT.cover", "LWD.reach", "DOC", "cond", "pH.lab", "total.P", "NH4", "NO3")


Input: Rename variables names on yaxis (for BRT figures) [CODESPLIT] BRT.plot.labels <- c("site.centrality" = "Cent", "mean.annual.flow" = "Flow", "basin.area" = "Area", "site.long" = "Long", "site.lat" = "Lat", "pct.ISC" = "ISC", "pct.urb" = "Urb", "pct.ag" = "Ag", "pct.for" = "For", "ALG.cover" = "Alg", "NAT.cover" = "Nat", "LWD.reach" = "LWD", "DOC" = "DOC", "cond" = "Cond", "pH.lab" = "pH", "total.P" = "TP", "NH4" = expression(NH[4]), "NO3" = expression(NO[3]))


Input: Sample posetrior and prior for graphical comparison [CODESPLIT] post1<-extract.samples(m1) set.seed(42) prio1<-extract.prior(m1,n=10000) save.image(file="posterior_samples_single.RData")


Input: correlation matrix for the DVs [CODESPLIT] judcorMat2 <- lowerCor(judgmentRatings2) corr.test(judgmentRatings2) corrplot(judcorMat2, method="color", type = 'lower',tl.col="black", addCoef.col = "black", tl.srt = 45)


Input: Subset data that includes only partner cooperation means within 0.4  0.6 [CODESPLIT] bound_data <- subset(expt1_data, expt1_data$cooplc_means >= 0.4 & expt1_data$cooplc_means <= 0.6 & expt1_data$readlc_means >= 0.4 & expt1_data$readlc_means <= 0.6)


Input: Plot histogram of chances that partner's choice was positive for all data [CODESPLIT] coop_hist_ggplot <- ggplot(all_pc, aes(x = alllc_means * 100)) + geom_histogram(aes(fill = included), bins = 50) +  # plot histogram scale_fill_manual(values = c("black", "grey50"), name="", label=c("Included", "Not included")) +  # color values inside and outside of 0.4-0.6 differently labs(x = "Percent partner positive actions", y = "Number of participants") + # label axes theme_classic() + # use classic theme theme(axis.title=element_text(size=45), axis.text=element_text(size=30), legend.text=element_text(size=30), legend.position = c(0.25, 0.9), legend.key.size = unit(2.5, 'lines')) png(file = "figures/partner_action_histogram.png", width = 1200, height = 750) # open device plot(coop_hist_ggplot) # plot figure dev.off() # close device


Input: Analyze accuracy as a function of payoff scheme (Standard or Costly), context (Cooperation or Newspaper), and partner action (Cooperate or Defect)   Conduct binomial GLMM of payoff scheme * partner action + context for memory accuracy  [CODESPLIT] accuracy_glmer_full <- glmer(accuracy ~ payoff_scheme * partner_action * context + (1 | subject), bound_data, family = binomial(link = "logit"))   # calculate GLMM of full model


Input: Conduct binomial GLMMs for memory accuracy to calculate BIC values to transform to Bayes factors [CODESPLIT] accuracy_glmer_null <- summary(glmer(accuracy ~ (1 | subject), bound_data, family = binomial(link = "logit")))    # calculate GLMM for null model accuracy_glmer_payoff <- summary(glmer(accuracy ~ payoff_scheme  + (1 | subject), bound_data, family = binomial(link = "logit")))    # calculate GLMM for payoff scheme accuracy_glmer_context <- summary(glmer(accuracy ~ context + (1 | subject), bound_data, family = binomial(link = "logit")))    # calculate GLMM for context accuracy_glmer_action <- summary(glmer(accuracy ~ partner_action + (1 | subject), bound_data, family = binomial(link = "logit")))    # calculate GLMM for partner action accuracy_glmer_payoff_action <- summary(glmer(accuracy ~ payoff_scheme + partner_action + (1 | subject), bound_data, family = binomial(link = "logit")))    # calculate GLMM for payoff_scheme + partner_action accuracy_glmer_payoff_action_inter <- summary(glmer(accuracy ~ payoff_scheme * partner_action + (1 | subject), bound_data, family = binomial(link = "logit")))    # calculate GLMM for payoff_scheme * partner_action accuracy_glmer_action_context <- summary(glmer(accuracy ~ partner_action + context + (1 | subject), bound_data, family = binomial(link = "logit")))    # calculate GLMM for partner_action + context accuracy_glmer_action_context_inter <- summary(glmer(accuracy ~ partner_action * context + (1 | subject), bound_data, family = binomial(link = "logit")))    # calculate GLMM for partner_action * context accuracy_glmer_payoff_action_context <- summary(glmer(accuracy ~ payoff_scheme + partner_action + context + (1 | subject), bound_data, family = binomial(link = "logit")))   # calculate GLMM for payoff_scheme * partner_action * context last_accuracy_glmer_null <- summary(glmer(accuracy ~ (1 | subject), last_data, family = binomial(link = "logit")))    # calculate GLMM for null model last_accuracy_glmer_payoff <- summary(glmer(accuracy ~ payoff_scheme  + (1 | subject), last_data, family = binomial(link = "logit")))    # calculate GLMM for payoff scheme last_accuracy_glmer_action <- summary(glmer(accuracy ~ partner_action + (1 | subject), last_data, family = binomial(link = "logit")))    # calculate GLMM for partner action last_accuracy_glmer_payoff_action <- summary(glmer(accuracy ~ payoff_scheme + partner_action + (1 | subject), last_data, family = binomial(link = "logit")))    # calculate GLMM for payoff_scheme + partner_action last_accuracy_glmer_payoff_action_inter <- summary(glmer(accuracy ~ payoff_scheme * partner_action + (1 | subject), last_data, family = binomial(link = "logit")))    # calculate GLMM for payoff_scheme * partner_action


Input: Conduct binomial GLMM of payoff scheme * partner action + context for memory accuracy [CODESPLIT] last_accuracy_glmer_full <- glmer(accuracy ~ payoff_scheme * partner_action + (1 | subject), last_data, family = binomial(link = "logit"))   # calculate GLMM of full model


Input: Calculate correlation between mean number of contacts and mean memory accuracy [CODESPLIT] coop_contacts_cor2 <- cor.test(expt2_data_subj$accuracy, expt2_data_subj$contacts)  # calculate network size/accuracy correlation coop_contacts2_bfdf <- data.frame(accuracy = expt2_data_subj$accuracy, contacts = expt2_data_subj$contacts) # create new data frame for Bayesian analysis coop_contacts2_lmbf <- lmBF(accuracy ~ contacts, data = coop_contacts2_bfdf)  # calculate Bayes regression coop_contacts2_bf <- extractBF(coop_contacts2_lmbf)$bf  # extract Bayes factor


Input: Create dummy variable for ethnicity: 0  option 4 only (Anglo/White), 1  any other option / combination of options  [CODESPLIT] table(survey$ethnic_group[!duplicated(survey$id)], useNA = "ifany") survey$ethnicity <- ifelse(survey$ethnic_group == "4", 0, 1) table(survey$ethnicity[!duplicated(survey$id)], useNA = "ifany")


Input: Create dummy variable for SES: 1  mother or father completed at least some college (4  some college), 0  otherwise  [CODESPLIT] table(survey$mother_educationlevel[!duplicated(survey$id)], useNA = "ifany") table(survey$father_educationlevel[!duplicated(survey$id)], useNA = "ifany") survey$SES <- ifelse(survey$mother_educationlevel >= 4 | survey$father_educationlevel >= 4, 1, 0) table(survey$SES[!duplicated(survey$id)], useNA = "ifany")


Input: Weekend  Create dummy variable for weekend: 1  weekend, 0  weekday  [CODESPLIT] survey$weekend <- ifelse(weekdays(survey$StartDate, abbr = TRUE) %in% c("Sat", "Sun"), 1, 0)


Input: Create dummy variable for mixed interaction partners [CODESPLIT] survey$no_partners <- apply(survey[c("close_peers", "family", "weak_ties")], 1, sum) survey$mixed_partner <- ifelse(survey$no_partners > 1, 1, 0) table(survey$mixed_partner, useNA = "ifany") # number of observations with mixed interaction partners: 11479 (S1) / 5797 (S2) table(apply(survey[c("close_peers", "family", "weak_ties")], 1, sum), useNA = "ifany") survey$close_peers_all <- survey$close_peers survey$family_all <- survey$family survey$weak_ties_all <- survey$weak_ties survey$close_peers <- ifelse(survey$mixed_partner == 1, NA, survey$close_peers) survey$family <- ifelse(survey$mixed_partner == 1, NA, survey$family) survey$weak_ties <- ifelse(survey$mixed_partner == 1, NA, survey$weak_ties) table(survey$close_peers, useNA = "ifany") # number of observations with interactions with close peers ONLY: 17194 (S1) / 9406 (S2) table(survey$interacting_people[survey$close_peers == 1]) table(survey$family, useNA = "ifany") # number of observations with interactions with family ONLY: 2450 (S1) / 1946 (S2) table(survey$interacting_people[survey$family == 1]) table(survey$weak_ties, useNA = "ifany") # number of observations with interactions with weak ties ONLY: 4336 (S1) / 2823 (S2) table(survey$interacting_people[survey$weak_ties == 1]) table(apply(survey[c("close_peers", "family", "weak_ties")], 1, sum), useNA = "ifany") # 23980 (S1) / 14175 (S2) length(which(survey$mixed_mode == 1 | survey$SKIP2 == 1 | survey$OTHER2 == 1 | is.na(survey$interacting_people) | survey$mixed_partner == 1)) table(apply(survey[c("close_peers_all", "family_all", "weak_ties_all")], 1, sum), useNA = "ifany") # 23980, 10176, 1303 (S1) / 14175, 5116, 681 (S2) length(which(survey$mixed_mode == 1 | survey$SKIP2 == 1 | survey$OTHER2 == 1 | is.na(survey$interacting_people))) survey$no_partners2 <- apply(survey[c("friends_roommates", "significant_other", "family_all", "weak_ties_all")], 1, sum) survey$mixed_partner2 <- ifelse(survey$no_partners2 > 1, 1, 0) table(survey$mixed_partner2, useNA = "ifany") # number of observations with mixed interaction partners: 13456 (S1) / 6847 (S2) table(apply(survey[c("friends_roommates", "significant_other", "family_all", "weak_ties_all")], 1, sum), useNA = "ifany") survey$friends_roommates2 <- ifelse(survey$mixed_partner2 == 1, NA, survey$friends_roommates) survey$significant_other2 <- ifelse(survey$mixed_partner2 == 1, NA, survey$significant_other) survey$family2 <- ifelse(survey$mixed_partner2 == 1, NA, survey$family_all) survey$weak_ties2 <- ifelse(survey$mixed_partner2 == 1, NA, survey$weak_ties_all) table(survey$friends_roommates2, useNA = "ifany") # number of observations with interactions with friends and roommates ONLY: 12882 (S1) / 6865 (S2) table(survey$interacting_people[survey$friends_roommates2 == 1]) table(survey$significant_other2, useNA = "ifany") # number of observations with interactions with significant others ONLY: 2335 (S1) / 1491 (S2) table(survey$interacting_people[survey$significant_other2 == 1]) table(survey$family2, useNA = "ifany") # number of observations with interactions with family ONLY: 2450 (S1) / 1946 (S2) table(survey$interacting_people[survey$family2 == 1]) table(survey$weak_ties2, useNA = "ifany") # number of observations with interactions with weak ties ONLY: 4336 (S1) / 2823 (S2) table(survey$interacting_people[survey$weak_ties2 == 1]) table(apply(survey[c("friends_roommates2", "significant_other2", "family2", "weak_ties2")], 1, sum), useNA = "ifany") # 22003 (S1) / 13125 (S2) length(which(survey$mixed_mode == 1 | survey$SKIP2 == 1 | survey$OTHER2 == 1 | is.na(survey$interacting_people) | survey$mixed_partner2 == 1))


Input: Create dummy variable for significant others [CODESPLIT] survey$significant_other <- ifelse(survey$mixed_mode == 1 | survey$SKIP2 == 1 | survey$OTHER2 == 1 | is.na(survey$interacting_people), NA, ifelse(survey$Significant_other == 1, 1, 0)) table(survey$significant_other, useNA = "ifany") # number of observations with interactions with significant others: 6681 (S1) / 3822 (S2) table(survey$interacting_people[survey$significant_other == 1])


Input: converting PPId and Statement to factors [CODESPLIT] Data$PPID <- as.factor(Data$PPID) Data$Statement <-as.factor(Data$Statement)


Input: find Q1, Q3, and interquartile range for values in column A  [CODESPLIT] Q1 <- quantile(DV2, .25) Q3 <- quantile(DV2, .75) IQR2 <- IQR(DV2)


Input: only keep rows in dataframe that have values within 1.5*IQR of Q1 and Q3 [CODESPLIT] no_outliers2 <- subset(df, DV2> (Q1 - 1.5*IQR2) & DV2< (Q3 + 1.5*IQR2)) no_outliers3 <- subset(df, DV3> (Q1 - 1.5*IQR3) & DV3< (Q3 + 1.5*IQR3))


Input: Plot beta weights for interaction [CODESPLIT] betalms #  called "beta" but represents "b" betalms <- betalms[,1:2] names(betalms) <- c("b", "SE")


Input: Plot beta weights for engagement [CODESPLIT] betalms_eng betalms_eng <- betalms_eng[,1:2] names(betalms_eng) <- c("b", "SE")


Input: Arrange b coeff plots [CODESPLIT] grid.arrange(betalms_ope_p, betalms_eng_p, betalms_p, ncol = 3, nrow = 1)


Input: Plot slopes [CODESPLIT] listofcharts = list() # create empty list for charts index = 0 # zero the index for (df in listofdfs) { index = index + 1 xlab_str = paste0("Economic beliefs in ", names(listofdfs)[index]) listofcharts[[index]] <- ggpredict(listoflms[[index]], terms = c("conservation2_s_c", "polit_eng_c[-0.14,0.14]"), type = "fe") %>% plot(colors = "bw") + ggtitle(names(listoflms[index])) + xlab("NSC") + ylab("Economic beliefs") + labs(linetype = "Political \nengagement") + scale_linetype_manual(values=c("solid", "dashed"), labels = c("Low", "High")) + theme_classic() + theme(legend.position = "none") +


Input: Does the start model fit the data significantly better as compared to a model without random intercepts over items? [CODESPLIT] tic();; start_min_item_intercepts <- glmer(bin_score ~ input*testmoment*learningtype + (1|participant), family = 'binomial', data = data, control = glmerControl(optimizer = "bobyqa", optCtrl=list(maxfun=1e5)));; toc() anova(start_min_item_intercepts, start) # Start model is significantly better (p < .001);; AIC difference of +- 240


Input: Random slope of input over item [CODESPLIT] tic();; input_item <- glmer(bin_score ~ input*testmoment*learningtype + (1+input|item) + (1|participant), family = 'binomial', data = data, control = glmerControl(optimizer = "bobyqa", optCtrl=list(maxfun=1e5)));; toc() anova(start, input_item) # Significant improvement (p = .03);; small AIC difference (3). summary(rePCA(input_item)) # All dimensions are supported by the data. >> KEEP


Input: Investigate model fit  Inspect residuals with a binned residual plot [CODESPLIT] residualsplot <- binnedplot(fitted(final), resid(final, type = "response"), cex.pts=1, col.int="black", xlab = "Estimated score (as probability)")


Input: model 1 is just baseHIne PHQ_9 severity in a simple logistic regression [CODESPLIT] HI_prognostic_model1 = glm(y ~ PHQ9_first, data = X_HI_only, family = "binomial") summary(HI_prognostic_model1)


Input: model 3 is a logistic regression built using elastic net regularization  use elastic net to build this model [CODESPLIT] set.seed(12345678) fit_HI = glmnet(data.matrix(X_HI_only_forEN), y_HI_only, family="binomial", alpha=.5) plot(fit_HI,label=TRUE) HI_prognostic_model3 = cv.glmnet(data.matrix(X_HI_only_forEN), y_HI_only, family="binomial", alpha=.5) plot(HI_prognostic_model3) HI_prognostic_model3$lambda.min HI_prognostic_model3$lambda.1se print(coef(HI_prognostic_model3, s = "lambda.min")) print(coef(HI_prognostic_model3, s = "lambda.1se"))


Input: calculate deviance statistic  logHIkeHIhood : sum from i1 to N of [ Yi*ln(P(Yi))+(1Yi)*ln(1P(yi))]  calculate brier score  brier_score: (1/n)*sum(pioi)^2 [CODESPLIT] log_likelihood_calculator_HI_1 = rep(NA,dim(X_HI_only_hold_out)[1]) brier_score_calculator_HI_1 = rep(NA,dim(X_HI_only_hold_out)[1]) log_likelihood_calculator_HI_2 = rep(NA,dim(X_HI_only_hold_out)[1]) brier_score_calculator_HI_2 = rep(NA,dim(X_HI_only_hold_out)[1]) log_likelihood_calculator_HI_3 = rep(NA,dim(X_HI_only_hold_out)[1]) brier_score_calculator_HI_3 = rep(NA,dim(X_HI_only_hold_out)[1]) log_likelihood_calculator_HI_4 = rep(NA,dim(X_HI_only_hold_out)[1]) brier_score_calculator_HI_4 = rep(NA,dim(X_HI_only_hold_out)[1]) log_likelihood_calculator_HI_5 = rep(NA,dim(X_HI_only_hold_out)[1]) brier_score_calculator_HI_5 = rep(NA,dim(X_HI_only_hold_out)[1]) for (i in 1:dim(X_HI_only_hold_out)[1]){ log_likelihood_calculator_HI_1[i] = y_HI_only_hold_out[i]*log(HI_prognosis_1[i])+(1-y_HI_only_hold_out[i])*log(1-HI_prognosis_1[i]) brier_score_calculator_HI_1[i] = (HI_prognosis_1[i]-y_HI_only_hold_out[i])^2 log_likelihood_calculator_HI_2[i] = y_HI_only_hold_out[i]*log(HI_prognosis_2[i])+(1-y_HI_only_hold_out[i])*log(1-HI_prognosis_2[i]) brier_score_calculator_HI_2[i] = (HI_prognosis_2[i]-y_HI_only_hold_out[i])^2 log_likelihood_calculator_HI_3[i] = y_HI_only_hold_out[i]*log(HI_prognosis_3[i])+(1-y_HI_only_hold_out[i])*log(1-HI_prognosis_3[i]) brier_score_calculator_HI_3[i] = (HI_prognosis_3[i]-y_HI_only_hold_out[i])^2 log_likelihood_calculator_HI_4[i] = y_HI_only_hold_out[i]*log(HI_prognosis_4[i])+(1-y_HI_only_hold_out[i])*log(1-HI_prognosis_4[i]) brier_score_calculator_HI_4[i] = (HI_prognosis_4[i]-y_HI_only_hold_out[i])^2 log_likelihood_calculator_HI_5[i] = y_HI_only_hold_out[i]*log(HI_prognosis_5[i])+(1-y_HI_only_hold_out[i])*log(1-HI_prognosis_5[i]) brier_score_calculator_HI_5[i] = (HI_prognosis_5[i]-y_HI_only_hold_out[i])^2 } deviance_for_HI_model_1 = sum(log_likelihood_calculator_HI_1,na.rm=TRUE) brier_score_for_HI_model_1 = (1/dim(X_HI_only_hold_out)[1])*sum(brier_score_calculator_HI_1,na.rm=TRUE) deviance_for_HI_model_2 = sum(log_likelihood_calculator_HI_2,na.rm=TRUE) brier_score_for_HI_model_2 = (1/dim(X_HI_only_hold_out)[1])*sum(brier_score_calculator_HI_2,na.rm=TRUE) deviance_for_HI_model_3 = sum(log_likelihood_calculator_HI_3,na.rm=TRUE) brier_score_for_HI_model_3 = (1/dim(X_HI_only_hold_out)[1])*sum(brier_score_calculator_HI_3,na.rm=TRUE) deviance_for_HI_model_4 = sum(log_likelihood_calculator_HI_4,na.rm=TRUE) brier_score_for_HI_model_4 = (1/dim(X_HI_only_hold_out)[1])*sum(brier_score_calculator_HI_4,na.rm=TRUE) deviance_for_HI_model_5 = sum(log_likelihood_calculator_HI_5,na.rm=TRUE) brier_score_for_HI_model_5 = (1/dim(X_HI_only_hold_out)[1])*sum(brier_score_calculator_HI_5,na.rm=TRUE) print(round(deviance_for_HI_model_1,1)) print(round(brier_score_for_HI_model_1,3)) print(round(deviance_for_HI_model_2,1)) print(round(brier_score_for_HI_model_2,3)) print(round(deviance_for_HI_model_3,1)) print(round(brier_score_for_HI_model_3,3)) print(round(deviance_for_HI_model_4,1)) print(round(brier_score_for_HI_model_4,3)) print(round(deviance_for_HI_model_5,1)) print(round(brier_score_for_HI_model_5,3))


Input: here we create a PAIstyle model that includes variables and their interaction with tx  we use this model as a demonstration: [CODESPLIT] differential_model_6 = glm(y ~ tx*(PHQ9_first+WSAS_first+Employment_binary+Ethnicity_binary+GAD7_first+Phobia_Q3_first), data = X_training, family = "binomial") summary(differential_model_6)


Input: grab the indices of which individuals got tx0 (li) and tx1 (hi) [CODESPLIT] tx_HI_i = which(X_hold_out$tx==1, arr.ind = TRUE) tx_LI_i = which(X_hold_out$tx==0, arr.ind = TRUE) step_size = 150 window_size = 300 bin_number = ceiling((dim(X_hold_out)[1]-window_size)/step_size)


Input: the below command can be used to see what y limits and x limits should be used to standardize all plots [CODESPLIT] cat("y_limits",round(c(min(observed_differential_response),max(observed_differential_response)),3),"\n") cat("x_limits",round(c(min(predicted_differential_response),max(predicted_differential_response)),3),"\n") cat("predicted avg differential response (full sample avg):",round(mean(differential_prediction),3),"\n") cat("predicted avg differential response (binned avg):",round(mean(predicted_differential_response),3),"\n") predicted_avg_diff = mean(differential_prediction) plot(predicted_differential_response,observed_differential_response,'p',ylim=c(-.1,.3), xlim = c(-.1,.3),xlab=x_label) plot(predicted_differential_response,observed_differential_response,'p',ylim=c(-.1,.3), xlim = c(min(predicted_differential_response),max(predicted_differential_response)),xlab=x_label) cor_windows = cor(1:bin_number,observed_differential_response) cor_pred_diff = cor(predicted_differential_response,observed_differential_response) cat("windows correlation = ",round(cor_windows,3),"\n") cat("predicted difference correlation = ",round(cor_pred_diff,3),"\n")


Input: we can use the tstatistic to adjust for the error around the slope  tvalue is the coefficient divided by its standard error [CODESPLIT] cat("slope t-stat = ",round(sc_coefs_summary$t.value[2],3),"\n") print(round(sc_coefs_summary,3)) cat("\n") observed_range = max(observed_differential_response) - min(observed_differential_response) predicted_range = max(predicted_differential_response) - min(predicted_differential_response) tstat = sc_coefs_summary$t.value[2] slope = sc_coefs_summary$Estimate[2] model_evaluations[k,] = c(tstat, slope, observed_range, predicted_range, predicted_avg_diff, cor_pred_diff) model_predictions[k,] = predicted_differential_response model_results[k,] = observed_differential_response } print(round(model_evaluations,3))


Input: comparisons to average for each trait [CODESPLIT] summary(lmer(RATINGc ~ TSELFc* EX + SMEANc* EX + SDMEAN* EX +PSELFc* EX + (TSELFc + SMEANc + SDMEANc +PSELFc    | PID),data= subset(fmimlm, fmimlm$motive == 0 ) )) summary(lmer(RATINGc ~ TSELFc* OP + SMEANc* OP + SDMEAN* OP +PSELFc*OP+ (TSELFc + SMEANc + SDMEANc  +PSELFc   | PID),data= subset(fmimlm, fmimlm$motive == 0   ) )) summary(lmer(RATINGc ~ TSELFc* AG + SMEANc* AG + SDMEAN* AG +PSELFc*AG + (TSELFc + SMEANc + SDMEANc   +PSELFc  | PID),data= subset(fmimlm, fmimlm$motive == 0 ) )) summary(lmer(RATINGc ~ TSELFc* NE + SMEANc* NE + SDMEAN* NE +PSELFc*NE+ (TSELFc + SMEANc + SDMEANc  +PSELFc   | PID),data= subset(fmimlm, fmimlm$motive == 0  ) )) summary(lmer(RATINGc ~ TSELFc* CO + SMEANc* CO + SDMEAN* CO+PSELFc*CO+ (TSELFc + SMEANc + SDMEANc  +PSELFc   | PID), data= subset(fmimlm,fmimlm$motive == 0  ) ))


Input: Conduct RSA  We want to estimate the RSA model in which the intercept is allowed to vary across states.  The equation for individual i living in state j (z  selfesteem, x  IV, y  SV) is:  zij  b0 + b1*xij + b2*yj + b3*xij^2 + b4*xij*yj + b5*yj^2 + uj + eij  specify and estimate this model:  [CODESPLIT] m.c <- lmer(selfesteem ~ IV.c + SV.c + IV2.c + IVSV.c + SV2.c + (1 | state), data = df) summary(m.c)


Input: Plot the average surface using MLRSA_AverageSurfacePlot: [CODESPLIT] MLRSA_AverageSurfacePlot(m.c, name_vars=c("IV.c","SV.c","IV2.c","IVSV.c","SV2.c"), outcome="selfesteem", data=df, xlab="Individual-level values", ylab="State-level values", zlab="Self-esteem")


Input: only keeping latest reported dates for each patient [CODESPLIT] data_lab_res_dcr <- data_lab[!duplicated(data_lab$shcsid,fromLast=TRUE),] data_drug_res_dcr <- data_drug[!duplicated(data_drug$shcsid,fromLast=TRUE),] data_dis_res_dcr <- data_dis[order(data_dis$shcsid,data_dis$newdate),] data_dis_res_dcr <- data_dis_res_dcr[!duplicated(data_dis_res_dcr$shcsid,fromLast=TRUE),]


Input: Plots with H(A|M)  nonnormalized conditional entropy Getting mean, median and standard deviation across different motifs per period  [CODESPLIT] N <- aggregate(CEAuthoritiesMotifs ~ DATE, data = resultsmotifs, FUN = length) MEAN <- aggregate(CEAuthoritiesMotifs ~ DATE, data = resultsmotifs, FUN = mean) MEDIAN <- aggregate(CEAuthoritiesMotifs ~ DATE, data = resultsmotifs, FUN = median) SD <- aggregate(CEAuthoritiesMotifs ~ DATE, data = resultsmotifs, FUN = sd) resultsmotifs_summary <- cbind.data.frame(N, MEAN$CEAuthoritiesMotifs, MEDIAN$CEAuthoritiesMotifs, SD$CEAuthoritiesMotifs) colnames(resultsmotifs_summary) <- c("DATE","N","MEAN","MEDIAN","SD") resultsmotifs_summary$SE <- resultsmotifs_summary$SD / sqrt(resultsmotifs_summary$N)


Input: Plots with H(A|M)/H(A)  normalized conditional entropy [CODESPLIT] resultsmotifs <- as.data.frame(rbind(results330,results350,results370,results390,results405,results415,results425, results435,results455,results470,results490,results600))


Input: Getting mean, median and standard deviation across different motifs per period  [CODESPLIT] N <- aggregate(NormCEAuthoritiesMotifs ~ DATE, data = resultsmotifs, FUN = length) MEAN <- aggregate(NormCEAuthoritiesMotifs ~ DATE, data = resultsmotifs, FUN = mean) MEDIAN <- aggregate(NormCEAuthoritiesMotifs ~ DATE, data = resultsmotifs, FUN = median) SD <- aggregate(NormCEAuthoritiesMotifs ~ DATE, data = resultsmotifs, FUN = sd) Nresultsmotifs_summary <- cbind.data.frame(N, MEAN$NormCEAuthoritiesMotifs, MEDIAN$NormCEAuthoritiesMotifs, SD$NormCEAuthoritiesMotifs) colnames(Nresultsmotifs_summary) <- c("DATE","N","MEAN","MEDIAN","SD") Nresultsmotifs_summary$SE <- Nresultsmotifs_summary$SD / sqrt(Nresultsmotifs_summary$N)


Input: Plot mean and median H(A|M)/H(A) per motif per period [CODESPLIT] require(ggplot2) ggmean <- ggplot(Nresultsmotifs_summary,aes(x=DATE,y=MEAN)) + labs(title =  "P1: Mean normalized conditional entropy of authorities given motifs across motifs", x = "Year BCE", y = "mean H(A|M)/H(A) across motifs") + scale_x_reverse() + geom_errorbar(aes(ymin=Nresultsmotifs_summary$MEAN-Nresultsmotifs_summary$SE, ymax=Nresultsmotifs_summary$MEAN+Nresultsmotifs_summary$SE),width=.1) + geom_line() + geom_point() ggmean ggmedian <- ggplot(Nresultsmotifs_summary,aes(x=DATE,y=MEDIAN)) + labs(title =  "P1: Median normalized conditional entropy of authorities given motifs across motifs", x = "Year BCE", y = "median H(A|M)/H(A) across motifs") + scale_x_reverse() + geom_line() + geom_point() ggmedian


Input: In renamed "gender" variable replace "son" with "Male" etc.  [CODESPLIT] StataGDIM$gender <- gsub('son', 'Male', StataGDIM$gender) StataGDIM$gender <- gsub('daughter', 'Female', StataGDIM$gender) StataGDIM$gender <- gsub('all', 'Mixed', StataGDIM$gender)


Input: Create cohort (decade of birth) variable in ACE data [CODESPLIT] StataACE <- StataACE %>% mutate(cohort = as.integer(dob_midrange/10)*10)


Input: Create short cohort ID by concatenating two character vectors. cohortIDshort is created to reduce clutter in multipanel figures [CODESPLIT] ETmerged$cohort_short <- substring(ETmerged$cohort, 3) ETmerged$cohortIDshort <- paste(ETmerged$wbcode, ETmerged$cohort_short, sep = "", collapse = NULL)


Input: Inverse variance weightings for variance of h2, c2 and e2  [CODESPLIT] ETmerged<-ETmerged %>% mutate (h2weight = 1/h2var) ETmerged<-ETmerged %>% mutate (c2weight = 1/c2var) ETmerged<-ETmerged %>% mutate (e2weight = 1/e2var)


Input: Manually derive pvalues from tvalues for Alt_Norway (for a twosided ttest): [CODESPLIT] 2*pt(abs(-1.0320512), df=14,lower.tail=FALSE) 2*pt(abs(2.48367345), df=14,lower.tail=FALSE) 2*pt(abs(-2.828329), df=14,lower.tail=FALSE) 2*pt(abs(1.2811099), df=14,lower.tail=FALSE) 2*pt(abs(3.4124371), df=14,lower.tail=FALSE) 2*pt(abs(0.6433726), df=14,lower.tail=FALSE) 2*pt(abs(-1.0321), df=14,lower.tail=FALSE) 2*pt(abs(2.4837), df=14,lower.tail=FALSE) 2*pt(abs(-2.8283), df=14,lower.tail=FALSE)


Input: correlations separately for each partner partner 1 [CODESPLIT] chart.Correlation(data_dyadic[ , c("pes_1","p_self_1","d_self_1","p_other_1","d_other_1")], use = "pairwise.complete.obs", pch = 20, histogram = TRUE)


Input: Remove" AoI > 1200 or < 50 ms   [CODESPLIT] prevalues_gaze <- sum(PAST_O_19$gazedur > 0, na.rm=T)+sum(PAST_M_19$gazedur > 0, na.rm=T)+ sum(PRES_M_19$gazedur > 0, na.rm=T)+sum(PRES_O_19$gazedur > 0, na.rm=T) prevalues_fix <- sum(PAST_O_19$fixdur > 0, na.rm=T)+sum(PAST_M_19$fixdur > 0, na.rm=T)+ sum(PRES_M_19$fixdur > 0, na.rm=T)+sum(PRES_O_19$fixdur > 0, na.rm=T) PAST_M_19$gazedur[PAST_M_19$gazedur  > 1200 | PAST_M_19$gazedur < 50] <- NaN PAST_M_19$fixdur[PAST_M_19$fixdur > 1200 | PAST_M_19$fixdur < 50] <- NaN PRES_O_19$gazedur[PRES_O_19$gazedur > 1200 | PRES_O_19$gazedur < 50] <- NaN PRES_O_19$fixdur[PRES_O_19$fixdur > 1200 | PRES_O_19$fixdur < 50] <- NaN PRES_M_19$gazedur[PRES_M_19$gazedur > 1200 | PRES_M_19$gazedur < 50] <- NaN PRES_M_19$fixdur[PRES_M_19$fixdur > 1200 | PRES_M_19$fixdur < 50] <- NaN PAST_O_19$gazedur[PAST_O_19$gazedur > 1200 | PAST_O_19$gazedur < 50] <- NaN PAST_O_19$fixdur[PAST_O_19$fixdur > 1200 | PAST_O_19$fixdur < 50] <- NaN postvalues_gaze <- sum(PAST_O_19$gazedur > 0, na.rm=T)+sum(PAST_M_19$gazedur > 0, na.rm=T)+ sum(PRES_M_19$gazedur > 0, na.rm=T)+sum(PRES_O_19$gazedur > 0, na.rm=T) postvalues_fix <- sum(PAST_O_19$fixdur > 0, na.rm=T)+sum(PAST_M_19$fixdur > 0, na.rm=T)+ sum(PRES_M_19$fixdur > 0, na.rm=T)+sum(PRES_O_19$fixdur > 0, na.rm=T) dataloss_fix <- prevalues_fix-postvalues_fix dataloss_fix_percentage <- (1-(postvalues_fix/prevalues_fix))*100 dataloss_gaze <- prevalues_gaze-postvalues_gaze dataloss_gaze_percentage <- (1-(postvalues_gaze/prevalues_gaze))*100


Input: Distributional properties of the individual items for the Germanspeaking sample [CODESPLIT] jmv::descriptives( data = DataGerman, vars = vars(DMW1, DMW2, DMW3, DMW4, SMW1, SMW2, SMW3, SMW4, SBPS1, SBPS2, SBPS3, SBPS4, SBPS5, SBPS6, SBPS7, SBPS8), freq = TRUE, hist = TRUE, violin = TRUE, skew = TRUE, kurt = TRUE)


Input: Distributional properties of the individual items for the US sample [CODESPLIT] jmv::descriptives( data = DataUS, vars = vars(DMW1, DMW2, DMW3, DMW4, SMW1, SMW2, SMW3, SMW4, SBPS1, SBPS2, SBPS3, SBPS4, SBPS5, SBPS6, SBPS7, SBPS8), freq = TRUE, hist = TRUE, violin = TRUE, skew = TRUE, kurt = TRUE)


Input: Network analysis using EBICglasso [CODESPLIT] n1<-estimateNetwork(DataAll, default= "EBICglasso") plot(n1, groups = gr, nodeNames = names, legend.cex=.35) centrality_auto(n1, weighted = TRUE, signed = TRUE) centralityPlot(n1, include =c("Betweenness","Closeness", "Strength")) print(n1)


Input: Network based on correlations [CODESPLIT] n1a<-estimateNetwork(DataAll, default= "cor") plot(n1a, groups = gr, legend.cex=.35)


Input: Network analysis using EBICglasso with the Germanspeaking sample including the openmindedness scale [CODESPLIT] gr2<- list('Deliberate MW'=c(1:4), 'Spontaneous MW'=c(5:8), 'Boredom'=c(9:16), 'Open-Mindedness'=c(17:22)) names2<-c("I allow my thoughts to wander on purpose", "I enjoy mind-wandering", "I find mind-wandering is a good way to cope with boredom", "I allow myself to get absorbed in pleasant fantasy", "I find my thoughts wandering spontaneously", "When I mind-wander my thoughts tend to be pulled from topic to topic", "It feels like I donÃ¢ÂÂt have control over when my mind wanders", "I mind wander even when IÃ¢ÂÂm supposed to be doing something else", "I often find myself at Ã¢ÂÂloose ends,Ã¢ÂÂ not knowing what to do", "I find it hard to entertain myself", "Many things I have to do are repetitive and monotonous", "It takes more stimulation to get me going than most people", "I donÃ¢ÂÂt feel motivated by most things that I do", "In most situations, it is hard for me to find something to do or see to keep me interested", "Much of the time, I just sit around doing nothing", "Unless I am doing something exciting, even dangerous, I feel half-dead and dull", "Has few artistic interests", "Is complex, a deep thinker", "Is original, comes up with new ideas", "Is fascinated by art, music, or literature", "Has little interest in abstract ideas", "Has little creativity") n2<-estimateNetwork(DataGerman, default= "EBICglasso") plot(n2, groups = gr2, nodeNames = names2, legend.cex=.35) centrality_auto(n2, weighted = TRUE, signed = TRUE) centralityPlot(n2, include =c("Betweenness","Closeness", "Strength")) print(n2)


Input: Extract the vectors of analysed characteristics of Partner and Nonbiological father from the dataset. [CODESPLIT] text<-paste("trait_p<-data$Partner_",char,sep="") eval(parse(text=text)) text<-paste("trait_f<-data$Nonbiol_",char,sep="") eval(parse(text=text)) text<-paste("trait_pb<-dbiol$Partner_",char,sep="") eval(parse(text=text)) text<-paste("trait_b<-dbiol$Biol_",char,sep="") eval(parse(text=text))


Input: Cohen's d First create the equivalent arrangement for the stimation of differences if the father is biologicla and present [CODESPLIT] muB<-rep(mean(diffb,na.rm=T),15) sdB<-rep(sd(diffb,na.rm=T),15) nB<-rep(length(diffb[!is.na(diffb)]),15)


Input: plots also when there is no interaction and also squared terms (potentially involved in interactions) create data frame storing the observed mean values per combination of the values of the grided covariate and factor levels in the data create vectors denoting the grid cell center values for the two covariate: [CODESPLIT] if(!is.na(grid.resol)){ xvar=seq(min(plot.data[,covariate]), max(plot.data[,covariate]), length.out=grid.resol) bin.x=cut(x=plot.data[,covariate], breaks=xvar, include.lowest=T, labels=F) bin.x=min(xvar)+diff(xvar[1:2])/2+(bin.x-1)*diff(xvar[1:2]) }else{ bin.x=plot.data[, covariate] }


Input: remove rows where wkl_uuid is NA: [CODESPLIT] VS <- VS[!is.na(VS$wkl_uuid), ]


Input: Generate data assuming an underlying VAR(1) process      Function to generate data assuming an underlying VAR(1) process  the input is N the number of samples, T.days and T.beeps are the number of days and the number of beeps ESM is conducted (Total number of assessments is T.days x T.beeps)  Psi is a matrix with the fixed regression weights, mu is a vector with the fixed intercepts, var.Psi is variance of the random regression weights (i.e., assumed to be equal),  For each participant, it is checked whether the matrix Psi conforms the assumption of stationary time series  with the absolute value of the maximum eigenvalue smaller than 1  The distribution of the random effects resembles a truncated multivariate normal distribution.  This function simulates data from a VAR(1) model  [CODESPLIT] Data.VAR.Fixed = function(N,T,Psi,cor.Sigma){ p = ncol(Psi)


Input: remove layers with gtype_class "MF" (only three distinct MF layers in data set!)  [CODESPLIT] toDiscard <- which(CM$gtype_class == "MF") if (length(toDiscard) > 0) CM <- CM[-toDiscard, ]


Input: Testing participant heterogeneity  chisquare test: [CODESPLIT] testHetChi(freq = "data/data_retrieval.csv", tree = c("E","E","E", "U","U","U", "N","N","N") ) testHetChi(freq = "data/data_encoding.csv", tree = c("E","E","E", "U","U","U", "N","N","N") )


Input: Fitting a betaMPT model [CODESPLIT] m.retrieval.beta <- betaMPT(eqnfile="model/2htsm.eqn", data = "data/data_retrieval.csv", restrictions = "model/restrictions.txt", modelfilename = "results/2htsm_betaMPT.jags", transformedParameters = list("deltaDd=D1-d1"), parEstFile = "results/results_retrieval_betaMPT.txt", n.chain = 4, n.iter = 50000, n.adapt = 10000, n.burnin = 10000, n.thin = 10, ppp = 5000, dic = TRUE ) summary(m.retrieval.beta)


Input: Withinsubject tests  Example: twohigh threshold model (2HTM, included in TreeBUGS)  [CODESPLIT] htm <- system.file("MPTmodels/2htm.eqn", package="TreeBUGS")


Input: Plot ranked correlations [CODESPLIT] cor_dat <- corr_cross(ogdatasub, max_pvalue = 0.05, # display only significant correlations (at 5% level) pvalue =T, plot = F, top = 10 # display top 10 correlations (by correlation coefficient) ) |> arrange(abs(corr)) |> mutate(lab = paste(key, mix, sep = " + "), lab = factor(lab)) cor_dat |> ggplot(aes(y = lab, x = abs(corr), fill = as.factor(sign(corr)))) + geom_col() + scale_fill_manual(values = c("#E64B3D", "#0092B2")) + labs(title="", subtitle = "", caption="Note: Red bars indicate a negative relationship") + geom_text(aes(label = signif(.data$corr, 2)), colour = "#FFFFFF", size = 3.5, hjust = 1.1) + scale_x_continuous(limits=c(0, .4), position="top") + scale_y_discrete(labels=c("fst + cst" = "Difficult Financial Situation & Cost of Food", "rsp + spp" = "Loved Ones' Needs & Lack of Support", "pdd + ppd" = "Positive Experiences with Veg*nism & Positive Elements Post-Diet", "eft + prc" = "Meal Complexity & Need for Specialized Equipment or Planning", "fds + oth" = "Discontent and Cravings for Animal Products & Other Obstacles", "rsp + eft" = "Loved Ones' Needs & Meal Complexity", "fph + cst" = "Challenging Purchase Requirements & Cost of Food", "avl + fph" = "Limited Access to Veg*n Options & Challenging Purchase Requirements", "med + con" = "Professional Medical Advice & Difficulty Managing Health", "con + com" = "Difficulty Managing Health & Commitment Difficulties", "fcn + prc" = "Lack of Veg*n Knowledge & Need for Specialized Equipment or Planning")) + theme_minimal() + theme(axis.title = element_blank(), legend.position = "none") cor_dat ggsave("Correlations.png", width=8, height=6)


Input: Predictive performance plot   ( model size selection plot) [CODESPLIT] stat_pretty <- setNames(nm = proj_evalstats) stat_pretty <- toupper(stat_pretty) stopifnot(identical(proj_evalstats, "mlpd")) ggeval <- plot(C_cvvs, stats = proj_evalstats, deltas = TRUE, ranking_nterms_max = NA) ggeval <- ggeval + facet_null() ggeval <- ggeval + scale_y_continuous( sec.axis = sec_axis(~ exp(.), name = bquote(Lambda*" "*"GMPD")) ) ggeval <- ggeval + labs(y = bquote(Delta*" "*.(stat_pretty))) print(ggeval) ggsave(file.path("output", out_folder, paste0(plot_prefix, "projpred_search_deltas.jpeg")), width = 7, height = 7 * 0.618) saveRDS(last_plot(), file = file.path("output", out_folder, paste0(plot_prefix, "projpred_search_deltas.rds")))


Input: save attribute level for option i in trial row.id [CODESPLIT] wide.data[[paste0("opt",i,att.names[k])]][row.id]=feat.ij


Input: save position of attribute j [CODESPLIT] wide.data[[paste0("pos",att.names[k])]][row.id]=j


Input: save attribute of position k [CODESPLIT] wide.data[[paste0("pos",j)]][row.id]=att.names[k] } } } if(y$selected[i]==1) wide.data$response[row.id]=i }


Input: 1. recode RT for trials with slow (missed) response as NA [CODESPLIT] data$rt[data$trialError == " Slow"] <- NA


Input: ttests to compare composite 'animal protection behaviors' in people who have vs. have not experienced each (16 types total) [CODESPLIT] t.test(beh_animalprotect_comp ~ graphic_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp~ nongraphic_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ person_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ leaflet_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ news_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ social_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ humaneed_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ documentary_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ book_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ celebrity_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ ad_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ challenge_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ labels_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp~ labeled_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ ndisprotest_exp_buc, data=data, var.equal = TRUE) t.test(beh_animalprotect_comp ~ disprotest_exp_buc, data=data, var.equal = TRUE)


Input: FDR correction for ttests that compared composite 'animal protection behaviors' between people who have and have not experienced each advocacy type [CODESPLIT] adjusted_pvalues_protectionbehaviors <- data %>% summarise(graphic_exp_buc = t.test(beh_animalprotect_comp ~ graphic_exp_buc, var.equal = TRUE)$p.value, nongraphic_exp_buc = t.test(beh_animalprotect_comp ~ nongraphic_exp_buc, var.equal = TRUE)$p.value, person_exp_buc = t.test(beh_animalprotect_comp ~ person_exp_buc, var.equal = TRUE)$p.value, leaflet_exp_buc = t.test(beh_animalprotect_comp ~ leaflet_exp_buc, var.equal = TRUE)$p.value, news_exp_buc = t.test(beh_animalprotect_comp ~ news_exp_buc, var.equal = TRUE)$p.value, social_exp_buc = t.test(beh_animalprotect_comp ~ social_exp_buc, var.equal = TRUE)$p.value, humaneed_exp_buc = t.test(beh_animalprotect_comp ~ humaneed_exp_buc, var.equal = TRUE)$p.value, documentary_exp_buc = t.test(beh_animalprotect_comp ~ documentary_exp_buc, var.equal = TRUE)$p.value, book_exp_buc = t.test(beh_animalprotect_comp ~ book_exp_buc, var.equal = TRUE)$p.value, celebrity_exp_buc = t.test(beh_animalprotect_comp ~ celebrity_exp_buc, var.equal = TRUE)$p.value, ad_exp_buc = t.test(beh_animalprotect_comp ~ ad_exp_buc, var.equal = TRUE)$p.value, challenge_exp_buc = t.test(beh_animalprotect_comp ~ challenge_exp_buc, var.equal = TRUE)$p.value, labels_exp_buc = t.test(beh_animalprotect_comp ~ labels_exp_buc, var.equal = TRUE)$p.value, labeled_exp_buc = t.test(beh_animalprotect_comp ~ labeled_exp_buc, var.equal = TRUE)$p.value, ndisprotest_exp_buc = t.test(beh_animalprotect_comp ~ ndisprotest_exp_buc, var.equal = TRUE)$p.value, disprotest_exp_buc = t.test(beh_animalprotect_comp ~ disprotest_exp_buc, var.equal = TRUE)$p.value) %>% gather("Advocacy","p_value") %>% mutate(p_fdr = p.adjust(p_value, method = "fdr", n = length(p_value))) %>% print()


Input: ttests to compare composite 'animal consumer behaviors' in people who have vs. have not experienced each (16 types total) [CODESPLIT] t.test(beh_consumer_comp ~ graphic_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp~ nongraphic_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ person_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ leaflet_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ news_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ social_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ humaneed_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ documentary_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ book_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ celebrity_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ ad_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ challenge_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ labels_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ labeled_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ ndisprotest_exp_buc, data=data, var.equal = TRUE) t.test(beh_consumer_comp ~ disprotest_exp_buc, data=data, var.equal = TRUE)


Input: prepare animal protection behaviors for stacked graph [CODESPLIT] mean_CI_protect <- data %>% group_by(advocacytype, experienced) %>% summarize(n = n(), protect_mean = mean(beh_animalprotect_comp), protect_lci = t.test(beh_animalprotect_comp, conf.level = 0.95)$conf.int[1], protect_uci = t.test(beh_animalprotect_comp, conf.level = 0.95)$conf.int[2])


Input: add asterisks to advocacy types that had sig different scores between experienced vs. not experienced from ttests [CODESPLIT] mean_CI_protect <- mean_CI_protect %>% mutate(advocacytype = case_when(advocacytype == "ad" ~ "Anuncio o Valla Publicitaria*", advocacytype == "book"  ~ "Libro*", advocacytype == "celebrity"  ~ "Celebridad*", advocacytype == "challenge"  ~ "Reto de Evitar la Carne*", advocacytype == "disprotest" ~ "Protesta Disruptiva*", advocacytype == "graphic"  ~ "Video GrÃ¡fico*", advocacytype == "humaneed"  ~ "EducaciÃ³n en el Aula de Clases*", advocacytype == "labeled"  ~ "InformaciÃ³n Educativa Sobre las Etiquetas de Bienestar*", advocacytype == "labels"  ~ "Etiquetas Vegano/De Base Vegetal*", advocacytype == "ndisprotest"  ~ "Protesta No Disruptiva*", advocacytype == "news" ~ "ArtÃculo de Noticias*", advocacytype == "nongraphic" ~ "Video No GrÃ¡fico*", advocacytype == "person" ~ "DivulgaciÃ³n Boca a Boca *", advocacytype == "social" ~"PublicaciÃ³n en Redes Sociales o en un Blog*", advocacytype == "documentary"  ~ "Documental*", advocacytype == "leaflet" ~ "Folleto o Volante*")) mean_CI_consume <- mean_CI_consume %>% mutate(advocacytype = case_when(advocacytype == "ad" ~ "Anuncio o Valla Publicitaria*", advocacytype == "book"  ~ "Libro*", advocacytype == "celebrity"  ~ "Celebridad*", advocacytype == "challenge"  ~ "Reto de Evitar la Carne*", advocacytype == "disprotest" ~ "Protesta Disruptiva*", advocacytype == "graphic"  ~ "Video GrÃ¡fico*", advocacytype == "humaneed"  ~ "EducaciÃ³n en el Aula de Clases*", advocacytype == "labeled"  ~ "InformaciÃ³n Educativa Sobre las Etiquetas de Bienestar*", advocacytype == "labels"  ~ "Etiquetas Vegano/De Base Vegetal*", advocacytype == "ndisprotest"  ~ "Protesta No Disruptiva*", advocacytype == "news" ~ "ArtÃculo de Noticias*", advocacytype == "nongraphic" ~ "Video No GrÃ¡fico*", advocacytype == "person" ~ "DivulgaciÃ³n Boca a Boca *", advocacytype == "social" ~"PublicaciÃ³n en Redes Sociales o en un Blog*", advocacytype == "documentary"  ~ "Documental*", advocacytype == "leaflet" ~ "Folleto o Volante*"))


Input: factorize advocacy type for graph [CODESPLIT] mean_CI_protect <- mean_CI_protect %>% mutate(advocacytype = factor(advocacytype, bar_order)) mean_CI_consume <- mean_CI_consume %>% mutate(advocacytype = factor(advocacytype, bar_order))


Input: grouped bar graph for animal protection behaviors [CODESPLIT] ggplot(mean_CI_protect, aes(x= advocacytype, fill=experienced, y=protect_mean)) + geom_col(width = 0.8, position="dodge") + coord_flip(ylim=c(1,5)) + geom_errorbar(aes(x= advocacytype, ymin = protect_lci, ymax = protect_uci), width=0.4, colour = "black", position=position_dodge(.8)) + geom_text(aes(label = format(round(protect_mean, 1)), y = protect_uci), hjust = -0.2,# nudge_y = 2, size = 3, position = position_dodge(width = 1)) + labs(y= "PuntuaciÃ³n Media del Comportamiento de ProtecciÃ³n de los Animales", x = "Tipo de Defensa", caption = "Un asterisco (*) indica que hubo una diferencia estadÃsticamente significativa entre los grupos (todos los ps < 0,05) despuÃ©s de haber corregido mediante FDR. Para mÃ¡s detalles sobre cÃ³mo se llevaron a cabo estos anÃ¡lisis, vÃ©ase el Material Complementario.") + theme(legend.title = element_blank(), legend.position = "bottom", panel.background = element_rect("white"), panel.border = element_rect(fill = NA), panel.grid.major.x = element_line("grey")) + scale_fill_manual(values = c("Experimentado" = "#c47020", "No Experimentado" = "#F68D29"))


Input: We create a list of parameters to visualize and fill the labels etc to the .txt file in any table editor (Excel) [CODESPLIT] write.table(data.frame(nam=rep.par2),"params_empty.txt",row.names=F,sep="\t")


Input: Draw density polygons density areas are scaled within each block. [CODESPLIT] area<-0.25*diff(xlims[[block]]) for(i in 1:nrow(dec)){ thispost<-postsc[,dec$n[i]] dens<-density(thispost) polX<-c(dens$x,rev(dens$x)) polY<-c(dens$y,rev(-dens$y)) ar1<-abs(polyarea(polX,polY)) perc<-area/ar1 polygon(polX,polY*perc+dei$y[i],col=dec$hex[i],border=col.pol,lwd=lwd.pol)


Input: correlations between csd_mean and averaged csds for Big Five traits   (mentioned in the text in Appendix A): [CODESPLIT] psych::corr.test( df2$n_csd,df2$csd_mean_n ) psych::corr.test( df2$e_csd,df2$csd_mean_e ) psych::corr.test( df2$o_csd,df2$csd_mean_o ) psych::corr.test( df2$a_csd,df2$csd_mean_a ) psych::corr.test( df2$c_csd,df2$csd_mean_c )


Input: correlations between variability and wellbeing measures: [CODESPLIT] names_var <- c("csd_mean_n","csd_mean_e","csd_mean_o","csd_mean_a","csd_mean_c", "sccs","csd_nob","simpson_csd","rses","swls","pa","na") psych::corr.test( df2[,names_var] )


Input: catch situation where Sx is missing  so we cannot assess response to treatment  [CODESPLIT] if ( nrow( thisSx ) < 1 ) { thisRow$status.sx <- NA noFurtherFlag <- 1    ## tell rest of loop to not bother thisRow$missing.Sx <- 1 }


Input: Descriptive analysis: counting occurrence of bodybased  units and coded themes.   Step 1. Analyse frequencies of bodybased units of measure  Ensure data is in character format [CODESPLIT] df$`Body dimension` <- as.character(df$`Body dimension`)


Input: Repeating confirmatory analyses with extra exclusions: in addition to excluding participants who did not complete the study, and excluding timeuntilguess and arithmeticsolvingtimes more than 5 standard deviations away from the mean, this analysis also excludes participants who removed 0 tiles when guessing.  Exclude participants who did not complete study  [CODESPLIT] d.conf_1_2.complete <- d.conf_1_2.b[complete.cases(d.conf_1_2.b),] d.conf_3_math.complete <- d.conf_3_math.b[complete.cases(d.conf_3_math.b),]


Input: remove rows with timeuntilguess values that are more than 5 standard deviations away from the mean [CODESPLIT] agg <- aggregate(ElapsedTime_Guess ~ Guess_Number + ID_Player + Effort + Competition, data=d.conf_1_2.complete, FUN = mean) sd5.times <- mean(agg$ElapsedTime_Guess) + (5 * sd(agg$ElapsedTime_Guess)) nrow(agg[agg$ElapsedTime_Guess > sd5.times,])


Input: remove rows with arithmeticsolvingtimes that are more than 5 standard deviations away from the mean [CODESPLIT] sd5.times <- mean(d.conf_3_math.complete$ElapsedTime_Math) + (5 * sd(d.conf_3_math.complete$ElapsedTime_Math)) nrow(d.conf_3_math.complete[d.conf_3_math.complete$ElapsedTime_Math > sd5.times,])


Input: Exclude participants who revealed 0 tiles [CODESPLIT] d.conf_1_2.complete_no0 <- d.conf_1_2.complete[d.conf_1_2.complete$TilesRevealed > 0,] d.conf_3_math.complete_no0 <- d.conf_3_math.complete[d.conf_3_math.complete$TilesRevealed > 0,]


Input: compare simpler models with sex and sex*effort [CODESPLIT] df <- compare(m_accuracy_guess_nointer, m_accuracy_componly, m_accuracy_sex, m_accuracy_sex_effort_inter, m_accuracy_sex_effort_inter_CEinter) df <- round(df@output, 2) df %>% kable(caption = "ACCURACY")  %>% kable_styling(bootstrap_options = c("striped", "condensed", "responsive"), full_width = TRUE) %>% column_spec(1:5, width = "2cm")


Input: aggregate data for time elapsed per guess, by first removing duplicate times, then summing up total times per player  [CODESPLIT] d.reward.agg <- aggregate(ElapsedTime_Guess ~ Effort + Competition + Sex + Guess_Number + ID_Player, data = d.reward, FUN = mean) d.reward.agg <- aggregate(ElapsedTime_Guess ~ Effort + Competition + Sex + ID_Player, data = d.reward.agg, FUN = sum)


Input: Bayes Factors  load additional libraries subset data into separate objects for frequentist analyses [CODESPLIT] d.math.agg.f <- d.math.agg d.math.agg.f$Competition <- as.factor(d.math.agg.f$Competition) d.math.agg.f$ID_Player <- as.factor(d.math.agg.f$ID_Player) d.math.agg.f$Sex <- as.factor(d.math.agg.f$Sex) d.conf.agg.f <- d.conf.agg d.conf.agg.f$Competition <- as.factor(d.conf.agg.f$Competition) d.conf.agg.f$Effort <- as.factor(d.conf.agg.f$Effort) d.conf.agg.f$ID_Player <- as.factor(d.conf.agg.f$ID_Player) d.conf.agg.f$Sex <- as.factor(d.conf.agg.f$Sex)


Input: Plot AUC [CODESPLIT] ggplot(plot.data, aes(x = Target, y = AUC, color = Algorithm, fill = Algorithm, shape = Algorithm)) + geom_boxplot(width = 0.3,lwd = 1, aes(color = Algorithm, fill = Algorithm), alpha = 0.3, outlier.shape=NA, position=position_dodge(0.5)) + geom_point(position=position_jitterdodge(jitter.width = 0.1, dodge.width = 0.5), size = 0.5) + coord_flip() + geom_hline(yintercept = 0.5, color="black", linetype = "dashed", size = 1) + theme_classic() + theme(text = element_text(size = 18), axis.title.y = element_blank(), legend.position = c(0.85, 0.5)) + scale_color_manual(values = c("#440154", "#5ec962")) + scale_fill_manual(values = c("#440154", "#5ec962")) + ylim(0.25, 1) + scale_x_discrete(labels=rev(c("Sociality" = expression(paste("* ", bold("S"), "ociality")), "Deception" = expression(paste(bold("D"), "eception")), "Negativity" = expression(paste(bold("N"), "egativity")), "Positivity" = expression(paste("* p", bold("O"), "sitivity")), "Mating" = expression(paste("* ", bold("M"), "ating")), "Adversity" = expression(paste(bold("A"), "dversity")), "Intellectuality" = expression(paste("* ", bold("I"), "ntellect")), "Duty" = expression(paste("* ", bold("D"), "uty")))))


Input: Step 4*: Visualization of the ROC curves for "core benchmark" for the Online Supplemental Material  Duty  [CODESPLIT] p_Duty = autoplot(bmr$clone(deep = TRUE)$filter(task_ids = "Duty", learner_ids = c("lasso_Duty", "rf_Duty")), type = "roc") + theme_classic() + theme(title = element_blank(), legend.position = "none", axis.title = element_text(size = 18), axis.text = element_text(size = 16)) + labs(y = "Sensitivity", x = "1 - Specifity") + geom_abline(intercept = 0, slope = 1, color = "black", linetype = "dotted", size = 0.8) + annotate(geom = "text", x = 0, y = 1, label = "Duty", hjust = 0, vjust = 1, size = 10) png("Figures_Tables/Figures/ROC_Curves/Duty.png", width = 450, height = 400) p_Duty dev.off()


Input: Plot ROC curves and caculate AUC (if desired) [CODESPLIT] plotIt <- FALSE currAUC <- plotAUC(allPs,allBFs,dt,numStudies,plotIt)  #currently does not save the AUCs ai <- ai+1 aucs[ai,1] <- sampleSizes[1] aucs[ai,2] <- effectSizes[2] aucs[ai,3] <- i #runNumber aucs[ai,4] <- currAUC[1] aucs[ai,5] <- currAUC[2] plotIt <- FALSE currAUC <- plotAUC(allPs2,allBFs2,dt,numStudies,plotIt)  #currently does not save the AUCs aucs$aucPhacked[ai] <- currAUC[1] aucs$aucBFhacked[ai] <- currAUC[2] if (currAUC[1] != currAUC[2]) { print(paste(effectSizes,i)) print(currAUC) } } #end for i runTimes } #end for ssa allDt <- allDt[-1,]  #get rid of initial dummy row that was just used to init allDt


Input: Stacked plots by SDT outcome   Plot by whether hacked or not plot hit, FA, miss, corrRejection for each effect size/sample size combo  [CODESPLIT] ap <- aggregate(hits ~ criterion+sampleSize+effectSizes+withHack, data=allDt,mean) ap2 <- aggregate(fa ~ criterion+sampleSize+effectSizes+withHack, data=allDt,mean) hFA <- merge(ap,ap2,by=c("criterion","sampleSize","effectSizes","withHack")) ap2 <- aggregate(miss ~ criterion+sampleSize+effectSizes+withHack, data=allDt,mean) hFA <- merge(hFA,ap2,by=c("criterion","sampleSize","effectSizes","withHack")) ap2 <- aggregate(corrRej ~ criterion+sampleSize+effectSizes+withHack, data=allDt,mean) hFA <- merge(hFA,ap2,by=c("criterion","sampleSize","effectSizes","withHack")) hFA$hits <- hFA$hits / numStudies hFA$fa <- hFA$fa / numStudies hFA$corrRej <- hFA$corrRej / numStudies hFA$miss <- hFA$miss / numStudies


Input: plot BF vs pvalues [CODESPLIT] plot(log(allPs),log(allBFs),bty="l")


Input: Create matrix of input variables with populationlevel effects: [CODESPLIT] C_datMM <- model.matrix( as.formula(paste("~", paste(vpreds_noInt, collapse = " + "))), data = C_dat )


Input: Set the latent regression coefficients for booklet 1, 5, 7 and 10 for reading and  booklet 4, 6, 9 and 11 for science to 0  [CODESPLIT] betas <- data.frame(var = c(which(names(con_dat) %in% paste0("bookid.", c(1, 5, 7, 10))), which(names(con_dat) %in% paste0("bookid.", c(4, 6, 9, 11)))), dim = rep(2:3, each = 4), value = 0) betas <- data.frame(var = c(which(names(con_dat) %in% paste0("bookid.", c(1, 5, 7, 10))), which(names(con_dat) %in% paste0("bookid.", c(4, 6, 9, 11)))), dim = rep(2:3, each = 4), value = 0)


Input: Compute latent regression of the latent ability on the conditioning  variables (excl. the first column which is the student ID) [CODESPLIT] latreg <- tam.latreg(likeli, Y = con_dat[, -1], pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay"), beta.fixed = as.matrix(betas)) } else { latreg <- tam.latreg(likeli, Y = con_dat[, -1], pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay")) } latreg <- tam.latreg(likeli, Y = con_dat1[, -1], pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay"), beta.fixed = as.matrix(betas)) } else { latreg <- tam.latreg(likeli, Y = con_dat1[, -1], pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay")) }


Input: Draw 5 plausible values for each student out of the resulting distribution  which is assumed to be normal distributed [CODESPLIT] pvs    <- tam.pv(latreg, nplausible = 5, normal.approx = T, samp.regr = samp.regr.opt) } else { pvs    <- tam.pv(latreg_md, nplausible = 5, normal.approx = T, samp.regr = samp.regr.opt) } else {


Input: Extract the regression coefficients of the conditioning variables, because  they are fixed for the core domains in the next step at that value  [CODESPLIT] reg.coefs <- cbind(rep(1:dim(latreg$beta)[1], 3), rep(1:3, each = dim(latreg$beta)[1]), c(latreg$beta[, 1], latreg$beta[, 2], latreg$beta[, 3]))


Input: Extract IRT likelihood of the second model (math, read and scie plus digital  domains)  [CODESPLIT] likeli_md <- IRT.likelihood(mod2)


Input: Compute latent regression of the latent ability on the conditioning  variables (excl. the first column which is the student ID). But this time  only the regression coefficients of the digital domains are computed freely.  The rest is fixed at the values of the first model [CODESPLIT] latreg_md <- tam.latreg(likeli_md, Y = con_dat[, -1],  pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay"), beta.fixed = reg.coefs)


Input: Calculate the number of surveys completed per person [CODESPLIT] N <- as.data.frame(table(dat$id)) names(N) <- c("id", "N") dat <- merge(dat, N, by = "id", all.x = T) table(dat$N, useNA = "ifany")


Input: DOWNSAMPLING  Loop to downsample data based on minimum time and distance between points Time parameter is set in "while(diff < time in minutes | dist > in meters)" downsampled pts that were less than 60min apart unless frog moved more than 20m during the time window  [CODESPLIT] tracks_dsmpl <- data.frame() ids <- unique(tracks$id) for(i in ids) { traj = subset(tracks, tracks$id == i) for(i in 1:nrow(traj)) { diff <- difftime(traj$dt[i+1], traj$dt[i], units = "mins") delta_x <- traj$x_utm[i+1] - traj$x_utm[i] delta_y <- traj$y_utm[i+1] - traj$y_utm[i] dist <- sqrt(delta_x^2+delta_y^2) if(is.na(diff)) {break} while(diff <= 60 & dist < 20) { traj <- traj[-(i+1),] diff <- difftime(traj$dt[i+1], traj$dt[i], units = "mins") delta_x <- traj$x_utm[i+1] - traj$x_utm[i] delta_y <- traj$y_utm[i+1] - traj$y_utm[i] dist <- sqrt(delta_x^2+delta_y^2) if(is.na(diff)) {break} } } tracks_dsmpl <- bind_rows(tracks_dsmpl, traj) } tracks_dsmpl <- tracks_dsmpl %>% group_by(id) %>% mutate(time_diff = difftime(dt, lag(dt, n = 1L), units = "min"), delta_x = x_utm - lag(x_utm, n = 1L), delta_y = y_utm - lag(y_utm, n = 1L), dist = sqrt(delta_x^2+delta_y^2)) tracks <- tracks_dsmpl


Input: Remove first row (tagging date) and last row (untagging day) per individual   Sort the daily, group by id and add index of id+date as a new variable  [CODESPLIT] daily %>% arrange(id) %>% group_by(id) %>% mutate(id_day = paste(id, date)) -> daily_grouped


Input: Join with summary stats [CODESPLIT] tracks_sum  <- left_join(tracks_sum, duration) tracks_sum  <- left_join(tracks_sum, relocs) tracks_sum  <- left_join(tracks_sum, days_tracked)


Input: Calculate average daily movement by behavioral category per individual for plotting [CODESPLIT] daily_beh_mean <- daily_beh %>% group_by(id, behavior) %>% dplyr::summarize(daily_dist = mean(daily_dist), max_dist = mean(max_dist), sex = first(sex), species = first(species))


Input: MCPs home range with 95% minimum convex ploygon (MCP95) [CODESPLIT] mcp95<- mcp(data_sp["id"], percent = 95, unout = "m2")


Input: 95% contour with hpi pluging method Define countour level [CODESPLIT] cont=c(95)


Input: Initiate empty df to store the metadarta [CODESPLIT] allfrogs_info <- data.frame(ID = numeric(0), Cont = numeric(0), frog_id = character(0)) allfrogs_info <- data.frame(ID = numeric(0), Cont = numeric(0), frog_id = character(0))


Input: BOXPLOTS: DAILY MOVEMENT  FIGURE EXPORT: daily movement by sex [CODESPLIT] daily_plot <-tracks_sum%>% ggplot(aes(x= sex, y=log(mean_cumul), fill = species)) + theme_bw(20) + geom_boxplot(width= 0.6, outlier.shape = NA) + geom_jitter(aes(group = sex), position=position_jitterdodge(0.4), shape = 21, stroke = 1, color = "black", size = 2, alpha = 0.6) + scale_color_manual(values=c("black", "black")) + scale_fill_manual(values=c("#E7B800", "#0072B2","#FC4E07")) + theme(legend.position="none") + labs(y = "ln Daily movement (m)") + facet_wrap(~species, labeller = labeller(species=c("afemo" = "A. femoralis", "dtinc" = "D. tinctorius", "osylv" = "O. sylvatica"))) + theme(axis.title.x = element_blank(), axis.text.x = element_text(color = "black", size = 18), strip.text = element_text(face = "italic"), aspect.ratio = 4) + scale_x_discrete(labels= c("F", "M"), expand = expansion(add = 1)) daily_plot


Input: Daily movement by sex and species, log transformed violin plots  [CODESPLIT] ggplot(daily_select, aes(x= sex, y=log(daily_dist))) + theme_bw(20) + geom_violin(aes(fill = species)) + scale_fill_manual(values=c("#E7B800", "#0072B2","#FC4E07")) + theme(legend.position="none") + labs(y = "ln Daily movement (m)") + geom_jitter(aes(shape=sex, fill = species), position=position_jitterdodge(0.2), size = 4, alpha=0.2) + facet_wrap(~species, labeller = labeller( species=c(afemo ="A. femoralis", dtinc = "D. tinctorius", osylv = "O. sylvatica"))) + theme(axis.title.x = element_blank(), axis.text.x = element_text(color = "black", size = 18), strip.text = element_text(face = "italic")) + scale_x_discrete(labels= c("F", "M"))


Input: convert attributes from character to numeric [CODESPLIT] for(i in 1:3) { data[[paste0("opt",i,"cost")]] <- as.numeric(substring(data[[paste0("opt",i,"cost")]], 3, 7)) data[[paste0("opt",i,"sides")]] <- as.numeric(substring(data[[paste0("opt",i,"sides")]], 1, 2)) data[[paste0("opt",i,"deliveryTime")]] <- as.numeric(substring(data[[paste0("opt",i,"deliveryTime")]], 2, 3)) }


Input: Step 9: Create time difference variable, and the final dependent variable (media_success)  calculating the time difference between each documentpair  [CODESPLIT] result$date_diff <- as.Date(as.character(result$news_date), format="%Y-%m-%d")- as.Date(as.character(result$date), format="%Y-%m-%d")


Input: Remove trials with RT < 4710 ms (i.e., presses before disambiguating information in sentence)  [CODESPLIT] dataset_exp1 <- dataset_exp1[which(dataset_exp1$rt > 4710), ]


Input: Add 'trackloss' column (if not looking at IA_1 or IA_2, then trackloss  1)  [CODESPLIT] dataset_exp1 <- within(dataset_exp1, { trackloss <- ifelse(average_target_sample_count_proportion == 0 & average_distractor_sample_count_proportion == 0, 1, 0) })


Input: Ttests (using participantaveraged data) [CODESPLIT] num_sub_exp1 <- length(unique((eyetrackingr.data.exp1$participant_number))) threshold_t_exp1 <- qt(p = 1 - .05 / 2, df = num_sub_exp1 - 1) # Pick threshold for t based on alpha = .05, two-tailed df_timeclust_exp1 <- make_time_cluster_data(response_time_exp1, test = "t.test", paired = TRUE, predictor_column = "trial_condition_new", threshold = threshold_t_exp1 )


Input: MSE for each participant [CODESPLIT] MSE.Sys.VAR.i = lapply(1:fold, function(k) MSE.k[[k]]$MSE.ki)


Input: use mutate and the dffit fit information to make the data for mal [CODESPLIT] mal_fit <- fit_num %>% mutate(fit = (s)/(1.196506 + s)) dex_fit <- fit_num %>% mutate(fit = (s)/(62.736799 + s)) lac_fit <- fit_num %>% mutate(fit = (s)/(43.839063 + s)) maldex_fit <- fit_num %>% mutate(fit = (s)/(7.253739 + s))


Input: Logistic Mixed Effects Regression for Original Critical Targets [CODESPLIT] log_reg_data <- cards_long %>% filter(card == "card_1" | card == "card_3" | card == "card_6" | card == "card_7" | card == "card_9" | card == "card_14" ) %>% mutate( distance = case_when( card == "card_1" | card == "card_3" | card == "card_6"  ~ 0, card == "card_7" | card == "card_9" | card == "card_14" ~ 1 ), comf_acquaint = scale(comf_acquaint, scale = FALSE), comf_close = scale(comf_close, scale = FALSE), approp_acquaint = scale(approp_acquaint, scale = FALSE), approp_close = scale(approp_close, scale = FALSE) ) log_reg_data$amit_wording <- factor(log_reg_data$amit_wording, levels = c("original", "new")) h1_melogreg <- glmer(choice ~ distance + amit_wording + (1 + distance|id) + (1|card), data = log_reg_data, family = binomial(link = "logit")) h1_melogreg_inter <- glmer(choice ~ distance * amit_wording + (1 + distance|id) + (1|card), data = log_reg_data, family = binomial(link = "logit")) h1_model_comparison <- anova(h1_melogreg, h1_melogreg_inter)


Input: Highest density interval ' ' This is a function that will calculate the highest density interval from a ' posterior sample. ' ' The default is to calcualte the highest 95 percent interval. It can be used ' with any numeric vector instead of having to use one of the specific MCMC ' classes. This function has been adapted from John K. Kruschke (2011). Doing ' Bayesian Data Analaysis: A Tutorial with R and BUGS. ' ' @param x Numeric vector of a distribution of data, typically a posterior ' sample ' @param prob Width of the interval from some distribution. Defaults to `0.95`. ' @param warn Option to turn off multiple sample warning message Must be in the ' range of `[0,1]`. ' @return Numeric range ' @export ' @examples ' x < qnorm(seq(1e04, .9999, length.out1001)) ' hdi_95 < hdi(x, .95) ' hdi_50 < hdi(x, .50) ' ' hist(x, br50) ' abline(vhdi_95, col"red") ' abline(vhdi_50, col"green") ' ' x < exp(seq(pi * (1  (1/16)), pi, len  1000)) ' x < c(x, rev(x)[1]) ' x < c(x, x) ' plot(sort(x), type"l") ' plot(density(x, adjust0.25)) ' abline(vhdi(x, p.49), col2) ' abline(vhdi(x, p.50), col3)  [CODESPLIT] hdi <- function(x, prob=0.95, warn=TRUE) { if (anyNA(x)) { stop("HDI: ", "x must not contain any NA values.", call.=FALSE) } N <- length(x) if (N < 3) { if (warn) { warning("HDI: ", "length of `x` < 3.", " Returning NAs", call.=FALSE) } return(c(NA_integer_, NA_integer_)) } x_sort <- sort(x) window_size <- as.integer(floor(prob * length(x_sort))) if (window_size < 2) { if (warn) { warning("HDI: ", "window_size < 2.", " `prob` is too small or x does not ", "contain enough data points.", " Returning NAs.", call.=FALSE) } return(c(NA_integer_, NA_integer_)) } lower <- seq_len(N - window_size) upper <- window_size + lower


Input: test whether Condition predicts exclusion probability [CODESPLIT] Cond_exclude <- table(data$Cond, data$exclude) chisq.test(Cond_exclude) rm(Cond_exclude)


Input: Fix the following script by:  Take our dataset (df) , and then  group it by our explanatory variable (Condition), and then  Summarise this dataset by  Creating a new variable in this summary dataset called Mean  Mean takes the mean of our Response variable, and ignores NA.  Repeat for standard deviation.  We've added on one more column in our summary dataset  N.  N is the number of observations per group. To do so, we want to add up  How many times our DV is not missing (per group).  When you think it is a complete, save the script. The name of the script  above will go from red to black. That is how you know you've saved it.  You can use ctrl+S to save, or click the floppy disk above.  We want to know how the means and standard deviations and Ns of Hire_Rating differed.  [CODESPLIT] sum_hire <-


Input: Calculate R squared for each model [CODESPLIT] r.squaredGLMM(m1) #indegree r.squaredGLMM(m2) #outdegree r.squaredGLMM(m3) #betweenness r.squaredGLMM(m4) #outcloseness r.squaredGLMM(m5) #incloseness r.squaredGLMM(m6) #local clustering r.squaredGLMM(m7) #average shortest path length r.squaredGLMM(m8) #eigenvector r.squaredGLMM(m9) #outstrength r.squaredGLMM(m10) #instrength


Input: split the data into two halves [CODESPLIT] d$ItemNo = parse_number(as.character(d$ItemNo)) de = d %>%  filter(ItemNo %% 2 == 0) do = d %>%  filter(ItemNo %% 2 == 1)


Input: Zscore transform RTs, compute zRT difference, remove NAs for the 2 groups  [CODESPLIT] de <- de |> group_by(Subject) |> mutate (zRT = scale(Reaction.Time, center = T, scale = T), meanRT = mean(Reaction.Time)) |> select (1,2,4,5) |> pivot_wider(names_from = Condition, values_from = zRT) |> mutate (zrt.diff = R-P) |> filter(!is.na(zrt.diff)) do <- do |> group_by(Subject) |> mutate (zRT = scale(Reaction.Time, center = T, scale = T), meanRT = mean(Reaction.Time)) |> select (1,2,4,5) |> pivot_wider(names_from = Condition, values_from = zRT) |> mutate (zrt.diff = R-P) |> filter(!is.na(zrt.diff)) de <- de |> group_by(Subject) |> mutate (zRT = scale(Reaction.Time, center = T, scale = T), meanRT = mean(Reaction.Time)) |> select (1,2,4,5) |> pivot_wider(names_from = Condition, values_from = zRT) |> mutate (zrt.diff = R-P) |> filter(!is.na(zrt.diff))


Input: fit models for even and odd numbered items (Bayesian & Generalized LMM) [CODESPLIT] m_de = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = de, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) m_do = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = do, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) m_de = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = de, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) m_do = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = do, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5)))


Input: fit lmm to the whole dataset [CODESPLIT] m <- blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = d_trimmed, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) summary(m)


Input: calculate shared and unique variance [CODESPLIT] x1 = rsq - rx2y^2 x2 = rsq - rx1y^2 x1_x2 = rsq - x1 - x2 c(x1, x2, x1_x2, rsq) } semipartial_corr = function(r12, r13, r23) {


Input: create empty df [CODESPLIT] df <- data.frame( `rx1y` = numeric(), `rx2y` = numeric(), `rx1x2` = numeric(), `rx1y_x2` = numeric(), `rx2y_x1` = numeric(), `x1` = numeric(), `x2` = numeric(), `Common` = numeric(), `Total` = numeric() )


Input: > Left panel: QQplot (uniform distribution)  > Right panel: Residuals against predicted values;; shaded (due to sample size) with extreme residuals colored red, and   3) MAIN EFFECTS OF KEY VARIABLES   AspElevForm  [CODESPLIT] emmip(PrefRate, ~AspElevForm, type = "response", CIs = TRUE) (emm <- emmeans(PrefRate, specs = ~AspElevForm, type = "response")) pairs(emm)


Input: Operator on x, rescale to be in y unit  [CODESPLIT] Hlist <- list() for(i in seq(nt)){ Hlist[[paste0("H",i)]] <- with(data, t(apply(data[[i]]$sdfp, 1, function(x) x*data[[i]]$prior)) %*% A) } H<-bdiag(unlist(Hlist)) strl <- function(x){ x[x < max(x)/1000] <- 0 return(x) } H <- as(t(apply(H, 1, strl)), 'dgCMatrix')  #Make sparser


Input: Creates the variable 'distances', a 540 X 3 distance matrix between stimuli and  category prototypes.  [CODESPLIT] distances = as.matrix(pdist(coordinates, prototypes))


Input: calculate similarity coefficient (mean of signif_line$similarity.scores) [CODESPLIT] mean(signif_line$similarity.scores[,2]) mean(coef_line$similarity.scores[,2]) mean(varimp_line$similarity.scores[,2])


Input: Calculate Priestley Taylor Ep [CODESPLIT] data$PT.Ep <- 1.26/lambda.w*deltav/(deltav+rho.air)*Rn


Input: plot hit, FA, miss, corrRejection for each effect size/sample size combo  [CODESPLIT] ap <- aggregate(hits ~ criterion+sampleSize+effectSizes, data=allDt,mean) ap2 <- aggregate(fa ~ criterion+sampleSize+effectSizes, data=allDt,mean) hFA <- merge(ap,ap2,by=c("criterion","sampleSize","effectSizes")) ap2 <- aggregate(miss ~ criterion+sampleSize+effectSizes, data=allDt,mean) hFA <- merge(hFA,ap2,by=c("criterion","sampleSize","effectSizes")) ap2 <- aggregate(corrRej ~ criterion+sampleSize+effectSizes, data=allDt,mean) hFA <- merge(hFA,ap2,by=c("criterion","sampleSize","effectSizes")) hFA$hits <- hFA$hits / numStudies hFA$fa <- hFA$fa / numStudies hFA$corrRej <- hFA$corrRej / numStudies hFA$miss <- hFA$miss / numStudies


Input: plot errors only (FA and misses, separately)   Plot ROC dist   [CODESPLIT] aa <- aggregate(ROCdist ~ criterion, data=allDt,mean) ab <- aggregate(ROCdist ~ criterion, data=allDt,sd) ab$ci <- qnorm(.975) * ab$ROCdist / sqrt(numStudies) titleText <- ifelse(length(sSizesAll) < 2, paste("N=",sSizesAll[1],"d=",effSzAll[1]), paste("firstES:",effSzAll[1])) plot(seq(1:length(crits)),aa$ROCdist,bty="l",xaxt="n",xlab="Criterion for Statistical Significance",ylab="Distance to Perfection",pch=19,col=rainbow(length(crits)),cex=2,ylim=c(0,max(aa$ROCdist)+max(ab$ci)),main = titleText) axis(side=1,at=seq(1:length(crits)),labels = crits) for(i in 1:length(crits)) { segments(i,aa$ROCdist[i] - ab$ci[i],i,aa$ROCdist[i]+ab$ci[i]) }


Input: calculate the variance and bias for the log(DR) [CODESPLIT] log.var <- ((res$se.tau2)^2)/4*1/(sum(w.star))^2*(sum(1/(res$vi + res$tau2)^2))^2 log.sd <- sqrt(log.var) bias <- 1/2*(res$se.tau2)^2*(1/2/sum(w.star)^2 - 1/sum(w.star)*sum(1/(res$vi + res$tau2)^3))


Input: create the forest plot including extra information (study names, weights, observed effects and associated variances).  [CODESPLIT] f <- forest(res, col = "blue", border = "blue", ylim = c(-8,12), xlim = c(-4,5), pch = 19, slab = dat$study, showweights = FALSE, addfit = FALSE, refline = FALSE, ilab = cbind(paste(format(round(res$yi,2), nsmall = 2)) , paste(format(round(res$vi, 2), nsmall = 2)), paste(format(round(res$ni, 2))), paste(format(weights, nsmall = 2)), paste(format(weights.f, nsmall = 2))) , ilab.xpos = c(-3.15,-2.75, -2.35,-1.5,-0.75), ilab.pos = 2, efac = 0, digits = 2)


Input: STEP 2: Filter the data in overall.data table according to preregistered inclusion criteria    replace 0 with NA in outcome column [CODESPLIT] overall.data$LTScreenOut[overall.data$LTScreenOut == 0] <- NA #replace NAs with 0 for averaging in the next steps overall.data$LTObjectOut[overall.data$LTObjectOut == 0] <- NA #replace NAs with 0 for averaging in the next steps overall.data$FirstLookDurationObjectOut[overall.data$FirstLookDurationObjectOut == 0] <- NA #replace NAs with 0 for averaging in the next steps


Input: fit indices function for the SEM and FA analyses [CODESPLIT] fa.CFI<-function(x){ nombre<-paste(x,"CFI",sep = ".") nombre<- ((x$null.chisq-x$null.dof)-(x$STATISTIC-x$dof))/(x$null.chisq-x$null.dof) return(nombre) }


Input: check Descriptive statistics    gender breakdown [CODESPLIT] df <- eval_data %>% group_by(gender) %>% summarise(counts = n()) df


Input: Decompose variance  Estimate multilevel model (without predictors) [CODESPLIT] m_logistic <- lmer(estimate ~ 1 + (1|controls) + (1|age) + (1|year) + (1|age:year) + (1|age:controls) + (1|year:controls), data = results %>% rename(age = age_group))


Input: Visualize four first principal components [CODESPLIT] fig.df <- data.frame(HR = c(FPCAdense$phi[,1], FPCAdense$phi[,2], FPCAdense$phi[,3], FPCAdense$phi[,4]), pc = c(rep(1, 51), rep(2, 51), rep(3, 51), rep(4, 51)), Time= rep(FPCAdense$workGrid, 4)) all.four <- ggplot(fig.df, aes(x=Time, y=HR))+geom_line()+ geom_vline(xintercept=.20, linetype="dashed")+ facet_grid(.~pc)+ theme_bw() all.four ggsave("../figures/figure5.png", width=6, height=4)


Input: SPATIOTEMPORAL VARIABLES AND HOMING SUCCESS  Join territory center pts to the dataframe to calculate translocation distance and homing success [CODESPLIT] trajectory <- trajectory.df %>% left_join(territory_centers, by = "id")%>% mutate(trans_dist = sqrt((x_home - first(x_utm))^2+(y_home - first(y_utm))^2), trans_group = ifelse(trans_dist > 100, "200m", "50m"))%>% dplyr::select(id, sex, trans_group, trans_dist, dt, x_utm, y_utm, x_home, y_home, time_lag_min = time_diff, dist)


Input: Tally the number relocations for each individual per day [CODESPLIT] trajectory.df %>% group_by(id, date) %>% count(id) -> relocs.perday


Input: Plot full circular info by sex  start with blank plot, then add groupspecific points  [CODESPLIT] dev.new();; par(mai = c(1, 1, 0.1,0.1)) par(mar=c(0.5, 0.5, 0.5, 0.5)) pdf("dt_circ_50m.pdf") plot(corient50_m, bg = rgb(0, 0.749, 0.769), pch = 21, cex = 1.5, lwd = 2, stack = TRUE, bin = 60, xlim = c(-1.2, 1.2), ylim = c(-1.2, 1.2), sep = 0.05, shrink = 1, tcl.text = -0.125, control.circle=circle.control(lwd = 2)) ticks.circular(circular(seq(0,2*pi,pi/2)), tcl=0.075) par(new = T) plot(corient50_f, bg=rgb(0.973, 0.463, 0.427), pch = 21, cex=1.5, lwd = 2, stack=T, bins=60, sep = -0.05, shrink= 1.3, axes = FALSE, control.circle=circle.control(lwd = 1)) arrows.circular(mean(corient50_m), y = rho.circular(corient50_m), col = rgb(0, 0.749, 0.769), lwd = 5) arrows.circular(mean(corient50_f), y = rho.circular(corient50_f), col = rgb(0.973, 0.463, 0.427), lwd = 5) par(new = T) plot(corient50_m, col = NA, shrink= 2.5, axes = FALSE, control.circle=circle.control(lty = 2, lwd = 1)) ticks.circular(circular(seq(0,2*pi,pi/8)), tcl=0.2) lines(density.circular(corient50_m, bw=30), shrink= 1, col = rgb(0, 0.749, 0.769, 0.7), lwd=2, lty=1) lines(density.circular(corient50_f, bw=30), col = rgb(0.973, 0.463, 0.427, 0.7), lwd=2, lty=1) dev.new();; par(mai = c(1, 1, 0.1,0.1)) par(mar=c(0.5, 0.5, 0.5, 0.5)) pdf("dt_circ_200m.pdf") plot(corient200_m, bg = rgb(0, 0.749, 0.769), pch = 21, cex = 1.5, lwd = 2, stack = TRUE, bin = 60, xlim = c(-1.2, 1.2), ylim = c(-1.2, 1.2), sep = 0.05, shrink = 1, tcl.text = -0.125, control.circle=circle.control(lwd = 2)) ticks.circular(circular(seq(0,2*pi,pi/2)), tcl=0.075) par(new = T) plot(corient200_f, bg=rgb(0.973, 0.463, 0.427), pch = 21, cex=1.5, lwd = 2, stack=T, bins=60, sep = -0.05, shrink= 1.3, axes = FALSE, control.circle=circle.control(lwd = 1)) arrows.circular(mean(corient200_m), y = rho.circular(corient200_m), col = rgb(0, 0.749, 0.769), lwd = 5) arrows.circular(mean(corient200_f), y = rho.circular(corient200_f), col = rgb(0.973, 0.463, 0.427), lwd = 5) par(new = T) plot(corient200_m, col = NA, shrink= 2.5, axes = FALSE, control.circle=circle.control(lty = 2, lwd = 1)) ticks.circular(circular(seq(0,2*pi,pi/8)), tcl=0.2) lines(density.circular(corient200_m, bw=30), shrink= 1, col = rgb(0, 0.749, 0.769, 0.7), lwd=2, lty=1) lines(density.circular(corient200_f, bw=30), col = rgb(0.973, 0.463, 0.427, 0.7), lwd=2, lty=1)


Input: Helper function to prepare raw keyboard data ' ' @author F. Bemmann ' @family Preprocessing function ' @description this function unfolds json data into one column per keyvalue pair ' @export [CODESPLIT] parseJsonColumnSensing = function(df, column_name){ parseJsonColumn = function(x){ str_c("[ ", str_c(x, collapse = ",", sep=" "), " ]")  %>% jsonlite::fromJSON(flatten = T) %>% as_tibble() } df2 = df %>% select(user_uuid,client_event_id,!!column_name) %>% filter(!is.na(!!rlang::sym(column_name))) %>% map_dfc(.f = parseJsonColumn) %>% distinct() colnames(df2)[1:2] = c("user_uuid", "client_event_id") df = left_join(df, df2, by = c("user_uuid", "client_event_id")) df[,column_name] = NULL return(df) }


Input: Separate ANOVAs for each subscale  Pairwise ttests with adjusted alpha level of .05/4  .0125 (because there are four relevant comparisons) [CODESPLIT] summary(aov(value~Fan*time+Error(VP_t0/(time)),data=dat[dat$scale=="Attentiveness",])) pairwise.t.test(dat[dat$scale=="Attentiveness",]$value,paste(dat[dat$scale=="Attentiveness",]$Fan,dat[dat$scale=="Attentiveness",]$time),p.adj="none")


Input: Models   .. Contrasts   (Reverse) Helmert for cond speech, cond mask  Treatment for speech_mask  Sum for group  Factor variables  [CODESPLIT] df <- df %>% mutate( group = factor(group), # oc, pd gender = factor(intake_gender), # f, m cond_mask = factor(cond_mask, levels = c("nm","sm","kn")), cond_speech = factor(cond_speech, levels = c("habitual","clear","loud")) ) %>% mutate(speech_mask = paste(cond_speech,cond_mask,sep="_")) levels(df$group) # oc, pd levels(df$gender) # f, m levels(df$cond_speech) # habitual, clear, loud levels(df$cond_mask) # nm, sm, kn


Input: 4) Descriptives and data inspection   total duration on survey [CODESPLIT] stat.desc(working_file %>% group_by(pp) %>% slice(1) %>% pull(duration))


Input: bayesian ttests [CODESPLIT] ttestBF(wide$high, wide$neutral, paired = TRUE) ttestBF(wide$low, wide$neutral, paired = TRUE) ttestBF(wide$high, wide$low, paired = TRUE) formatC(3057348376, format = "e", digits = 2)


Input: Confidence interval as a vector [CODESPLIT] result <- c("lower" = vec_mean - error, "upper" = vec_mean + error) return(result) }


Input: Transform academic background and job category variables from character to factor [CODESPLIT] class(expertsample$acadgroup) expertsample$acadgroup<-as.factor(expertsample$acadgroup) class(expertsample$job_cat) expertsample$job_cat <- as.factor(expertsample$job_cat)


Input: graphical check for normal distribution of differences support (mean) [CODESPLIT] diff_support <- bothexpert$BECCS_support-bothexpert$DACCS_support hist(diff_support)


Input: Wilcoxon tests support (mean) [CODESPLIT] wilcox.test(bothexpert$BECCS_support, bothexpert$DACCS_support, paired=TRUE)


Input: correlations separately for each condition [CODESPLIT] data_con <- data[data$Cond == "Control", ] data_ent <- data[data$Cond == "Entitlement", ] chart.Correlation(data_con[ , c("pes","prestige","dominance","benign","malicious","pain")], use = "pairwise.complete.obs", pch = 20, histogram = TRUE) chart.Correlation(data_ent[ , c("pes","prestige","dominance","benign","malicious","pain")], use = "pairwise.complete.obs", pch = 20, histogram = TRUE) rm(data_con,data_ent)


Input: Estimate partial correlation matrices using fiml (partial cors and not glasso b/c different sample sizes leads to different glasso penalties) [CODESPLIT] net1hi <- cor1.edhi$cor %>% EBICglasso(., n = cor1.edhi$n) net2hi <- cor2.edhi$cor %>% EBICglasso(., n = cor2.edhi$n) net3hi <- cor3.edhi$cor %>% EBICglasso(., n = cor3.edhi$n) net4hi <- cor4.edhi$cor %>% EBICglasso(., n = cor4.edhi$n) net5hi <- cor5.edhi$cor %>% EBICglasso(., n = cor5.edhi$n) net6hi <- cor6.edhi$cor %>% EBICglasso(., n = cor6.edhi$n) net7hi <- cor7.edhi$cor %>% EBICglasso(., n = cor7.edhi$n) net1lo <- cor1.edlo$cor %>% EBICglasso(., n = cor1.edlo$n) net2lo <- cor2.edlo$cor %>% EBICglasso(., n = cor2.edlo$n) net3lo <- cor3.edlo$cor %>% EBICglasso(., n = cor3.edlo$n) net4lo <- cor4.edlo$cor %>% EBICglasso(., n = cor4.edlo$n) net5lo <- cor5.edlo$cor %>% EBICglasso(., n = cor5.edlo$n) net6lo <- cor6.edlo$cor %>% EBICglasso(., n = cor6.edlo$n) net7lo <- cor7.edlo$cor %>% EBICglasso(., n = cor7.edlo$n)