Input: RIndex    Calcuate Mean, Median, Peak  [CODESPLIT] Rindex.Reults<-BCa.Boot.CI(ScienceStatus_SP,Calc.Z,r.index.calc.boot,LogT=FALSE,splitter=yearcat, StatType="AR") Rindex.Reults


Input: FIGURE 3 Length in phonemes    RD  fit a model with fixed effects and with the random effect of subjects on intercepts and the slopes for length [CODESPLIT] Cue.Subj.lmer = glmer(ACC ~ CueCondition + zLengthPh + zFreq + (1+zLengthPh|Subject), data = NamingData, family = "binomial", control = glmerControl(optimizer="bobyqa")) summary(Cue.Subj.lmer)


Input: extract fitted values and align with original data for plotting [CODESPLIT] a<-fitted.values(Cue.Subj.lmer) length(a) Dat<-na.omit(NamingData) #remove NAs from original data so aligns with model values Dat$fitted<-a names(Dat) a<-fitted.values(Cue.Subj.lmer) length(a) Dat<-na.omit(NamingData) #remove NAs from original data so aligns with model values Dat$fitted<-a names(Dat)


Input: FIGURE 4a Plot average slope for effect of Frequency [CODESPLIT] p <- ggplot(data=Dat,aes(x=zFreq, y=fitted)) p <- p + geom_smooth(method = "glm") p <- p + xlab("Frequency (z score)") + ylab("Accuracy (model fit)") p <- p + ggtitle("4a) Average (group) effect of Frequency") p <- p + ylim(0,1) p <- p + theme_bw() + theme(text=element_text(size=12)) p


Input: Main effects model for predicting inversion questions during alignment sessions. [CODESPLIT] inversion_main_effects_model<-glmer(inversion_dv ~ prime_type + WMC + modality +  inversion_production_pre + (1 + prime_type + trial_order | subject) + (1|verb), priming, family="binomial"(link="logit"),glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 100000))) summary(inversion_main_effects_model)


Input: Odds ratios for main effects model [CODESPLIT] inversion.me.CI<-confint(inversion_main_effects_model, parm="beta_", level=0.90, method="Wald") inversion.me.tab <- cbind(est = fixef(inversion_main_effects_model),inversion.me.CI) inversion.me.tab <- exp(inversion.me.tab) inversion.me.tab <- as.data.frame(inversion.me.tab) inversion.me.tab <- rownames_to_column(inversion.me.tab) inversion.me.tab


Input: Visualize the interaction between prime type and modality.  save the specific effect to a variable [CODESPLIT] effect2 <-effect("prime_type*modality",inversion_full_model_sig_int_only) summary(effect2) plot(effect2)


Input: post hoc analyses to compare all levels of test order  between groups indirect production main effect only [CODESPLIT] ind_prod_me_between_groups <- emmeans(indirect_production_me,c("test_order"), type = "response") pairs(ind_prod_me_between_groups, reverse = F, type = 'response', adjust = 'none') plot(ind_prod_me_between_groups)


Input: Test assumptions MANOVA  Test whether residuals are normally distributed [CODESPLIT] df$pc1.residuals = lm(pc1~condition.socaccount, data=df)$residuals df$pc2.residuals = lm(pc2~condition.socaccount, data=df)$residuals df$pc3.residuals = lm(pc3~condition.socaccount, data=df)$residuals df$pc4.residuals = lm(pc4~condition.socaccount, data=df)$residuals shapiro.test(df$pc1.residuals) shapiro.test(df$pc2.residuals) shapiro.test(df$pc3.residuals) shapiro.test(df$pc4.residuals)


Input: Only include tweets with at least 3 words [CODESPLIT] final_twitter_data_ex <- final_twitter_data %>% filter(wc>=3) final_twitter_data_ex <- final_twitter_data_ex %>% filter(bryscore>=0.0001)


Input: Means and SDs in feartweets and anxietytweets [CODESPLIT] final_twitter_data_ex %>% group_by(fearVSanx) %>% summarise_at(vars(bryscore,i,we,they,focusfuture), list(mean=mean, sd=sd))


Input: Independent samples ttest: Brysbaert concreteness score as DV [CODESPLIT] t.test_bci <- final_twitter_data_ex %>% rstatix::t_test(bryscore ~ fearVSanx, var.equal = TRUE, detailed=TRUE) %>% rstatix::add_significance() t.test_bci


Input: convert age from months to years [CODESPLIT] demog.tab$interview_age <- demog.tab$interview_age / 12


Input: multinomial CI (these are simulataneous CI although assume full pooling) [CODESPLIT] obs_p_CI <- DescTools::MultinomCI(pl_d$N, conf.level=1-0.05/2, method="goodman") *4 pl_d$obs_p_lb <- obs_p_CI[,2] pl_d$obs_p_ub <- obs_p_CI[,3] pl_d %>% mutate(resp_true = ifelse(k>=4,1,0), fill_group = str_c(item, resp_true, type), line_group = str_c(item, type), item = factor(item, levels=c("true","false"))) %>% ggplot(aes(x=k,y=obs_p))+ facet_grid(item ~ type) + nice_theme + geom_col(aes(fill=fill_group))+ geom_errorbar(aes(y=obs_p,ymin=obs_p_lb, ymax=obs_p_ub),color="dark grey",width=0,lwd=0.8)+


Input: Mratio posterior density plot [CODESPLIT] log_mu_sci <- unlist(c(output[,grep('mu_logMratio_1',varnames(output))])) log_mu_cov <- unlist(c(output[,grep('mu_logMratio_2',varnames(output))])) d_groupM <- data.frame(logM =c(log_mu_sci,log_mu_cov), type=c(rep('science',length(log_mu_sci)),rep('Covid-19',length(log_mu_sci)))) d_groupM %>% mutate(M=exp(logM)) %>% ggplot(aes(x=M,y=type,fill=type))+ nice_theme + geom_vline(xintercept = 1, lty=2,size=0.4)+ stat_halfeye(.width = c(.95, .95),aes(fill=type),alpha=0.8)+


Input: Convert `campaign_week` from a character string to a factor with 11 levels to order weeks chronologically. [CODESPLIT] Facebook_Users$campaign_week <- factor(Facebook_Users$campaign_week, levels = c("Week 1", "Week 2", "Week 3", "Week 4", "Week 5", "Week 6", "Week 7", "Week 8", "Week 9", "Week 10", "Week 11", "Election Day"))


Input: Convert `candidate_page` from a character string to a factor with 3 levels.(Facilitates data visualization and data exploration). [CODESPLIT] Facebook_Users$candidate_page <- factor(Facebook_Users$candidate_page, levels = c ("Harper", "Trudeau", "Mulcair"))


Input: Adds a new column to identify the Facebook page being `liked`. [CODESPLIT] Harper_User_Likes$partisanship <- "Conservative" Trudeau_User_Likes$partisanship <- "Liberal" Mulcair_User_Likes$partisanship <- "Social Democrat"


Input: Match partisan assignment from Facebook_User_Likes to the Facebook Users Dataset using `user_id`. [CODESPLIT] Facebook_Users$partisanship <- NA Facebook_Users$partisanship <- Facebook_User_Likes$partisanship[match(Facebook_Users$user_id, Facebook_User_Likes$user_id)]


Input: Convert `partisanship` from a character string to a factor with 3 levels.(Facilitates data visualization and data exploration). [CODESPLIT] Facebook_Users$partisanship <- factor(Facebook_Users$partisanship, levels = c ("Conservative", "Liberal", "Social Democrat"))


Input: split the data and transform it into integers [CODESPLIT] ARTE <- as.numeric(data[which(data$TV.Station == 'ARTE'),]$Rating) Degeto <- as.numeric(data[which(data$TV.Station == 'Degeto Film'),]$Rating)


Input: run the onesided ttest with alpha  0.1 [CODESPLIT] t.test(ARTE, Degeto, alternative = "greater", conf.level = 0.90)


Input: Create list of dataframes per country [CODESPLIT] countries <- unique(data8$cntry_full) index = 0 listofdfs <- list()


Input: Draw correlation plots [CODESPLIT] char.col<-c("#228822","#663388","#006688") groupn<-c(4,11,6,3) left<--8 top<-25 corrplot.mixed(cortabNB, upper = "ellipse",tl.pos="lt",tl.col=rep(char.col,groupn[1:3]),number.cex = .7) text(left,top,"Non-biological\nfathers",cex=1.2,pos=4) nc<-0.5 w<-16 tiff("Figure_S3_corr1.tif",width=w,height=2*w,units="cm",res=600,compression="lzw") par(mfrow=c(2,1)) corrplot.mixed(cortabNB, upper = "ellipse",tl.pos="lt",number.cex = nc,tl.col=rep(char.col,groupn[1:3])) text(left,top,"Non-biological\nfathers",cex=1.2,pos=4) corrplot.mixed(cortabPA, upper = "ellipse",tl.pos="lt",number.cex = nc,tl.col=rep(char.col,groupn[1:3])) text(left,top,"Partners",cex=1.2,pos=4) dev.off() tiff("Figure_S4_corr2.tif",width=w,height=2*w,units="cm",res=600,compression="lzw") par(mfrow=c(2,1)) corrplot.mixed(cortabLO, upper = "ellipse",tl.pos="lt",number.cex = nc,tl.col=rep(char.col,groupn[1:3])) text(left,top,"Sensitive\nperiod\nlog-odds",cex=1.2,pos=4) corrplot.mixed(cortabD, upper = "ellipse",tl.pos="lt",number.cex = nc,tl.col=rep(char.col,groupn[1:3])) text(left,top,"Relative\nsimilarity\nt value",cex=1.2,pos=4) dev.off()


Input: function to calculate proporiton of studies within each time period for continuous variables that were transformed in a cutoff   x  character string of the variable  name  character string of the name that will appear in the table  time  character string of the time period variable  method  either "chisq" or "fisher" depending on the type of the test wanted  [CODESPLIT] CAT<-function(x, name, time, method) { tabtot <- table(DATA[,x]) sumtot <- sum(tabtot) tabtime <- table(DATA[,x], DATA[,time]) sumtime <- apply(tabtime, 2, sum) proptot <- tabtot[2]/sum(tabtot) CItot <- exactci(tabtot[2], sum(tabtot), conf.level = 0.95) proptime <- tabtime[2,]/sumtime CItime <- map2(tabtime[2,], sumtime, function(x, y){exactci(x, y, conf.level = 0.95)}) propCItime <- map2(proptime, CItime, function(x,y){paste0(round(x*100,0)," (", round(y[["conf.int"]][1]*100,0),"-", round(y[["conf.int"]][2]*100,0),")")}) if(method == "fisher"){ p <- fisher.test(tabtime) } else if(method == "chisq"){ p<-chisq.test(tabtime) } N_propCItime <- NULL for(i in 1:length(propCItime)){ N_propCItime <- c(N_propCItime, c(sumtime[i], propCItime[[i]])) } res=c(name, sumtot, paste0(round(proptot*100,0)," (",round(CItot$conf.int[1]*100,0),"-", round(CItot$conf.int[2]*100,0),")"), N_propCItime, round(p$p.value[1],4)) return(res) }


Input: function to calculate overall effect size for death or readmission rates (output has results + model to do model checks)   var  character string of the variable to calculate the effect size for [CODESPLIT] rate_ES <- function(var){ dat <- na.omit(DATA[,c("number_follow_up", var)]) colnames(dat)<-c("Ni","Ei") dat_es <- escalc( xi= Ei, ni =Ni, data = dat, measure = "PLO", to="if0all")


Input: function to get weighted logistic regression with continuous X variable and proportion Y variable and ggplot showing the predicted relationship   x  X variable as character  y  Y variable as character  Xpred  vector of X values to get predictions for  labX  X label as character  labY  Y label as character  limY  axis limits for Y axis, vector of 2 values  title  plot title as character  ypos  y relative position of text with OR and pvalue  [CODESPLIT] wtlogis_plot <- function(NB, x, y, Xpred, labX, labY, limY, title, ypos, unit){ dat <- data.frame(count=as.integer(DATA[,y]), Ntot=DATA[,NB], t=DATA[,x]) %>% mutate(prop = count/Ntot, perc = prop*100, wt = log(Ntot), t_div = t/10) dat <- na.omit(dat)


Input: model with time divided by 10 to get OR for 10yr increment [CODESPLIT] timediv_mod <- glm(prop ~ t_div, family = "binomial", weights = wt, data = dat) ORdiv <- tidy(timediv_mod, conf.int = TRUE) %>% mutate(OR_CI = paste0(round(exp(estimate),2), " (", round(exp(conf.low),2),"-", round(exp(conf.high),2), ")"))


Input: function to get weighted linear regression with continuous X variable and continuous Y variable and ggplot showing the predicted relationship   x  X variable as character  y  Y variable as character  Xpred  vector of X values to get predictions for  labX  X label as character  labY  Y label as character  limY  axis limits for Y axis, vector of 2 values  title  plot title as character  ypos  y relative position of text with OR and pvalue  [CODESPLIT] wtlin_plot <- function(NB, x, y, Xpred, labX, labY, limY, title, ypos, unit){ dat <- data.frame(y=as.integer(DATA[,y]), Ntot=DATA[,NB], t=DATA[,x]) %>% mutate(wt = log(Ntot), t_div = t/10) dat <- na.omit(dat)


Input: function to get OR and CI from the model with 10 year increment   obj  model with x variable divided by 10  p  pvalue from the LRT [CODESPLIT] OR_div <- function(obj, p){ OR_CI <- paste0(round(exp(obj$beta[2]),2), " (", round(exp(obj$ci.lb[2]),2),"-", round(exp(obj$ci.ub[2]),2), ")") pval_clean <- ifelse(p[["pval"]] < 0.001, "p<0.001", paste0("p=",round(p[["pval"]],3))) OR_p <- c(OR_CI, p, pval_clean) return(OR_p) }


Input: function to get metaregression model with continuous X variable and proportion Y variable and ggplot showing the predicted relationship   x  X variable as character  y  Y variable as character  Xpred  vector of X values to get predictions for  labX  X label as character  labY  Y label as character  limY  axis limits for Y axis, vector of 2 values  title  plot title as character  ypos  y relative position of text with OR and pvalue  [CODESPLIT] MA_prop_plot <- function(NB, x, y, Xpred, labX, labY, limY, title, ypos){ prop_dat <- na.omit(DATA[,c(NB, y, x)]) colnames(prop_dat)<-c("Ni","Ei","X") prop_dat$prop <- (prop_dat$Ei/prop_dat$Ni) * 100 prop_dat$X_div <- prop_dat$X/10 es_prop_dat <- escalc( xi= Ei, ni =Ni, data = prop_dat, measure = "PLO", to="if0all")


Input: function to get OR for subgroup variables with 2 categories   x  character string for the x variable  y  character string for the y variable  group  chracter string for the group variable  newref  character string for the level of the group variable that is not the reference level [CODESPLIT] OR_group_fun <- function(x, y, group, newref){ OR_data <- data.frame(Group = rep(NA,2), N = rep(NA,2), OR = rep(NA,2), lowCI = rep(NA,2), upCI = rep(NA,2), p = rep(NA,2), I2 = rep(NA,2)) group_dat <- na.omit(DATA[,c("number_follow_up", y, x, group)]) colnames(group_dat)<-c("Ni","Ei","X","group") group_dat$X_div <- group_dat$X/10 OR_data$Group <- levels(group_dat$group) OR_data$N <- as.integer(table(group_dat$group)) es_group_dat <- escalc( xi= Ei, ni =Ni, data = group_dat, measure = "PLO", to="if0all") inter_mod1 <- rma(yi=yi,mods = ~ X_div * group, vi=vi, data=es_group_dat, method = "REML") inter_mod2 <- rma(yi=yi,mods = ~ X_div * I(relevel(group, newref)) , vi=vi, data=es_group_dat, method = "REML")


Input: function to get metaregression model with continuous X1 and X2 variables and 2 group variables and proportion Y variable and ggplot showing the predicted relationship with x1 for a median value of x2   x1  X1 variable as character  x2  X2 variable as character  group1  group1 variable (2level factor) as character  group2  group2 variable (2level factor) as character  y  Y variable as character  x1pred  vector of values for which to predict x1  x2val  median value of X2 for which to get predictions  labX  X label as character  labY  Y label as character  limY  axis limits for Y axis, vector of 2 values  title  plot title as character  ypos  y relative for text of OR and pvalue  [CODESPLIT] MA_prop_plot_adj <- function(NB, x1, x2, group1, group2, y, x1pred, x2val, labX, labY, limY, title, ypos){ prop_dat <- na.omit(DATA[,c(NB, y, x1, x2, group1, group2)]) colnames(prop_dat)<-c("Ni","Ei","X1", "X2", "group1", "group2") prop_dat$prop <- (prop_dat$Ei/prop_dat$Ni) * 100 prop_dat$X1_div <- prop_dat$X1/10 es_prop_dat <- escalc( xi= Ei, ni =Ni, data = prop_dat, measure = "PLO", to="if0all")


Input: rayleigh_test   Rayleigh test for the uniformity of directional data,  as described by Mardia et al. (1979: chapter 15) and Mardia & Jupp (1999)  Note that there would probably be better alternatives on CRAN  [CODESPLIT] rayleigh_test <- function(X, correction = TRUE, check = TRUE, convert = TRUE) { if(check) { if(!isTRUE(all.equal(diag(tcrossprod(X)), 1))) { if(convert) { X / sqrt(diag(tcrossprod(X))) warning("X was converted into directional data") } else { stop("Directional data (in coordinates) are assumed as X") } } } p <- ncol(X) n <- nrow(X) Mean <- colMeans(X) Norm_Mean_2 <- drop(crossprod(Mean)) S <- p * n * Norm_Mean_2 if(correction) { S <- S * (1 - 1 / 2 / n) + S ^ 2 / (2 * n * (p + 2)) } P_value <- pchisq(S, p, lower.tail = FALSE) list(Norm_Mean = sqrt(Norm_Mean_2), n = n, p = p, Statistics = S, P_value = P_value) }


Input: Compute ICC  run null/unconditional model and use intercept and residual variances to solve for ICC (i.e., Intercept Variance / (Intercept Variance + Residual Variance))  [CODESPLIT] Model.Null <- lmer(VerbPhysAggSum ~ 1 + (1 | ID), data = LineBisectionStudy) summary(Model.Null) ICC <- (18.69/(18.69+7.76)) print(ICC)


Input: Function to extract legend (from: https://gist.github.com/crsh/be88be19233f1df4542aca900501f0fbfilegglegendrL7)  otherwise plots without tracks would have no legend [CODESPLIT] gglegend <- function(x){ tmp <- ggplot_gtable(ggplot_build(x)) leg <- which(sapply(tmp$grobs, function(y) y$name) == "guide-box") tmp$grobs[[leg]] } legend = gglegend(gi)


Input: define function doing the bootstrap: [CODESPLIT] boot.fun<-function(x, xcall., data., rv.name., m., discard.non.conv., save.path., extract.all.){ xdone=F while(!xdone){ done2=F while(!done2){ data.[, rv.name.]=simulate(object=m.)[, 1] if(xcall[["xfam"]][["family"]]!="beta" | (xcall[["xfam"]][["family"]]=="beta" & min(data.[, rv.name.])>0 & max(data.[, rv.name.])<1)){ done2=T } } i.res=try(update(m., data=data.), silent=T)


Input: prepare model frame for conditional model for prediction: [CODESPLIT] model=attr(terms(as.formula(xcall[["cond.form"]])), "term.labels") model=model[!grepl(x=model, pattern="|", fixed=T)] if(length(model)==0){model="1"} cond.m.mat=model.matrix(object=as.formula(paste(c("~", paste(model, collapse="+")), collapse="")), data=new.data) if(set.circ.var.to.zero){ cond.m.mat[,paste(c("sin(", circ.var.name, ")"), collapse="")]=0 cond.m.mat[,paste(c("cos(", circ.var.name, ")"), collapse="")]=0 }


Input: Function that draws any bellcurve in the form and shape as the ones used in the paper [CODESPLIT] docurve<-function( sd=2, dist=1, xcent=10, ycent=0.6, paroff=0.15, offoff=0.1, percoff=0.06, percoff2=0.03, thresh.vis=0.01, bellims=15, botlims=8, pardown=0.01, xoff=0, par.col="#0097BD", off.col="#FF0066", off.in.col="#FF0066", off.out.col="#FF6600", fading="33", col.bot="#555555", lwd.par=1.2, lwd.bot=1.2){ off.in.col2<-paste(off.in.col,fading,sep="") off.out.col2<-paste(off.out.col,fading,sep="") p1<-xcent-dist/2 p2<-xcent+dist/2 c1<-gen.curve(sd,average=0,bellims=bellims) polygon(replast(c1[[1]][c1[[1]]<(-dist/2)])+xcent,c(c1[[2]][c1[[1]]<(-dist/2)],0)+ycent,col=off.out.col2,border=NA) polygon(repfirst(c1[[1]][c1[[1]]>(dist/2)])+xcent,c(0,c1[[2]][c1[[1]]>(dist/2)])+ycent,col=off.out.col2,border=NA) polygon(repboth(c1[[1]][c1[[1]]>=(-dist/2)&c1[[1]]<=(dist/2)])+xcent,c(0,c1[[2]][c1[[1]]>=(-dist/2)&c1[[1]]<=(dist/2)],0)+ycent,col=off.in.col2,border=NA) lines(c(xcent-botlims,xcent+botlims),c(ycent,ycent),col=col.bot,lwd=lwd.bot) lines(c(p1,p1),c(ycent-pardown,ycent+paroff),col=par.col,lwd=lwd.par) lines(c(p2,p2),c(ycent-pardown,ycent+paroff),col=par.col,lwd=lwd.par) outprob<-sum(c1[[2]][c1[[1]]>dist/2])/sum(c1[[2]]) inprob<-sum(c1[[2]][c1[[1]]<=dist/2&c1[[1]]>=-dist/2])/sum(c1[[2]]) offtail<-mean(c(c1[[1]][c1[[1]]>dist/2][1], c1[[1]][c1[[1]]>dist/2][!(c1[[2]][c1[[1]]>dist/2]>thresh.vis)][1])) text(xcent,ycent+percoff,paste(round(inprob*100),"%",sep=""),col=off.in.col,cex=0.8) text(c(xcent-offtail,xcent+offtail)+c(-1,1)*xoff,ycent+percoff2,paste(round(outprob*100),"%",sep=""),col=off.out.col,cex=0.8) text(c(p1,p2),ycent+paroff,c(expression(t[p[1]]),expression(t[p[2]])),pos=3,col=par.col,offset=0.15) }


Input: loglikelihood for each subject using their mean parameter vector [CODESPLIT] mean_pars_ll <- numeric(ncol(mean_pars)) data <- transform(sampled$data, subject = match(subject, unique(subject))) for (j in 1:nsubj) { mean_pars_ll[j] <- sampled$ll_func(mean_pars[j, ], data = data[data$subject == j,], sample = FALSE) }


Input: Create the plots and populate them. The yaxt  "n" serves to remove axis labels from the yaxis while the axis function serves to add axis labels in line with APS standards for graph publication. The lines and points functions add the connecting lines and symbols to the graphs. We repeat the process three times to create the three graphs corresponding to different values of tau.  [CODESPLIT] plot(k, end.data.cov[ ,1], type = "l", ylab = "Coverage", main = "A: Tau = 0.2", yaxt = "n", ylim = c(0.9, 1),xlab = expression("Number of Studies " (italic(k)))) axis(side = 2, at = c(0.92,0.94,0.96,0.98,1),labels = c(".92",".94",".96",".98","1.0")) points(k, end.data.cov[ ,1], pch = 0) lines(k, end.data.cov[ ,2]) points(k, end.data.cov[ ,2], pch = 3) lines(k, end.data.cov[ ,7]) points(k, end.data.cov[ ,7], pch = 5) lines(k, end.data.cov[ ,14]) points(k, end.data.cov[ ,14], pch = 4) legend("bottomright", c("bWT-DL","bWT-REML", "bWT-HE", "Sub-Q"), pch = c(0,5,4,3), cex = 0.9, ncol = 2) plot(k, end.data.cov[ ,3], type = "l", ylab = "Coverage", main = "B: Tau = 0.4", yaxt = "n", ylim = c(0.9, 1),xlab = expression("Number of Studies " (italic(k)))) axis(side = 2, at = c(0.92,0.94,0.96,0.98,1),labels = c(".92",".94",".96",".98","1.0")) points(k, end.data.cov[ ,3], pch = 0) lines(k, end.data.cov[ ,4]) points(k, end.data.cov[ ,4], pch = 3) lines(k, end.data.cov[ ,9]) points(k, end.data.cov[ ,9], pch = 5) lines(k, end.data.cov[ ,17]) points(k, end.data.cov[ ,17], pch = 4) legend("bottomright", c("bWT-DL","bWT-REML", "bWT-HE", "Sub-Q"), pch = c(0,5,4,3), cex = 0.9, ncol = 2) plot(k, end.data.cov[ ,5], type = "l", ylab = "Coverage", main = "C: Tau = 0.6", yaxt = "n", ylim = c(0.9, 1),xlab = expression("Number of Studies " (italic(k)))) axis(side = 2, at = c(0.92,0.94,0.96,0.98,1),labels = c(".92",".94",".96",".98","1.0")) points(k, end.data.cov[ ,5], pch = 0) lines(k, end.data.cov[ ,6]) points(k, end.data.cov[ ,6], pch = 3) lines(k, end.data.cov[ ,11]) points(k, end.data.cov[ ,11], pch = 5) lines(k, end.data.cov[ ,20]) points(k, end.data.cov[ ,20], pch = 4) legend("topright", c("bWT-DL","bWT-REML", "bWT-HE", "Sub-Q"), pch = c(0,5,4,3), cex = 0.9, ncol = 2)


Input: Define the initial column name for x/y coordinates you want to use [CODESPLIT] xy_columns = list( x = "GazePointX (ADCSpx)", y = "GazePointY (ADCSpx)" ),


Input: compute cutoff for guessing by taking the 99% quantile from the binomial distribution (given by guessing probability and number of tests) [CODESPLIT] mutate(guessing_probability = 1/19, cut_off = qbinom(p = .99, size = number_tests, prob = guessing_probability)/number_tests, guessing_check = ifelse(mean_acc > cut_off, TRUE, FALSE)) %>% group_by(participant_id, condition) %>% summarize(guessing_check =  as.logical(min(guessing_check))) %>% ungroup()


Input: split the data into different data frames depending on the intended analysis   create dataframe with data on the hebb effect for the main analysis of the learning data [CODESPLIT] data_hebb_task = data_filtered %>% filter(phase == "WM") %>% select(participant_id, condition, phase, block, trial_number, hebb_trial, presentation_order:duration) %>% ungroup()


Input: check cluster agreement using hierarchical clustering on raw items instead of factors [CODESPLIT] HCheck.HClusterD <- dist(EFA.mainData[, c(2:56)], method = "euclidean") HCheck.HClusterFit <- hclust(HCheck.HClusterD, method="ward.D2") HCheck.HCluster <- cutree(HCheck.HClusterFit, k = 3) HCheckCluster <- data.frame(Factor = HCluster, Item = HCheck.HCluster) HCheckCluster <- cbind(HCheckCluster, ifelse(HCheckCluster[1] == HCheckCluster[2], 1, 0)) colnames(HCheckCluster)[3] <- 'Agreement' HCheckClusterAgreement <- HCheckCluster[, c(2:3)] %>% group_by(Item) %>% summarise(total = n(), n_agree = sum(Agreement))  %>% rename(Cluster = Item)


Input: create dataframe with factor scores and cluster membership [CODESPLIT] KClusterScores <- cbind(EFA.mainData[, c(111:116)], KClusterFit$cluster) colnames(KClusterScores)[7] <- "KCluster"


Input: testing homogeneity of variance in factors [CODESPLIT] KClusterScores %>% pivot_longer(c(Sensory, CognitiveDemand, ThreatToSelf, CrossSettings, Safety, States), names_to = c("Factor")) %>% group_by(Factor) %>% levene_test(value ~ as.factor(KCluster))


Input: univariate Welch's ANOVA test with Bonferroni correction [CODESPLIT] table1 <- KClusterScores %>% pivot_longer(c(Sensory, CognitiveDemand, ThreatToSelf, CrossSettings, Safety, States), names_to = c("Factor")) %>% mutate(Factor = factor(Factor, levels = c("Sensory", "CognitiveDemand", "ThreatToSelf", "CrossSettings", "Safety", "States"))) %>% group_by(Factor) %>% welch_anova_test(value ~ as.factor(KCluster)) %>% adjust_pvalue(method = "bonferroni")


Input: manually calculating omega squared and adjusted confidence intervals for each test [CODESPLIT] table1$omegasq <- apply(table1, 1, function(x) omega.F(as.numeric(x[5]), as.numeric(x[6]), as.numeric(x[4]), as.numeric(x[3]), 0.05/6)$omega) table1$omegalow <- apply(table1, 1, function(x) omega.F(as.numeric(x[5]), as.numeric(x[6]), as.numeric(x[4]), as.numeric(x[3]), 0.05/6)$omegalow) table1$omegahigh <- apply(table1, 1, function(x) omega.F(as.numeric(x[5]), as.numeric(x[6]), as.numeric(x[4]), as.numeric(x[3]), 0.05/6)$omegahigh)


Input: Linear mixed effect model (accuracy) [CODESPLIT] LDTnonword_ACC_LME = glmer(accuracy ~ DISHARc + (1+DISHARc|item) + (1|subject), data = byTrial, family=binomial, control=glmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) summary(LDTnonword_ACC_LME)


Input: Estimate d from t and df [CODESPLIT] dest <-function (t,df) { r2 <- (t^2) / (t^2 + df) d.est <- (2*(r2^.5)) / (1-r2) }


Input: Stimuli categorized according to a multinomial distribution [CODESPLIT] y[i,] ~ dmulti(r[i,], t[i]) predy[i,1:ncat] ~ dmulti(r[i,], t[i]) }


Input: Denominator is just the sum of the numerator values [CODESPLIT] denominator[i] = sum(numerator[i,]) }


Input: annotate lines so that each  has a unique id for ggplot overplotting  (else two lines from the same draw but  different replicates can get confused  with each other) [CODESPLIT] func_samples_surface <- func_samples_surface %>% mutate(line_id = as.numeric(rownames(func_samples_surface))) func_samples_aer <- func_samples_aer %>% mutate(line_id = as.numeric(rownames(func_samples_aer)))


Input: cross product decay_rates with x (time) values  and calculate y (titer) values [CODESPLIT] cat('setting up x values...\n') to_plot_surface <- func_samples_surface %>% crossing(surface_plot_times) to_plot_aer <- func_samples_aer %>% crossing(aer_plot_times) to_plot_surface <- to_plot_surface %>% mutate(predicted_titer = 10^(intercept - decay_rate * time)) to_plot_aer <- to_plot_aer %>% mutate(predicted_titer = convert_mL_media_to_L_air * 10^(intercept - decay_rate * time)) max_nonzero_time <- to_plot_surface %>% filter(log10(predicted_titer) > lowest_log_titer) %>% select(time) %>% max() surface_xlim <- c(0, max_nonzero_time) aer_xlim <- c(0, aer_max_x) print(aer_xlim) aer_jitwid <- 3/100 fit_panel_surface <- to_plot_surface %>% ggplot(aes( x = time, y = predicted_titer, color = virus, group = line_id)) + geom_line(alpha = line_alpha, size = line_size) + scale_colour_manual(values = unlist(virus_colors)) + geom_point(aes(x = time, y = 10^(log10_titer), group = trial_unique_id), data = surface_dat, color = pointborder, fill = pointfill, alpha = pointalpha, size = pointsize, stroke = pointstroke, position = position_jitter( width = jitwid, height = jith, seed = 5)) + geom_hline( data = experiment_dat_virus_surface, aes(yintercept = detection_limit), linetype = detection_linestyle, size = detection_linesize) + scale_y_continuous(trans = ytrans, breaks = ybreaks, labels = yformat) + coord_cartesian(ylim = surface_ylim, xlim = surface_xlim) + facet_grid(vars(virus), vars(material), drop = TRUE)


Input: group adjustment for sigma with prior 0,0.1 for the beta  [CODESPLIT] ACT.BF.sigma.prior01 <- stan(data=ACT.data,file="./BayesFactor/models/ACT/ACT.BF.sigma.prior01.stan", iter=40000, warmup =1000, chains=3,control = list(adapt_delta = 0.9)) ACT.BF.sigma.prior01.bridge <- bridge_sampler(ACT.BF.sigma.prior01) saveRDS(ACT.BF.sigma.prior01.bridge, "./BayesFactor/marginal_lik/ACT/ACT.BF.sigma.prior01.rds") DA.BF.sigma.prior01 <- stan(data=DA.standata,file="./BayesFactor/models/DA/DA.BF.sigma01.stan", iter=40000, warmup =1000, chains=3) DA.BF.sigma.prior01.bridge <- bridge_sampler(DA.BF.sigma.prior01) saveRDS(DA.BF.sigma.prior01.bridge, "./BayesFactor/marginal_lik/DA/DA.BF.sigma.prior01.rds")


Input: increase in rsq when using elastic net with items instead of linear regression with sum scores (without covariates) [CODESPLIT] tab_delta_rsq <- merge(tab[learner.id == "elastic net" & predictors == "items" & control == "excluded", .(elasticnet_items = rsq.test.mean), by = c("target", "design")], tab[learner.id == "linear regr" & predictors == "sum scores" & control == "excluded", .(linearregr_sumscores = rsq.test.mean), by = c("target", "design")]) tab_delta_rsq[, .(mean_delta_rsq = mean(elasticnet_items - linearregr_sumscores)), by = "design"]


Input: Calculate Cohen's d_z [CODESPLIT] return_Cohen_d_z <- function(variable_1, variable_2){ mean_differences <- mean(variable_1) - mean(variable_2) sd_var1 <- sd(variable_1) sd_var2 <- sd(variable_2) cor_var1_var2 <- cor(variable_1, variable_2) Cohen_d_z <- abs(mean_differences) / sqrt( (sd_var1 ^ 2) + (sd_var2 ^ 2) - (2 * sd_var1 * sd_var2 * cor_var1_var2) ) return(Cohen_d_z) }


Input: visualizing the data add +scale_x_discrete(guide  guide_axis(angle  45)) to the plot to change the angle of the lables on the X axis [CODESPLIT] ggplot(mydata_p6_la, aes(x = Condition, y = Voltage)) + geom_boxplot() + facet_grid(.~ Specificity,)+ scale_x_discrete(guide = guide_axis(angle = 45)) ggplot(mydata_p6_ra, aes(x = Condition, y = Voltage)) + geom_boxplot() + facet_grid(.~ Specificity,)+ scale_x_discrete(guide = guide_axis(angle = 45)) ggplot(mydata_p6_lp, aes(x = Condition, y = Voltage)) + geom_boxplot() + facet_grid(.~ Specificity,)+ scale_x_discrete(guide = guide_axis(angle = 45)) ggplot(mydata_p6_rp, aes(x = Condition, y = Voltage)) + geom_boxplot() + facet_grid(.~ Specificity,)+ scale_x_discrete(guide = guide_axis(angle = 45))


Input: fill output matrix with the calculated social measure [CODESPLIT] socialmeasures[,3] <- measure1 socialmeasures[,4] <- measure2 socialmeasures[,5] <- measure3 socialmeasures[,6] <- measure4 socialmeasures[,7] <- measure5 socialmeasures[,8] <- measure6 socialmeasures[,10] <- measure8 socialmeasures[,11] <- measure9 socialmeasures[,12] <- measure10 socialmeasures[,3] <- measure1 socialmeasures[,4] <- measure2 socialmeasures[,5] <- measure3 socialmeasures[,6] <- measure4 socialmeasures[,7] <- measure5 socialmeasures[,8] <- measure6 socialmeasures[,10] <- measure8 socialmeasures[,11] <- measure9 socialmeasures[,12] <- measure10


Input: 7 calculate the AVERAGE SHORTEST PATH of each node of the matrix [CODESPLIT] measure7 <- mean_distance(graphN, directed = TRUE, unconnected = TRUE) print(measure7) measure7 <- mean_distance(graphN, directed = TRUE, unconnected = TRUE) print(measure7)


Input: Add Age Bins  This acts to help preserve privacy and allows easy plotting:     e.g., ggplot(Data, aes(x  Agebins) ) + geom_bar()  [CODESPLIT] Agebin = c('< 20', '20-29', '30-39','40-49','50-59','60-69','70-79','80+') Data %<>% mutate(Agebins = case_when( Age  < 20 ~ Agebin[1], Age >= 20 & Age < 30 ~ Agebin[2], Age >= 30 & Age < 40 ~ Agebin[3], Age >= 40 & Age < 50 ~ Agebin[4], Age >= 50 & Age < 60 ~ Agebin[5], Age >= 60 & Age < 70 ~ Agebin[6], Age >= 70 & Age < 80 ~ Agebin[7], Age >= 80  ~ Agebin[8] ) ) %>% apply_labels(Agebins = c('< 20' = 1, '20-29' = 2, '30-39' = 3, '40-49' = 4,'50-59' = 5,'60-69' = 6, '70-79' = 7,'80+' = 8)) Agebin = c('< 20', '20-29', '30-39','40-49','50-59','60-69','70-79','80+') Data %<>% mutate(Agebins = case_when( Age  < 20 ~ Agebin[1], Age >= 20 & Age < 30 ~ Agebin[2], Age >= 30 & Age < 40 ~ Agebin[3], Age >= 40 & Age < 50 ~ Agebin[4], Age >= 50 & Age < 60 ~ Agebin[5], Age >= 60 & Age < 70 ~ Agebin[6], Age >= 70 & Age < 80 ~ Agebin[7], Age >= 80  ~ Agebin[8] ) ) %>% apply_labels(Agebins = c('< 20' = 1, '20-29' = 2, '30-39' = 3, '40-49' = 4,'50-59' = 5,'60-69' = 6, '70-79' = 7,'80+' = 8))


Input: ChiSquared  Gender create dataframe of gender and cluster membership, then exclude participant with 'Other' as response to analyse with Chisquared test  [CODESPLIT] data.OtherExcluded <- demographics %>% select(Gender, KCluster) %>% filter(Gender != 'Other') data.OtherExcluded$Gender <- droplevels(data.OtherExcluded$Gender)


Input: posthoc pairwise Chisquared with Bonferroni correction [CODESPLIT] pairwiseNominalIndependence(ASD.contable, compare = "row", fisher  = FALSE, gtest   = FALSE, chisq   = TRUE, method  = "bonferroni", digits  = 3)


Input: compile parameter estimates and fit of population ODE/SDE models [CODESPLIT] modt <- readRDS("PSM_transits_ODE.RDS") mods <- readRDS("PSM_population_ODE.RDS") i <- length(mods) pars <- c(round(modt[[4]]$THETA,1), "OMEGA_stress"=1.5, "OMEGA_ke"=.05, "OMEGA_kt"=.15, "OMEGA_init"=.15) pars[c("init","sigma")] <- c(.001,.001) parA <- list(LB=pars*.2, Init=pars, UB=pars*2.5) #bounds + inits npars <- Vectorize(function(x) sum(parA$Init != round(mods[[x]]$THETA,3)))(1:i) res <- Vectorize(function(x) round(mods[[x]]$THETA,3))(1:i) #parameter estimates for each fitted model res <- rbind(res, "Mtt"= Vectorize(function(x) round(4/mods[[x]]$THETA["kt"],3))(1:i)) #add mean transit time for each model res <- rbind(res, "LL"= -Vectorize(function(x) mods[[x]]$NegLogL)(1:i)) res <- rbind(res, "AIC"= 2*npars +2*Vectorize(function(x) mods[[x]]$NegLogL)(1:i)) res <- rbind(res, "R2"= Vectorize(function(x) 1 - mods[[x]]$THETA["S"]/var(PKdata$DV))(1:i)) colnames(res) <- letters[1:i] print(res)


Input: define a fixed grid of cutoff (threshold) values from [1, 0] with length `resolution`  [CODESPLIT] resolution <- 500 cutoff_out <- seq(1, 0, length.out = resolution) resolution <- 500 cutoff_out <- seq(1, 0, length.out = resolution)


Input: Compute F1 skill score... ' ...for a given cutoffthreshold. ' @param sim vector of numeric values between [0, 1] (e.g., proportion of unstable grid points) ' @param obs vector of logicals (TRUE/FALSE) stating whether the layer was observed (of concern) or not. ' @param cutoff in percentage within (0, 1] ' @return numeric value of skill score ' @export  [CODESPLIT] calculateF1Score <- function(sim, obs, cutoff) { tp <- length(sim[sim >= cutoff & obs]) fn <- length(sim[sim < cutoff & obs]) fp <- length(sim[sim >= cutoff & !obs]) f1 <- 2*tp / (2*tp + fp + fn) return(f1) }


Input: Underscore split: split up the "variable" column in order to get the different factors (verbtype, input, moment)  [CODESPLIT] participantsdata.long <- cbind(participantsdata.long, colsplit(participantsdata.long$variable, "_", names = c("verbtype", "input", "testmoment")))


Input: LDA  training the model [CODESPLIT] model_lda = train(class ~ ., data=trainSet, method='lda', trControl = trainControl(method = "cv")) fitted <- predict(model_lda)


Input: function to extract the sequence "Obj_xxx" untile a period "." appears  [CODESPLIT] slice_object_string <- function(string) { gsub(".*Obj_(.*)\\..*", "\\1", c(string)) } familiar_objects <- unlist(lapply(string_list, slice_object_string))


Input: ChiSquare tests Relations between diet type and major themes [CODESPLIT] chisq.test(data$Diet, data$Health) #p = 0.94, chi-squared = 0.01 chisq.test(data$Diet, data$Food) #p = 0.44, chi-squared = 0.59 chisq.test(data$Diet, data$Social) #p = 0.80, chi-squared = 0.06 chisq.test(data$Diet, data$Logistic) #p = 0.17, chi-squared = 1.90 chisq.test(data$Diet, data$Finance) #p = 0.06, chi-squared = 3.61 chisq.test(data$Diet, data$Motivat.) #p = 0.76, chi-squared = 0.10 chisq.test(data$Diet, data$Diet.Cons.) #p = 0.05, chi-squared = 3.97 chisq.test(data$Diet, data$Other) #p = 1, chi-squared = 8.90e-29 chisq.test(data$Diet, data$Positive) #p = 0.16, chi-squared = 1.94


Input: Hypotheses   Fit multivariate regression model [CODESPLIT] moltenformula <- as.formula("value ~ v - 1 + v:scipopgoertz + v:age + v:sex + v:lingreg_D + v:lingreg_I + v:urbanity_log + v:edu_uni + v:edu_com + v:sciprox_score + v:sciliteracy + v:rel + v:pol + v:inter_science + v:trust_science + v:trust_scientists + v:scimedia_att + v:scimedia_sat") m_inx <- svyglm(moltenformula, design = svydsgn_melt_inx)


Input: estimate bifactor model (maximum likelihood) [CODESPLIT] fit <- cfa(model, dat,estimator = "MLM", std.lv = TRUE)


Input: draw random factor scores from a multivariate normal distribution [CODESPLIT] lat_scores <- mvrnorm(n = n, mu = mu, Sigma = sigma)


Input: function to create data summaries in figures [CODESPLIT] data_summary <- function(x) { m <- mean(x) ymin <- m-ci(x) ymax <- m+ci(x) return(c(y=m,ymin=ymin,ymax=ymax)) }


Input: to get numbers for confidence intervals click on item in global environment and expand plot 95% credible intervals [CODESPLIT] x<-plot(me, plot = FALSE)[[1]] + scale_color_grey() + scale_fill_grey() p<-x+ylim(0,1)+ theme(panel.grid.major = element_line(colour="gray"), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_blank(),panel.grid.major.x = element_blank())+xlab("")+ylab("") p


Input: 1  Never, 2  I tried it but don't do it systematically, 3  I do it when it feels convenient, 4  I do it for most research projects/studies, 5  I do it for every research project/study.  Make dataframe 'Wish' with intentions to engage in open science practices  [CODESPLIT] wish = data[, 17:25] wish_complete = wish[,-9] # remove missing data wish = apply(wish, 2, as.numeric) wish = as.data.frame(unlist(wish)) colnames(wish) = c("preregister", "sharedatas", "sharecode", "openaccess", "preprint", "openpeer", "opensw", "replicate", "other") wish = t(wish) rowMeans(wish, na.rm = T) # mean apply(wish, 1, sd, na.rm = T) # standard deviation


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


Input: 2.3 Loss tangents   We draw a diagram of loss tangents with logarithmic scale on the xaxis [CODESPLIT] plot(graphData$Freq[graphData$site == "wreck"], graphData$tan[graphData$site == "wreck"], log = "x", axes = FALSE, xlab = "", ylab = "", type = "b", pch = PCH, col = col_wreck, xlim = c(0.01, 100), ylim = c(0, 15)) par(new = TRUE, ps = PS, mar = MAR) plot(graphData$Freq[graphData$site == "beach"], graphData$tan[graphData$site == "beach"], type = "b", log = "x", xlab = expression("Frequency [rad s"^-1 *"]"), ylab = expression(paste("tan ", delta)), pch = PCH, col = col_beach, axes = FALSE, xlim = c(0.01, 100), ylim = c(0, 15)) axis(1, at = c(0, 0.1, 1, 10, 100, 1000), labels = c(0, 0.1, 1, 10, 100, 100)) axis(2, at = c(-1 , 0, 3, 6, 9, 12, 15)) text(x = 0.01, y = 15, label = expression(bold("c"))) abline(1, 0)


Input: estimate mean average difference between observed and corrected values   check for sign reversals [CODESPLIT] dat_analysis[sign(MA_ES_self_corr) == sign(MA_ES_self_obs), .N] # 46 (no sign rev)


Input: Step 3: Fit varyingintercept ESEM model [CODESPLIT] esem_anti_fit_alt1F <- cfa(esem_anti_model_alt1F, esem_anti_data_alt, group = "country_iso", estimator = "MLM", group.equal = "loadings")


Input: performing the chisquared comparisons across all the possible pairs [CODESPLIT] pairwise.table(chi_squared_paired_comparison_1, rownames(hypotheses_per_research_area), p.adjust.method="none") pairwise.table(chi_squared_paired_comparison_2, rownames(hypotheses_per_research_area), p.adjust.method="none")


Input: chi squared test of criteria met by association type [CODESPLIT] f_statistic <- chisq.test(data_hypotheses_long$association_type, data_hypotheses_long$reporting_criteria_met) f_statistic


Input: Hastags   wordcloud of most common hashtags [CODESPLIT] frequenthashes <- hashtable[hashtable>floor(quantile(hashtable,.999))] hashvec <- unlist(lapply(frequenthashes,function(x) rep(names(x),x))) stretched <- log10(frequenthashes-min(frequenthashes)+1)/max(log10(frequenthashes-min(frequenthashes)+1)) cols <- rgb(1- stretched,0,0) png("hashcloud.png",width = 12,heigh=12,units = "cm",res=300) wordcloud(names(frequenthashes),frequenthashes,random.order = F,colors=cols) dev.off()


Input: Fit the model using unweighted least square (ULS) [CODESPLIT] m1.fit <- sem( m1, sample.cov = S, sample.nobs = 200, estimator = "ULS")


Input: Remove items that do not occur in the country [CODESPLIT] items <- items[items$item %in% colnames(x_country), ]


Input: multilevel model (repeated measures) correlation using package rmcorr: [CODESPLIT] td_corr <- rmcorr(subject, trust, distrust, td) td_corr


Input: Robust growth model MLR estimator [CODESPLIT] rctBoot <- growth(rctModel, data=rctWide, se = "bootstrap") summary(rctBoot) rctMLR <- growth(rctModel, data=rctWide, estimator = "MLR") summary(rctMLR)


Input: create a scatterplot of sleep quality and insomnia scores (FIRST). Add appropriate labels [CODESPLIT] plot(Sleep_and_COVID19$PSQI_global, Sleep_and_COVID19$FIRST, main = "Main title", xlab = "X axis title", ylab = "Y axis title", frame = FALSE)


Input: 4) Ttest    Examine whether there is a significant difference in sleep quality in those who may have symptoms or been diagnosed with COVID [CODESPLIT] t.test(PSQI_global ~ SymptomsOrPositive, data = Sleep_and_COVID19)


Input: Examine whether there is a significant difference in mean sleep difficulty scores in those who undertake shiftwork [CODESPLIT] t.test(PSQI_global ~ ShiftWork, data = Sleep_and_COVID19) ?t.test


Input: 6) Regression Analysis    Using multiple regression analysis, examine the influence of the age, hours worked, physical health, coffee drank  alertness and insomnia proneness on sleep quality  [CODESPLIT] model1 <- lm(PSQI_global ~ Age + WorkHour + Health + CoffeeToday + StanfordSleepinessScale + FIRST,  data = Sleep_and_COVID19) summary(model1)


Input: Draw samples setting heart_rate_traj above as mean with appropriate constant variance (10 beats/min) [CODESPLIT] heart_rate <- rnorm(n = length(heart_rate_traj), mean = heart_rate_traj, sd = 10)


Input: Computing pvalues based on the Fdistribution [CODESPLIT] p_durable <- pf(q=Femp_durable, df1=Df_aest_durable, df2=Df_residual, lower.tail = F) p_nond <- pf(q=Femp_nond, df1=Df_aest_nond, df2=Df_residual, lower.tail = F)


Input: Logistic Regression Model  Creating null model and a logistic regression model based on all variables [CODESPLIT] lr.null <- glm(Treatment ~ 1, data = dat2, family = binomial(link="logit")) lrm <- glm(Treatment ~ Sq + Ssk + Sku + Sp + Sv + Sz + Sa,data = dat2, family = binomial(link="logit")) summary(lrm)


Input: Filter and select variables of interest [CODESPLIT] d <- d_2011 %>% subset(sns == 1) %>% # indicated to use social media subset(!is.na(beh_disclose_soc)) %>% select(id, country, year, gender, age, cons_record, cons_zweck, cons_target, contains("soc"), v143:v156, # beh_setting, int_home, int_work, sns, nth_arg) %>% mutate(cons_mean = (cons_record + cons_zweck + cons_target)/3, cons_mean_bin = ifelse(cons_mean > median(cons_mean, na.rm = T), 1, ifelse(is.na(cons_mean), NA, 0))) %>% mutate(age_group = ifelse(age <= 32, "younger than 32 years", "older than 32 years"))


Input: Confirmatory factor analyses  CFA for privacy concerns (tauequivalent) [CODESPLIT] cfa.model <- " priv_con =~ 1*cons_record + 1*cons_zweck + 1*cons_target " fit <- cfa(cfa.model, d_2011) summary(fit, std = T, fit = T) reliability(fit)


Input: Estimate models across all specifications  Customized model functions to include random country effect [CODESPLIT] linear <- function(formula, data) { pb$tick() # set tick for progress bar lmer(paste(formula, "+ (1|country)"), data = data) }


Input: Decomposing variance  Estimate multilevel model (without predictors) [CODESPLIT] m_lin <- lmer(stdcoef ~ 1 + (1|x) + (1|controls) + (1|subsets)  + (1|x:controls) + (1|x:subsets) + (1|subsets:controls), data = results) summary(m_lin)


Input: run polynomial regresion as a OLS linear model [CODESPLIT] f <- paste0(DV, " ~ ", paste("1", IV1, IV2, IV12, IV_IA, IV22, sep=" + "), controlvariables) lm.full <- lm(f, data=df, na.action=na.exclude)


Input: Matrix of phenotypic change trajectories X and Z,  interlineage correlation matrix C, and intertrait crossproduct matrix A,  as well as the number of lineages n ( 13)  and dimensionality of the vectors p ( 76)  [CODESPLIT] X <- f.mean.diff(data.sc, fishID) Z <- X / sqrt(diag(tcrossprod(X))) C <- tcrossprod(Z) A <- crossprod(Z) n <- nrow(Z) p <- ncol(Z) - 4 # -4 accounting for the loss of d.f. from Procrustes alignment


Input: Histograms comparing dissimilarity between the original and  bootstrap replicates between "Moo" and "Pac" (largest and smallest dispersion)  This shows that the heteroscedasticity is real (not due to visual distortion)  [CODESPLIT] hist(acos(Z[10, ] %*% Zb[10, , ]), breaks = seq(0, pi / 2, 0.1), col = "#FF000080", main = "Pac (red) versus Moo (blue)", xlab = "Angle between original and bootstrap vectors (radian)") hist(acos(Z[7, ] %*% Zb[7, , ]), add = TRUE, breaks = seq(0, pi / 2, 0.1), col = "#0000FF80")


Input: Use kNNdistplot(d.cor.umap, k  3) to determine the value for eps  [CODESPLIT] d.cor.dbscan <- dbscan(d.cor.umap, minPts = 3, eps = 1.8) data.table.large.cluster <- data.table[,d.cor.dbscan$cluster == 1] large.cluster.cor.metric <- as.dist(acos(cor(data.table.large.cluster))) large.umap <- umap( large.cluster.cor.metric, min_dist = 1, n_neighbors = 3 ) large.dbscan <- dbscan(large.umap, minPts = 3, eps = 1) large.cols <- rainbow(length(unique(large.dbscan$cluster)), start = 2/6) write.csv( d.cor.umap, 'd_acos_cor_fixed.csv', row.names = F ) write.csv( d.cor.dbscan$cluster, 'dbscan_clustering_fixed.csv' ) write.csv( large.umap, 'd_acos_cor_fixed_large_cluster.csv', row.names = F ) write.csv( large.dbscan$cluster, 'dbscan_clustering_of_large_cluster_fixed.csv' )


Input: Chisquare test: Difference in preference based on outcome, by condition [CODESPLIT] chisq.test(matrix(c(19,5,5,17), ncol = 2, byrow = T)) oddsratio.wald.outcome <- oddsratio.wald(matrix(c(19,5,5,17), ncol = 2, byrow = T))$measure[2] # Note: I reorganized the matrix so that r is of the same sign as that of Experiment 2 esc_2x2( grp1yes = 19, grp1no = 5, grp2yes = 5, grp2no = 17, es.type = "or" ) # this confirms Wald's odds ratio


Input: Two sample ttest: Difference in proportionate looking based on outcome, by condition [CODESPLIT] twosamplet.outcome <- t.test(pPositiveO ~ Condition, data = bh2zoom, alternative = "two.sided") twosampled.outcome <- cohen.d(pPositiveO ~ Condition, data = bh2zoom)$estimate


Input: Assess how well model captured PWLs ' ' This function calculates several indicators that help to assess how well the model captured captWKLs beyond simple layer structure. ' It get's called by the overarching evaluation script `evaluate_main.R` ' ' So, for each WKL the function computes ' ' * correlation factors for likelihood/distribution/sensitvity versus proportion of unstable grid points ' * the maximum proportion of unstable grid points during the lifetime of the WKL ' * the temporal lag between first forecaster concern (> avy problem) and first time that grid points are unstable in that layer '      different timing instances possible: first time (i) at least one grid point unstable, (ii) the majority of grid points is unstable, (iii) more than 50 % of max proportion unstable ' * the temporal lag between latest forecaster concern (> last day of avy problem) and last time that grid points are unstable in that layer '      need to find rules for becoming dormant and waking up again versus becoming inactive ' ' @param VData object;; don't include both primary/secondary and tertiary gtype_ranks! ' ' @export  [CODESPLIT] assessQualityOfcaptWKL <- function(VData, band, stabilityindex = "p_unstable") { gtype_rank <- unique(VData$vframe$gtype_rank) if (any(c("primary", "secondary") %in% gtype_rank) & "tertiary" %in% gtype_rank) stop("You can only provide either primary and/or secondary, or tertiary gtype_ranks in your VData object to this function!") possible_ranks <- c("tertiary", "secondary", "primary") gtype_rank <- possible_ranks[possible_ranks %in% gtype_rank][1] nrow_max <- length(VData$wkl$wkl_uuid) OUTnames <- c( "wkl_uuid", "wkl_iscrust", "wkldate", "wkltag", "nPDays", "nPDays_anyunstable", "nPDays_median", "nPDays_halfofmax", "nPDays_20", "rho_llhd", "rho_dist", "rho_sens", "p_llhd", "p_dist", "p_sens", "pu_max", "offset_maxes", "offset_mean", "pcapt_max", "lagA_anyunstable", "lagA_median", "lagA_halfofmax", "lagA_20", "lagZ_anyunstable", "lagZ_median", "lagZ_halfofmax", "lagZ_20", "band", "stabilityindex", "gtype_rank" ) OUT <- matrix(nrow = max(1, nrow_max), ncol = length(OUTnames), dimnames = list(seq(max(1, nrow_max)), OUTnames)) for (i in seq_along(VData$wkl$wkl_uuid)) { wuid <- VData$wkl$wkl_uuid[i] wkldate <- as.character(as.Date(VData$wkl$datetag[i])) wkltag <- paste(format(as.Date(VData$wkl$datetag[i]), "%b %d"), substr(gtype_rank, start = 1, stop = 4)) wkl_iscrust <- as.logical(VData$wkl$iscrust[i])


Input: Correlation of life satisfaction and depression across all measurement occasions [CODESPLIT] d.all %>% select(contains("fsat"), contains("depr"), id) %>% gather(key, value, -id) %>% separate(key, c("time", "variable")) %>% spread(variable, value) %>% select(depr, fsat) %>% zero_order_corr(print = T, digits = 3) %>% select(`1`) %>% slice(2)


Input: check if latent covariances are equal across groups [CODESPLIT] est_svc <- cfa(mod_s,quop_use, estimator = "MLR", missing = "FIML", group = "year", group.equal = c("loadings","intercepts","residuals", "lv.variances","lv.covariances"), cluster = "class")


Input: get factor scores from model est_svcm_sl [CODESPLIT] fs <- lavPredict(est_svcm_sl, method = "bartlett")


Input: Plot for distribution of emotions   Arguments: original ddbb, type of emotion, plot title  [CODESPLIT] create.emotion.plot <- function(case_ddbb, emotion="emotion", plot_title=NULL){


Input: Table and plot for effect sizes   Arguments: original ddbb, plot title  [CODESPLIT] create.effectsize.tableplot <- function(case_ddbb, plot_title = NULL){


Input: Convert average time into a ordinal variable [CODESPLIT] Tbl2$DurSecAvg1Cat <- cut(Tbl2$DurSecAvg1, breaks = quantile(Tbl2$DurSecAvg1, c(0, 1/3, 2/3, 1)), include.lowest = T) aggregate(Tbl2$DurSecAvg1, list(Tbl2$DurSecAvg1Cat), summary) levels(Tbl2$DurSecAvg1Cat) <- c("Less", "Avg", "More")


Input: Plotting Figure 3 [CODESPLIT] png(filename = "Fig03_Demographics.png", width = 19, height = 10, units = "cm", res = 500, pointsize = 7) par(mfrow=c(2,3))


Input: Predict node for checking differences in distributions with chisquared test [CODESPLIT] Tbl2$NodeRate <- predict(Engage, newdata = Tbl2, type = "node") table(Tbl2$NodeRate) (temp <- chisq.test(Tbl2$NodeRate, Tbl2$FeedbackEngage)) temp$observed round(100*prop.table(temp$observed, 1), 1) mosaic(temp$observed, shade = T) Tbl2$NodeRate <- predict(FeedTree, newdata = Tbl2, type = "node") table(Tbl2$NodeRate) (temp <- chisq.test(Tbl2$NodeRate, Tbl2$Useful_FeedbackMiddle)) temp$observed round(100*prop.table(temp$observed, 1), 1) mosaic(temp$observed, shade = T) Tbl2$NodeRate <- predict(ExTree, newdata = Tbl2, type = "node") table(Tbl2$NodeRate) (temp <- chisq.test(Tbl2$NodeRate, Tbl2$Useful_FeedbackMiddle)) temp$observed round(100*prop.table(temp$observed, 1), 1) mosaic(temp$observed, shade = T) head(Tbl2$RankTaskPerform)


Input: Convert `from_name` to factor with three levels. (Facilitates data visualization). [CODESPLIT] Campaign_Messages$from_name <- factor(Campaign_Messages$from_name, levels = c ("Stephen Harper", "Justin Trudeau", "Tom Mulcair"))


Input: change the title text to size 20 and bold [CODESPLIT] axis.title = element_text(size = 20, face = "bold"), axis.title = element_text(size = 20, face = "bold"),


Input: change the axis label text to size 14, bold, and black color  [CODESPLIT] axis.text.x = element_text(size = 14, face = "bold", color = "black"), axis.text.y = element_text(size = 14, face = "bold", color = "black")) + axis.text.x = element_text(size = 14, face = "bold", color = "black"), axis.text.y = element_text(size = 14, face = "bold", color = "black")) + scale_y_continuous(limits = c(0, 17), expand = c(0,0)) +


Input: Identify all neighbours within 2km [CODESPLIT] sp_nb <- spdep::dnearneigh(coords, d1 = 0, d2 = km, row.names = row.names(sp), longlat = TRUE)


Input: take the inverse of the distances [CODESPLIT] W <- lapply(dsts, function(x) 1 / x) W <- lapply(dsts, function(x) 1 / x)


Input: recode base price and overage as numeric (without $ sign) [CODESPLIT] x$b1=as.numeric(sapply(strsplit(as.character(x$b1),"\\$"),function(y) y[2])) x$b2=as.numeric(sapply(strsplit(as.character(x$b2),"\\$"),function(y) y[2])) x$b3=as.numeric(sapply(strsplit(as.character(x$b3),"\\$"),function(y) y[2])) x$c1=as.numeric(sapply(strsplit(as.character(x$c1),"\\$"),function(y) y[2])) x$c2=as.numeric(sapply(strsplit(as.character(x$c2),"\\$"),function(y) y[2])) x$c3=as.numeric(sapply(strsplit(as.character(x$c3),"\\$"),function(y) y[2]))


Input: create dataset with possible k values, their prior and likelihood  probabilities  likelihood is drawn from 1000 random samples from beta distibution  [CODESPLIT] df <- tibble(k = hypo_k) %>% mutate(model_vote = 0.0727^k) %>% mutate(occur = map_int(.$model_vote, ~ length(which(polls$value >= .x))), prior = prob_k) %>% mutate(like = map(.$occur,~ rbeta(trials, .x, polls_len - .x)))


Input: visualise normalised posterior on a graph [CODESPLIT] p <- df %>% ggplot(aes(k, norm_posterior)) + geom_point() + geom_line() p + labs( title = "Probability of k exponent in the interval <0.89;; 0.99>", x = "Value o k exponent", y = "Normalised probability" ) + theme_minimal()


Input: 3) CALCULATION OF ESTIMATED MARGINAL MEANS   Tests for differences in response to jargon for plot [CODESPLIT] at_jarg <- list(Jargon = c("More", "Less"), UnderN = "Easy", RecognN = "Fairly", TrvlAdv_Atten = "Cons", cut = "3|4") grid_jarg <- ref_grid(clmm_usejar, mode = "exc.prob", at = at_jarg) (emm_jarg <- emmeans(grid_jarg, specs = pairwise ~ Jargon, by = "BackgrAvTraining")) plot_jarg <- summary(emm_jarg$emmeans) cont_jarg <- summary(emm_jarg$contrasts)


Input: Gradient of FDR with respect to alpha (and its implied power) across ncp for a onesided ztest  Note that the gradient is increasing towards $\infty$ from both side at ncp  0 and alpha 0, but is equal to 0 at that point. The figure does not allow to depict it properly and it seems like as if it peaked at ncp around .5 and was decreasing towards 0.  Green corresponds to $P(H_0)  .2$, blue to $P(H_0)  .5$, and red to $P(H_0)  .8$.  [CODESPLIT] alpha <- seq( 0, 1, length.out = 500) ncp   <- seq(-5, 5, length.out = 500) FDR.2od  <- fill_gradFDR.alpha(.2, alpha, ncp, FALSE) FDR.5od  <- fill_gradFDR.alpha(.5, alpha, ncp, FALSE) FDR.8od  <- fill_gradFDR.alpha(.8, alpha, ncp, FALSE) plot_ly(x = ~alpha, y = ~ncp, z = ~FDR.5od) %>% add_surface(contours = list( y = list( show = TRUE, project = list(y = TRUE), usecolormap = FALSE, color = "blue" ), x = list( show = TRUE, project = list(x = TRUE), usecolormap = FALSE, color = "blue" ) ), opacity = .4) %>% layout(scene = list( xaxis = list( tickvals = c(0, .05, .1, .2, .5, 1) ), yaxis = list( tickvals = pretty(ncp) ), zaxis = list( tickvals = seq(0, 1, .2), title    = list(text = "FDR'") ) )) %>% add_surface(x = ~alpha, y = ~ncp, z = ~FDR.8od, opacity = .4, contours = list( y = list( show = TRUE, project = list(y = TRUE), color = "red" ), x = list( show = TRUE, project = list(x = TRUE), color = "red" ) )) %>% add_surface(x = ~alpha, y = ~ncp, z = ~FDR.2od, opacity = .4, contours = list( y = list( show = TRUE, project = list(y = TRUE), color = "green" ), x = list( show = TRUE, project = list(x = TRUE), color = "green" ) ))


Input: List that will include table (each element should be vector of 3): [CODESPLIT] Table <- list( c("Network Characteristics",title,""), c("Comparing Global Characteristics",nameOrig, nameRepl) )


Input: The row with "def_cond" is moved to a new column and duplicated (this is  done with reference to "cond_to_group")  [CODESPLIT] df_tmp_2 <- full_join( df_tmp_1 %>% filter({{cond_to_compare}} != def_cond), df_tmp_1 %>% filter({{cond_to_compare}} == def_cond), by = col )


Input: Repeating the analyses with closeness as covariate [CODESPLIT] cor.test(data_3A$closeness_1,data_3A$closeness_2) cor.test(data_3B$closeness_1,data_3B$closeness_2) cor.test(data_3C$closeness_1,data_3C$closeness_2)


Input: check if the number of processed partners is smaller than the number of listed partners as saved in the counter variable [CODESPLIT] nrow(Relationship_details) < My_EHC_survey$count_SP


Input: run anovas to check interaction between specificity and condition  LA [CODESPLIT] anova_N4_la_sp = summary(aov(Voltage ~ Condition *Specificity , data = mydata_n4_la)) anova_N4_la_sp


Input: Visualize grid cluststers [CODESPLIT] mgp.u<-c(2.3,0.6,0.5) if(tifit==T){ tiff(tifname,width=14,height=12.5,units="cm",res=600,compression="lzw") } par(oma=c(0,4,4,4)) layout(matrix(1:9,ncol=3,byrow=T),widths=c(1.28,1,1),heights=c(1,1,1.28)) doFloorC(n=1000,eta=1,char=char,mar1=c(gap,3.5,gap,gap),mgp1=mgp.u,xax=F,yax=T,xl="",col2=col2,seq.s=seq.s,seq.c=seq.c,contour=contour)


Input: Create the dataset for visualizations Summarize the means (and sd for clusters) [CODESPLIT] means.cl<-tapply(res$clust,paste(res$n,res$h,res$nu,res$eta),mean,na.rm=T) sd.cl<-tapply(res$clust,paste(res$n,res$h,res$nu,res$eta),sd,na.rm=T) means.dim<-tapply(res$explained3D,paste(res$n,res$h,res$nu,res$eta),mean,na.rm=T) means.avg<-tapply(log(res$avgdist),paste(res$n,res$h,res$nu,res$eta),mean,na.rm=T) vars<-strsplit(names(means.cl)," ")


Input: Graph of the distribution of pvalues for each effect [CODESPLIT] pvalue.plot <- ggplot(melt_pvalue,aes(x = value)) + facet_wrap(~variable, ncol = 5) + geom_histogram()


Input: Graph of the distribution of standard estimates for each effect [CODESPLIT] est.std.plot <- ggplot(melt_est.std,aes(x = value)) + facet_wrap(~variable, ncol = 5) + geom_histogram() list.result <- list("dist_pvalue.plot" = pvalue.plot, "dist_est.std.plot" = est.std.plot) return(list.result)


Input: returns plot of pvalue disttribution, plot of standard estimates distribution  [CODESPLIT] list.result <- list("dist_pvalue.plot" = pvalue.plot, "dist_est.std.plot" = est.std.plot) return(list.result)


Input: Model estimates plot   Arguments: standard estimates distribution, pvalues distributions, use sign level TREU/FALSE, level of signicance, plot title  [CODESPLIT] create.model_estimates.plot <- function (est.std_dist, pvalue_dist, significant = FALSE, sig_level=.05, title = NULL){


Input: Median of each standard estimates and TRUE/FALSE values if mean(pvalues) < sig_level [CODESPLIT] est.std_All <- data.frame(cbind(colMeans(est.std_dist), colMeans(pvalue_dist) <= sig_level))


Input: Change the participantID to a shorter & uniform name "Subject"  [CODESPLIT] names(d)[names(d) == "Participant.Public.ID"] <- "Subject"


Input: For trimmed set, we remove any RT that is too long (>2500ms)  [CODESPLIT] d_trimmed = d %>% filter (acc == 2, Reaction.Time > 300, Reaction.Time < 2500)


Input: Plotting   create a dataset that contains means of both oddnumbered & evennumbered items' RTs [CODESPLIT] raw_untrimmed<-inner_join(x= mean.o, y=mean.e, by="Subject") names(raw_untrimmed) <- c("Subject", "Odd", "Even")


Input: AVERAGE BY PARTICIPANT [CODESPLIT] mean.e = de %>% group_by(Subject) %>% summarise(mean(rt.diff)) mean.o = do %>% group_by(Subject) %>% summarise(mean(rt.diff)) mean.e = de %>% group_by(Subject) %>% summarise(mean(zrt.diff)) mean.o = do %>% group_by(Subject) %>% summarise(mean(zrt.diff)) mean.e = de %>% group_by(Subject) %>% summarise(mean(zrt.diff)) mean.o = do %>% group_by(Subject) %>% summarise(mean(zrt.diff))


Input: combine them into one data frame [CODESPLIT] person <- inner_join(person_rand_e, person_rand_o, by = "Subject", suffix = c("_even", "_odd"))


Input: Wilcoxon ranksum test on widths of unbroken artefacts: [CODESPLIT] results <- wilcox.test(An2entire$Width,Gmeentire$Width) Z       <- qnorm(results$p.value)


Input: Wilcoxon ranksum test on lengths of unbroken artefacts: [CODESPLIT] results <- wilcox.test(An2entire$Length,Gmeentire$Length) Z       <- qnorm(results$p.value)


Input: DATA DOWNSAMPLING  add collumns with delta distance and delta time for downsampling [CODESPLIT] trajectory.df <- trajectory.df %>% 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))


Input: Caculate daily cumulative distances and time lags Calculate speed Join with relocation info Add consecutive number per individual to indicate tracking day [CODESPLIT] daily <- trajectory.df %>% group_by(id, date) %>% filter(!dist == "NA") %>% dplyr::summarize(daily_dist = sum(dist), sex = first(sex), time_lag_min = sum(time_lag_min)) %>% mutate(id_day = paste(id, date), daily_speed = (daily_dist/as.numeric(time_lag_min) * 60)) %>% left_join(relocs.perday) %>% group_by(id) %>% mutate(trans_day = row_number())


Input: Split up the trajectories into 50m and 200m translocations [CODESPLIT] trajectory50m <- trajectory.df %>% filter(trans_group == "50m") trajectory200m <- trajectory.df %>% filter(trans_group == "200m")


Input: Plot daily movement by daily temp & sex [CODESPLIT] ggplot(data = daily, aes(x = temp, y = daily_dist, group = sex, color = sex)) + geom_point() + stat_smooth(method=lm) + theme_bw()


Input: Plot daily movement by daytime rainfall & sex [CODESPLIT] ggplot(data = daily, aes(x = rain_daytime, y = daily_dist, group = sex, color = sex)) + geom_point() + stat_smooth(method=lm) + theme_bw()


Input: Plot daily movement by cumulative rainfall & sex [CODESPLIT] ggplot(data = daily, aes(x = rain_cumul, y = daily_dist, group = sex, color = sex)) + geom_point() + stat_smooth(method=lm) + theme_bw()


Input: x is a matrix containing the data  method : correlation method. "pearson"" or "spearman"" is supported  removeTriangle : remove upper or lower triangle  results :  if "html" or "latex"  the results will be displayed in html or latex format  [CODESPLIT] corstars <-function(x, method=c("pearson", "spearman"), removeTriangle=c("upper", "lower"), result=c("none", "html", "latex")){


Input: Diagonal matrix Tau used to scale the z_w [CODESPLIT] Tau_w <- matrix(c(DA.mp$`tau_w[1]`,0,0, 0,DA.mp$`tau_w[2]`,0, 0,0,DA.mp$`tau_w[3]` ),nrow=3,ncol=3)


Input: Run fixed effect model [CODESPLIT] life <- rma(yi = corrs$cor, vi = corrs$vi, measure = "COR", method = "FE")


Input: Set max Y for graph [CODESPLIT] y_max<-max(d_dist)+1


Input: This does the summary. For each group's data frame, return a vector with  N, mean, median, and sd  [CODESPLIT] datac <- ddply(data, groupvars, .drop=.drop, .fun = function(xx, col) { c(N    = length2(xx[[col]], na.rm=na.rm), mean = mean   (xx[[col]], na.rm=na.rm), median = median (xx[[col]], na.rm=na.rm), sd   = sd     (xx[[col]], na.rm=na.rm) ) }, measurevar )


Input: Rename the "mean" and "median" columns  [CODESPLIT] datac <- rename(datac, c("mean" = paste(measurevar, "_mean", sep = ""))) datac <- rename(datac, c("median" = paste(measurevar, "_median", sep = ""))) datac$se <- datac$sd / sqrt(datac$N)  # Calculate standard error of the mean


Input: A function that reads in one line in the csv file, add tags and texts around it, and write the output line into an output file  [CODESPLIT] add_tags <- function(l,o){ image_no <- strsplit(as.character(l[1]),"\\.")[[1]][1] image_URL <- paste("<img src='", as.character(l[2]),"'>",sep="") write(paste("[[Block:", image_no, "]] \n [[Question:DB]] \n [[ID:", image_no, "-image]] \n", image_URL, " \n [[Question:TE:SingleLine]] \n [[ID:", image_no, "-TE]] \n", TE, " \n [[Question:MC:SingleAnswer:Vertical]] \n [[ID:", image_no, "-MC]] \n", MC, " \n [[Choices]] \n", choices_formatted, "\n [[Question:Matrix]] \n [[ID:", image_no, "-ratings]] \n ",rating_prompt," \n [[AdvancedChoices]] \n ", rating_statements_formatted, "\n [[AdvancedAnswers]] \n [[Answer]] \n","1 - Strongly Disagree", "\n [[Answer]] \n 2 \n [[Answer]] \n 3 \n [[Answer]] \n 4 \n [[Answer]] \n 5 \n [[Answer]] \n 6 \n [[Answer]] \n", "7 - Strongly Agree"," \n [[PageBreak]] \n", sep = ""), o, append = TRUE) }


Input: Generate a plot for posterior predictive check (evaluate whether the ' posterior predictive data look more or less similar to the observed data) ' ' @param df dataframe with the data ' @param mod Bayesian model ' ' @return plot with posterior predictive check [CODESPLIT] get_pp_check <- function(df, mod) { map(list(df), ~brms::pp_check(mod,


Input: Simulate a single between group study given sample size n, true (fixed) effect size delta, and heterogeneity (random effect) tau.  Generate data for the experimental group (y_e) and for the control group (y_c).  [CODESPLIT] y_e = rnorm(n, 0, 1) + delta + rnorm(1, 0, tau) y_c = rnorm(n, 0, 1)


Input: calculate pooled variance S, standardized mean difference d, the variance of d, the pvalue, and N.  [CODESPLIT] S = sqrt(((n - 1) * v_e + (n - 1) * v_c) / df) d = (m_e - m_c) / S var.d = (n + n)/(n * n) + (d^2 / (2 * (n + n))) se.d = sqrt(var.d) N = n + n


Input: Box and Whisker Plots to Compare Models [CODESPLIT] scales <- list(x=list(relation="free"), y=list(relation="free")) bwplot(results, scales=scales)


Input: stimuli  specify correlations for rnorm_multi (one of several methods) [CODESPLIT] stim_cors = stim_i_cor stim = rnorm_multi( n = stim_n, vars = 2, r = stim_cors, mu = 0, # means of random intercepts and slopes are always 0 sd = c(stim_sd, stim_version_sd), varnames = c("stim_i", "stim_version_slope") ) %>% mutate( stim_id = 1:stim_n ) stim_cors = stim_i_cor stim = rnorm_multi( n = stim_n, vars = 2, r = stim_cors, mu = 0, # means of random intercepts and slopes are always 0 sd = c(stim_sd, stim_version_sd), varnames = c("stim_i", "stim_version_slope") ) %>% mutate( stim_id = 1:stim_n ) stim_cors = stim_i_cor stim = rnorm_multi( n = stim_n, vars = 2, r = stim_cors, mu = 0, # means of random intercepts and slopes are always 0 sd = c(stim_sd, stim_version_sd), varnames = c("stim_i", "stim_version_slope") ) %>% mutate( stim_id = 1:stim_n )


Input: calculate trialspecific effects by adding overall effects and slopes [CODESPLIT] version_eff = stim_version_eff + stim_version_slope + sub_version_slope, version_eff = stim_version_eff + stim_version_slope + sub_version_slope, version_eff = stim_version_eff + stim_version_slope + sub_version_slope,


Input: Take the list of csv files from above, and read them all into R (purrr::map function)  This will download 100 csv files into a list  The reduce function will then bind them all together into a dataframe  [CODESPLIT] large_df <- csv_files %>% purrr::map(function(x) { read.csv(x) }) %>% purrr::reduce(cbind)


Input: Re structure this dataframe to turn it to long format (pivot_longer)  Keep the X columns in, these are the rowvalues we can use to denote a sample  The column names contain the participant (P) and the session number (S)  It will display with each 1st sample of each session for a given participant, so need to reorder to get sorted by participant, session, then second sample  The names_pattern uses regular expresisons to denote that the names will come from the specified area  i.e., after the P, which could contain any values which occur before the underscore, and likewise after the S  [CODESPLIT] large_df <- large_df %>% tidyr::pivot_longer(cols = !contains("X"), names_to = c("participant", "session"), names_pattern = c("P(.*)_S(.*)"), values_to = "heart_rate")  %>% dplyr::rename(seconds = "X") %>% dplyr::arrange(participant, session, seconds) %>% dplyr::mutate(participant = as.factor(participant), session = as.factor(session))


Input: pool "exp_buc" columns into one column, so that advocacy type is one variable and create new "experienced" column for each level of advocacy type  [CODESPLIT] data <- data %>% pivot_longer(names_to = "advocacytype", values_to = "experienced", graphic_exp_buc:disprotest_exp_buc)


Input: Create variables for residue that is 'present' vs 'absent' This is used for the tables/descriptives AND for color/filling the figures [CODESPLIT] data <- dplyr::mutate(data, oro_zero = if_else(valleculae_severity_rating == 0, "Absent", "Present")) data <- dplyr::mutate(data, hypo_zero = if_else(piriform_sinus_severity_rating == 0,"Absent", "Present")) data <- dplyr::mutate(data, epi_zero = if_else(epiglottis_severity_rating == 0, "Absent", "Present")) data <- dplyr::mutate(data, lv_zero = if_else(laryngeal_vestibule_severity_rating == 0, "Absent", "Present")) data <- dplyr::mutate(data, vf_zero = if_else(vocal_folds_severity_rating == 0, "Absent", "Present")) data <- dplyr::mutate(data, sg_zero = if_else(subglottis_severity_rating == 0, "Absent", "Present")) data <- dplyr::mutate(data, pas_zero = if_else(pas_max < 2, "Absent", "Present"))


Input: Diagnostic tests to determine appropriate number of factors in EFA  parallel analysis (includes scree plot) and Very Simple Structure test  optimal number of factors is 6 [CODESPLIT] fa.parallel(mainData[, c(2:56)], fm = 'ml', fa = 'fa') vss(mainData[, c(2:56)], n = 8, rotate = 'oblimin', fm = 'mle')


Input: replace missings values (9 and 99) with NA [CODESPLIT] pilot<- na_if(pilot,99) pilot<- na_if(pilot,-9)


Input: subset of participants with less then 4 missings [CODESPLIT] pilot<- subset(pilot, pilot$missings_a < 4) pilot_c <- pilot[,c("SJT_kb_00007","SJT_kb_00028","SJT_kb_00058", "SJT_kb_00054","SJT_kb_00072","SJT_kb_00026", "SJT_kb_00060","SJT_kb_00053","SJT_kb_00039", "SJT_kb_00027","SJT_kb_00015","SJT_kb_00038", "SJT_kb_00035","SJT_kb_00055","SJT_kb_00010")] pilot$missings_c <- apply(pilot_w,1,function(x) sum(is.na(x))) pilot<- subset(pilot, pilot$missings_c < 4) pilot_es <- pilot[,c("SJT_kb_00103","SJT_kb_00197","SJT_kb_00136", "SJT_kb_00134","SJT_kb_00113","SJT_kb_00128", "SJT_kb_00117","SJT_kb_00127","SJT_kb_00104", "SJT_kb_00108","SJT_kb_00094","SJT_kb_00143", "SJT_kb_00116","SJT_kb_00202","SJT_kb_00175")] pilot$missings_es <- apply(pilot_es,1,function(x) sum(is.na(x))) pilot<- subset(pilot, pilot$missings_es < 4)


Input: Coding past experiences into binary variables [CODESPLIT] data <- data %>% mutate_at(vars("graphic_exp":"attentioncheck_exp"), list(buc = bucketing_experienced)) %>% glimpse


Input: Coding behaviors into binary variables 0  unselected, 1  selected  [CODESPLIT] data <- data %>% mutate_at(vars("behavior_donation":"behavior_none"), list(bin = binary.behavior)) %>% glimpse


Input: Creating a combined race/ethnicity variable [CODESPLIT] data <- data %>% mutate(race.eth = case_when(hispanic == "Yes" ~ "Hispanic or Latinx", race == "Caucasian/White" & hispanic == "No" ~ "White, Non-Latinx", race == "Black or African-American" & hispanic == "No" ~ "Black, Non-Latinx", race == "Asian" & hispanic == "No" ~ "Asian", race == "Multi-Racial" & hispanic == "No" ~ "Multi-Racial", TRUE ~ "Other Races/Ethnicities"))


Input: correlations between csd_mean and averaged csds for Big Five traits (not mentioned   in the text): [CODESPLIT] psych::corr.test( df2$e_csd,df2$csd_mean_e ) psych::corr.test( df2$a_csd,df2$csd_mean_a ) psych::corr.test( df2$pa_csd,df2$csd_mean_pa ) psych::corr.test( df2$na_csd,df2$csd_mean_na )


Input: Participants could select all response options that applied to them in any given situation. Here, we create one dummy variable for every response option.  [CODESPLIT] for (i in 1:length(survey$interacting_by)) { v <- unlist(strsplit(survey$interacting_by[i], ",")) if (is.element("1", v)) { survey$TiP[i] <- 1 } if (is.element("2", v)) { survey$ToP[i] <- 1 } if (is.element("3", v)) { survey$TM[i] <- 1 } if (is.element("4", v)) { survey$ChattingWHATSAPP[i] <- 1 } if (is.element("5", v)) { survey$ChattingDATING[i] <- 1 } if (is.element("6", v)) { survey$Emailing[i] <- 1 } if (is.element("7", v)) { survey$Videochatting[i] <- 1 } if (is.element("8", v)) { survey$Facebook[i] <- 1 } if (is.element("9", v)) { survey$Instagram[i] <- 1 } if (is.element("10", v)) { survey$Snapchat[i] <- 1 } if (is.element("11", v)) { survey$Twitter[i] <- 1 } if (is.element("12", v)) { survey$OTHER[i] <- 1 } if (is.element("0", v)) { survey$NoInteraction[i] <- 1 } if (is.element("999", v)) { survey$SKIP[i] <- 1 } } for (i in 1:length(survey$interacting_people)){ v <- unlist(strsplit(survey$interacting_people[i], ",")) if (is.element("1", v)) { survey$Classmates[i] <- 1 } if (is.element("2", v)) { survey$Coworkers[i] <- 1 } if (is.element("3", v)) { survey$Family[i] <- 1 } if (is.element("4", v)) { survey$Friends[i] <- 1 } if (is.element("5", v)) { survey$Roommates[i] <- 1 } if (is.element("6", v)) { survey$Significant_other[i] <- 1 } if (is.element("7", v)) { survey$Strangers[i] <- 1 } if (is.element("8", v)) { survey$OTHER2[i] <- 1 } if (is.element("999", v)) { survey$SKIP2[i] <- 1 } }


Input: Rescore so high values are what we expect to be positive predictors (e.g. female 2 male 1) [CODESPLIT] df$Nationality2 <- df$Nationality df$Nationality2 <- as.integer(df$Nationality2 %in% "Dutch") df$Nationality2[df$Nationality2==0] <- 2 df$Nationality2[df$Nationality2==1] <- 0 df$Nationality2[df$Nationality2==2] <- 1  # Dutch=0 (36), Rest=1 (44) count(df$Nationality2) df$RelationshipStatus2 <- df$RelationshipStatus df$RelationshipStatus2 <- recode(df$RelationshipStatus2, "3" = 2) df$RelationshipStatus2[df$RelationshipStatus2==2] <- 0  # Partnered=0 (30), Single=1 (50) count(df$RelationshipStatus2) df$Gender2 <- df$Gender          # df$Gender2[df$Gender2==3] <- NA  # code 1 nonbinary participant as NA for this to avoid 3 levels df$Gender2[df$Gender2==1] <- 0 df$Gender2[df$Gender2==2] <- 1   # men=0 (19), women=1 (60), 1 NA count(df$Gender2) df$WorkStatus2 <- df$WorkStatus df$WorkStatus2[df$WorkStatus2==2] <- 0 # 54no, 26yes count(df$WorkStatus2) df$MentalHealth2 <- as.numeric(df$MentalHealth) df$MentalHealth2[df$MentalHealth2==1] <- 0 df$MentalHealth2[df$MentalHealth2==2] <- 1   # healthy=0 (59), history=1 (17), 4 NA count(df$MentalHealth2) df$selfefficacy_pre2 <- df$selfefficacy_pre*-1 # reverse code


Input: Rating Means and Standard Deviations of Conditions   Unspecified Rating [CODESPLIT] round(mean(unspecified$rating), 2) round(sd(unspecified$rating), 2)


Input: Save and export image as .eps (8.18 x 4.88 inch) [CODESPLIT] if(saveFigures) cairo_ps(file = '../R_Output/Images/AccuracyPerProject_Revision.eps', onefile = TRUE, fallback_resolution = 600, width = 8.18, height = 4.88) par(cex.main = 2.2, mar = c(5, 5.5, 2, 2) + 0.1, mgp = c(3, 1, 0), cex.lab = 2, font.lab = 1, cex.axis = 1.6, bty = 'n', las = 1) plot(x = c(.5, .8), y = c(0, 50), type = 'n', xlab = expression(paste("Accuracy Rate ", omega, " (in %)")), ylab = 'Density', main = '', axes = FALSE) axis(2, lwd.tick = 0, labels = FALSE) axis(1, at = seq(.5, .8, by = .05), labels = seq(50, 80, by = 5)) d <- lapply(split(df$omega, df$condition), density) Map(function(dens, col) polygon(dens, col = col), dens = d, col = figureColors[['cols.transparent']]) text(.64,44.5,'Laypeople\n(Evidence)', cex = 1.3) text(.55,44.5,'Laypeople\n(Description)', cex = 1.3) text(.621,25,'Experts\nML2',  cex = 1.3) text(.75,25, 'Experts\nSSRP', cex = 1.3) graphics.off()


Input: function to calculate AUC [CODESPLIT] groupAUC.description <- pnorm(description.mud / sqrt(2)) # signal distribution has sigma = 1 quantile(groupAUC.description, c(0.025, 0.5, 0.975)) groupAUC.evidence <- pnorm(evidence.mud / sqrt(2)) # signal distribution has sigma = 1 quantile(groupAUC.evidence, c(0.025, 0.5, 0.975))


Input: get relevant information  compute mode of signal distribution [CODESPLIT] estimate_mode <- function(x) { d <- density(x) d$x[which.max(d$y)] } modeD           <- estimate_mode(mud) medianC         <- median(muc) empiricalLambda <- (0.5*modeD) + medianC


Input: compute CIs for each value of lambda [CODESPLIT] probD      <- quantile(mud, probs = probs) for (i in seq_len(nPoints)){ c        <- lambdas[i] - (0.5 * probD) qph[i, ] <- pnorm((0.5 * probD) - c) }


Input: get the posterior distributions of the intercepts, transformed to rate scale  [CODESPLIT] post.description <- inv_logit_scaled(posterior_samples(m.studies, 'b_intercept'))[,1] post.evidence    <- inv_logit_scaled(posterior_samples(m.studies, 'b_intercept') + posterior_samples(m.studies, 'b_conditionDescriptionPlusEvidence'))[,1]


Input: add the observed average accuracy per study and per condition [CODESPLIT] fit$obs.accuracy <- c(aggregate(dat$guessed.correctly, list(condition = dat$condition), mean)[,'x'], aggregate(dat$guessed.correctly, list(study = dat$study, condition = dat$condition), mean)[,'x'])


Input: Create a binary trial type variable 0  Go, 1  No Go  [CODESPLIT] sart$trial_type <- sart$code sart$trial_type[sart$code == 3] <- NA sart$trial_type <- as.factor(sart$trial_type-1)


Input: Calculate Go RT coefficient of variation (CV) to index intraindividual variability [CODESPLIT] sartsub$go_cv <- sartsub$gosd / sartsub$gomean sart <- merge(sart, sartsub[,c(1,5,6,9)], by = "subid")


Input: Add CSE variables to the MW probe data set [CODESPLIT] probes <- merge(probes, cse_wide[,c("subid","cse","ce","csez","cez")], by = "subid")


Input: read in, display, and summarize 'csv' data  [CODESPLIT] data_raw <- read.table("osylv_spaceuse_raw.csv", header = T, sep =",") head(data_raw)


Input: Add collumns with delta distance and delta time [CODESPLIT] tracks <- tracks %>% 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))


Input: boxplot of maximum dist per id [CODESPLIT] maxdist_plot <- ggplot(daily_perid, aes(x= sex, y=max_dist_perid, fill = sex)) + theme_bw(20) + geom_boxplot(aes(fill = sex), outlier.shape = NA) + labs(y = "Longest movement (m)") + geom_jitter(aes(fill=sex), position=position_jitterdodge(0.2), shape = 21, size = 4, alpha=0.4) + facet_wrap(~site, labeller = labeller( site=c(can ="Natural site", oto = "Enclosures"))) + scale_x_discrete(labels= c("F", "M")) + theme(legend.position= "none", axis.title.x = element_blank(), axis.ticks.x = element_blank(), axis.text.x = element_text(color = "black", size = 18), aspect.ratio = 3) + ylim(0, 25) # excludes one male point at >40m from Canande maxdist_plot


Input: centering a variable to a range from 0.5 to 0.5 [CODESPLIT] center <- function(x) { minimum <- min(x) maximum <- max(x) return((x - (minimum + maximum)/2)/(maximum - minimum)) }


Input: keep only data from 2003 onwards (because fid started in 2003) [CODESPLIT] survival <- subset(survival, year >2002)


Input: identify influenial points (e.g., cooksD > 6/n)  [CODESPLIT] influential_obs <- as.numeric(names(cooksD)[(cooksD > (6/n))])


Input: function serves to plot all important information what is plotted can be modified by whatplot argument first  predict value line second  confidence interval third  points fourth  axis fifth  summary of the end point sixth  corresponding line [CODESPLIT] nice.plot<-function(X=describe$generation,Y,maxY,minY=0,col,whatplot=c(T,T,T,T,T,T),ofset=0,name="",labs=c(minY,ifelse(explarge==T,signif(maxY,nsignif),maxY)),span=0.18,end=length(X),roundrep=0,nsignif=3,percentual=F,explarge=F,labrep=ifelse(explarge==T,signif((ci[,1][newend]*(maxY-minY)+minY),nsignif),ifelse(percentual==T,paste(round((ci[,1][newend]*(maxY-minY)+minY)*100,roundrep),"%",sep=""),round((ci[,1][newend]*(maxY-minY)+minY),roundrep))),cextext=1,lwdmain=2,mtextcex=1,firstax=-0.3,smooth=F){ col.li<-col col.ci<-paste(col,"20",sep="") col.po<-paste(col,"33",sep="") Y<-(Y-minY)/(maxY-minY) if(whatplot[3]==T){ points(X[1:end],Y[1:end],col=col.po,pch=16) } tryCatch({ lo <- loess(Y~X,degree=1,span=span) newX <- seq(min(X),max(X), length.out=1000) ci = cbind( predict(lo, data.frame(X=newX)), predict(lo, data.frame(X=newX))+ predict(lo, data.frame(X=newX), se=TRUE)$se.fit*qnorm(1-.05/2), predict(lo, data.frame(X=newX))- predict(lo, data.frame(X=newX), se=TRUE)$se.fit*qnorm(1-.05/2) ) }, error = function(e){ print("warning: loess returned error, original values instead of loess smoothed curved are visualized") newX <- X ci = cbind(Y,Y,Y) }) newend<-which.min(abs(newX-end)) if(smooth==F){ newY <- approx(Y,n=1000)$y ci <- cbind(newY,newY,newY) } if(whatplot[1]==T){ lines(newX[1:newend], ci[,1][1:newend], lwd=lwdmain,col=col.li) } if(whatplot[2]==T){ if(smooth==T){ polygon(c(newX[1:newend],rev(newX[1:newend])), c(ci[,2][1:newend],rev(ci[,3][1:newend])), col=col.ci,border=NA) } } if(whatplot[4]==T){ par(mgp=c(3,ofset+firstax,ofset+firstax-0.2)) axis(2,at=c(0,1),lab=c("",""),col=col.li,col.axis=col.li,tck=-0.008) mtext(name,2,line=ofset+firstax,col=col.li,cex=mtextcex) mtext(labs,at=c(0,1),2,line=ofset+firstax,col=col.li,cex=mtextcex) } xtext<-par("usr")[2]-(par("usr")[2]-par("usr")[1])/50 if(whatplot[5]==T){ text(xtext,ci[,1][newend],labrep,col=col.li,xpd=T,pos=4,cex=cextext) } if(whatplot[6]==T){ lines(c(0,xtext),rep(ci[,1][newend],2),col=col.li,lty=3,xpd=T) } }


Input: We draw a lollipop diagram to illustrate color distribution [CODESPLIT] par(ps = PS, mar = c(5, 5, 4, 2) + 0.1) plot(x = graphData$colour, y = graphData$Beach, type = "p", col = col_beach, ylim = c(0, 65), xlab = "Colour", ylab = "Proportion [%]", pch = PCH, xaxt = "n", cex = SS) axis(1, at = seq(1, 6, by = 1), labels = c("White", "Beige", "Grey", "Yellow", "Red", "Black")) par(ps = PS, new = TRUE, mar = c(5, 5, 4, 2) + 0.1) plot(x = graphData$colour, y = graphData$Wreck, type = "p", col = col_wreck, ylim = c(0, 65), axes = FALSE, xlab = "", ylab = "", pch = PCH, cex = SS) arrows(x0 = graphData$colour, x1 = graphData$colour, y0 = graphData$Beach, y1 = graphData$Wreck, angle = 90, length = 0, ) legend("topright", legend = c("Beach", "Wreck"), fill = c(col_beach, col_wreck), bty = "n")


Input: Extract model statistics   Extract coefficients and std errors [CODESPLIT] model_coefs <- glmm_list %>% plyr::ldply(.fun = tidy) %>% subset(group == 'fixed') %>% droplevels


Input: Regression test for funnel plot asymmetry [CODESPLIT] res <- rma(Z_value,Z_var, data=data1, measure = "ZCOR", method = "ML") regtest(res, predictor = "vi")


Input: build a new matrix that includes the formatted correlations and their significance stars [CODESPLIT] Rnew <- matrix(Rformatted, ncol = ncol(x)) rownames(Rnew) <- colnames(x) colnames(Rnew) <- paste(colnames(x), "", sep =" ")


Input: CLEAR ENVIRONMENT   function to clear the environment after running a script while keeping important objects  use clear_environment: add store_to_keep variable with list variables;;  tip: include a variable with curr_env [CODESPLIT] clear_environment <- function(keep, # vector with variable-names to be excluded from cleaning all=ls(envir=pos.to.env(1))){ rm(list = all[! all %in% keep], envir = pos.to.env(1)) }


Input: boxplot visualizing the differences between the three languages [CODESPLIT] par(mfrow = c(1,1)) boxplot(ReadRate ~ Language, data = joint.read_rate, main = "Reading rate, words/minute")


Input: zscore RSES T1 and T2 [CODESPLIT] df2$RSES1Z <- (df2$RSES1 - mean(df2$RSES1))/sd(df2$RSES1) df2$RSES2Z <- (df2$RSES2 - mean(df2$RSES2, na.rm = TRUE))/sd(df2$RSES2, na.rm = TRUE)


Input: ANALYSES  Does Att Valence differ across Sections, OA Practice, and Level?  [CODESPLIT] mod_attvalence <- lmer(Att~Level*Section*OAPractice+(1|Responder_ID), df_attvalence) summary(mod_attvalence) anova(mod_attvalence) eta_sq(mod_attvalence, partial = TRUE)


Input: Create variable Past_Future from Item. [CODESPLIT] df_use$Past_Future <- recode(df_use$Item, P1Use01 = "In the past 12 months",P1Use02 = "In the following 12 months", P2Use01 = "In the past 12 months",P2Use02 = "In the following 12 months", P3Use01 = "In the past 12 months",P3Use02 = "In the following 12 months", P4Use01 = "In the past 12 months",P4Use02 = "In the following 12 months", P5Use01 = "In the past 12 months",P5Use02 = "In the following 12 months")


Input: Calculate average level of Att across Perspectives. [CODESPLIT] df_use_attvalence$Att <- rowMeans(df_use_attvalence[,c('Att_DailyLife', 'Att_ResearchField', 'Att_PublicSociety')], na.rm=TRUE)


Input: Formula and family specification   In our case, setting `k  4` and `bs  'cr'` in the mgcv::s() smooth term is  not overly restrictive (checked by running the frequentist mgcv::gam()  function for each existing activity index in turn, thereby varying arguments  `k` and `bs`, and then checking the summary() of the resulting fits), but in a  future (prospective) study, the mgcv::s() settings need to be checked again:  [CODESPLIT] C_formula <- as.formula(paste(voutc, "~", paste0("s(", vactidx_i, ", k = 4, bs = 'cr')"))) C_family <- cumulative(link = "logit", link_disc = "log", threshold = "flexible")


Input: display relationships between WVSES and associated variables [CODESPLIT] ggplot(df11, aes(WVSES, SE)) + geom_jitter() ggplot(df11, aes(WVSES, SISE)) + geom_jitter() ggplot(df11, aes(WVSES, ANX)) + geom_jitter() ggplot(df11, aes(WVSES, AVO)) + geom_jitter() ggplot(df11, aes(WVSES, LIFE)) + geom_jitter() ggplot(df11, aes(WVSES, EXTRA)) + geom_jitter() ggplot(df11, aes(WVSES, AGREE)) + geom_jitter() ggplot(df11, aes(WVSES, CON)) + geom_jitter() ggplot(df11, aes(WVSES, NEUR)) + geom_jitter() ggplot(df11, aes(WVSES, OPEN)) + geom_jitter() ggplot(df11, aes(WVSES, SSTA)) + geom_jitter() ggplot(df11, aes(WVSES, SINC)) + geom_jitter() ggplot(df11, aes(WVSES, MDS)) + geom_jitter()


Input: take RSES and run confirmatory factor analysis [CODESPLIT] RSESdata <- data.frame(df11$SE1, df11$SE2, df11$SE3, df11$SE4, df11$SE5, df11$SE6, df11$SE7, df11$SE8, df11$SE9, df11$SE10) singleF.model <- 'SE =~ df11.SE1 + df11.SE2 + df11.SE3 + df11.SE4 + df11.SE5 + df11.SE6 + df11.SE7 + df11.SE8 + df11.SE9 + df11.SE10'


Input: pivot authorlevel data to "longer" authorarticlelevel dataframe  [CODESPLIT] article_author_level <- author_level %>% dplyr::select(FirstName_MI_LastName_str, full_name.kap, Article.1.Code.kap, Article.2.Code.kap, Article.3.Code.kap, Article.4.Code.kap, Article.5.Code.kap, Article.6.Code.kap, Article.7.Code.kap, Article.8.Code.kap, Article.9.Code.kap, Article.10.Code.kap, Gender.apsa, R_E.apsa, PhD.Year, PhD.Institution) %>% pivot_longer(cols = -c(FirstName_MI_LastName_str, full_name.kap, Gender.apsa, R_E.apsa, PhD.Year, PhD.Institution), values_to = "article_title", names_to = "names") %>% subset(article_title != "NA") %>% relocate(article_title)


Input: authorlevel count and proportion for all race / ethnic identity categories [CODESPLIT] summary_race_ethnicity_author <- article_author_level %>% dplyr::select(-c(article_title, names)) %>% distinct() %>% summarize(count = c(sum(white, na.rm = TRUE), sum(black, na.rm = TRUE), sum(east_asian, na.rm = TRUE), sum(south_asian, na.rm = TRUE), sum(latino, na.rm = TRUE), sum(mena, na.rm = TRUE), sum(native, na.rm = TRUE), sum(pacific, na.rm = TRUE), sum(other, na.rm = TRUE))) summary_race_ethnicity_author <- summary_race_ethnicity_author %>% mutate(race_ethnicity = c("White", "Black", "East Asian", "South Asian", "Hispanic or Latino", "Middle Eastern / Arab", "Native", "Pacific Islander", "Other")) %>% mutate(proportion = round(count / sum(count), 2)) %>% dplyr::select(race_ethnicity, count, proportion)


Input: Convert `candidate_page` to a factor. (Facilitates data visualizations and exploration). [CODESPLIT] elxn2015$candidate_page <- factor(elxn2015$candidate_page, levels = c("Harper", "Trudeau", "Mulcair"))


Input: Timestamps are initially encoded as factors. Convert them to POSIXct format to avoid errors. Dates and times are separated and saved as two new variables;; namely, `date_published` and `time_published`. `date_published` must be converted back to POSIXct format. `Time_published` is left as a character string as this format proves easier to work with when plotting timerelated data.  [CODESPLIT] elxn2015$created_time <- anytime(elxn2015$created_time, tz = "America/Los_Angeles") elxn2015$date_published <- as.POSIXct(format(elxn2015$created_time, "%Y-%m-%d")) elxn2015$time_published <- format(elxn2015$created_time, "%H:%M:%S")


Input: Create a new variable from `date_published` to indicate the month each post was published. [CODESPLIT] elxn2015$month_published <- as.POSIXct(elxn2015$date_published, format="%H:%M:%S") elxn2015$month_published <- format(elxn2015$month_published, "%B")


Input: `month_published` is converted to a factor with three levels such that values are chronologically ordered. [CODESPLIT] elxn2015$month_published <- factor(elxn2015$month_published, levels = c("August", "September","October"))


Input: Ensure consistent data types across data sets. IDs are appropriately treated as characters rather than numeric. [CODESPLIT] Facebook_Pages$id <- as.character(Facebook_Pages$id) Facebook_Pages$likes_count <- as.double(Facebook_Pages$likes_count) Facebook_Pages$comments_count <- as.double(Facebook_Pages$comments_count) Facebook_Pages$shares_count <- as.double(Facebook_Pages$shares_count)


Input: run random and fixed effects analyses on the data and calculate confidence intervals for the variables corresponding to heterogeneity (I2, H2 and T2). slab contains a vector of study names to display on the plot.  [CODESPLIT] res <- rma(measure = "MD", m1i = m2,m2i = m1, sd1i = sd2, sd2i = sd1, n1i = n2, n2i = n1, weights = as.numeric(weights.r), slab = c("Mc1", "Mc2", "Mi1", "Mi2", "Mi3", "Mi4", "Mi5", "Mi6", "Mi7", "Mi8" ), method = "DL") res.f <- rma(measure = "MD", m1i = m2,m2i = m1, sd1i = sd2, sd2i = sd1, n1i = n2, n2i = n1, weights = weights.f, method = "FE") con <- confint(res)


Input: 2. Transform precision into partial correlations for interpretation [CODESPLIT] pr2pc <- function(K) { D.Prec = diag(diag(K)^(-.5)) R <- diag(2,dim(K)[1])-D.Prec%*%K%*%D.Prec colnames(R) <- colnames(K) rownames(R) <- rownames(K) return(R) }


Input: 4. BDgraph extract posterior distribution for estimates [CODESPLIT] extractposterior <- function(fit, data, method = c("ggm", "gcgm"), not.cont){ m <- length(fit$all_graphs) k <- 30000 n <- nrow(data) p <- ncol(data) j <- 1 densities <- rep(0, k)


Input: objects to store graph centrality measures [CODESPLIT] degree <- matrix(0, nrow = len, ncol = p) betweenness <- matrix(0, nrow = len, ncol = p) closeness <- matrix(0, nrow = len, ncol = p)


Input: create token named "twitter_token"  [CODESPLIT] twitter_token <- create_token( app = appname, consumer_key = key, consumer_secret = secret, access_token = access_token, access_secret = access_secret)


Input: mean/sd ratings of targets and decoys by condition [CODESPLIT] tapply(dat.long$rating, list(dat.long$condition, dat.long$target), mean) tapply(dat.long$rating, list(dat.long$condition, dat.long$target), function(x) sd(x)/sqrt(length(x)))


Input: mean difference between candidates in each condition [CODESPLIT] round(s[s$target == 'envy.target' & s$condition == 'Baseline', "emmean"] - s[s$target == 'pity.target' & s$condition == 'Baseline', "emmean"],3) round(s[s$target == 'envy.target' & s$condition == 'PityAD', "emmean"] - s[s$target == 'pity.target' & s$condition == 'PityAD', "emmean"],3) round(s[s$target == 'envy.target' & s$condition == 'PityC', "emmean"] - s[s$target == 'pity.target' & s$condition == 'PityC', "emmean"],3) round(s[s$target == 'envy.target' & s$condition == 'EnvyAD', "emmean"] - s[s$target == 'pity.target' & s$condition == 'EnvyAD', "emmean"],3) round(s[s$target == 'envy.target' & s$condition == 'EnvyC', "emmean"] - s[s$target == 'pity.target' & s$condition == 'EnvyC', "emmean"],3)


Input: regression for difference between social/nonsocial [CODESPLIT] b = glmer(choice ~ pchoice1*social +  opchoice2*social + opchoice1 + pchoice2 + (1 + pchoice1 +  opchoice2 + opchoice1 + pchoice2  |code),family = 'binomial',data[data$opponent == 1,] ,control = glmerControl(optimizer="bobyqa", tolPwrss = 1e-10, optCtrl = list(maxfun = 60000))) b = glmer(choice ~ pchoice1*social +  opchoice2*social + opchoice1 + pchoice2 + (1 + pchoice1 +  opchoice2 + opchoice1 + pchoice2  |code),family = 'binomial',data[data$opponent == 0,] ,control = glmerControl(optimizer="bobyqa", tolPwrss = 1e-10, optCtrl = list(maxfun = 60000)))


Input: Principal component analysis with correlation matrix [CODESPLIT] pca <- prcomp(d[, -whi], scale. = T)


Input: Make stacked figure of costs by age [CODESPLIT] stack <- lapply(pe.list.hadza_male, colMeans, na.rm=T) stacks <- as.data.frame(do.call(rbind, stack)) names(stacks) <- c(male.acts, "climbing") stacks$age <- age_seq stacks$Processing <- stacks$light_processing + stacks$other_out_of_camp + stacks$pounding_baobab stack_plot_male <- stacks %>% select(-nonsubsistence, -resting, -light_processing, -other_out_of_camp, -pounding_baobab) %>% gather(key="act", value="cost", carry_firewood_water:climbing, Processing) male_stack_hadza <- ggplot(stack_plot_male, aes(x=age, y=cost, fill=act)) + geom_area() + scale_fill_manual(name="Activity", labels=c("Firewood and water collection", "Chopping", "Climbing", "Eating", "Manufacture", "Food processing", "Walking (during foraging)"), values = brewer.pal(7, "Set1")) + labs(x="Age (years)", y="Energy cost (kcal/day)") + theme_classic(base_size=16) + ggtitle("Hadza: Men") + lims(y=c(0, 750)) stack <- lapply(pe.list.hadza_female, colMeans, na.rm=T) stacks <- as.data.frame(do.call(rbind, stack)) names(stacks) <- female.acts stacks$age <- age_seq stacks$Processing <- stacks$light_processing + stacks$other_out_of_camp + stacks$pounding_baobab stack_plot_female <- stacks %>% select(-nonsubsistence, -resting, -light_processing, -other_out_of_camp, -pounding_baobab) %>% gather(key="act", value="cost", carry_firewood_water:digging, Processing) fhcols <- brewer.pal(8, "Set1")[c(1,2,4,5,6,7)] fhcols[2] <- "#33CCFF" female_stack_hadza <- ggplot(stack_plot_female, aes(x=age, y=cost, fill=act)) + geom_area() + scale_fill_manual(name="Activity", labels=c("Firewood and water collection", "Digging", "Eating", "Manufacture", "Food processing", "Walking (during foraging)"), values = fhcols) + labs(x="Age (years)", y="Energy cost (kcal/day)") + theme_classic(base_size=16) + ggtitle("Hadza: Women") + lims(y=c(0, 750))


Input: create centered age^2 variable for quadratic LGCM [CODESPLIT] qscale <- 100 rndhrs_subset <- rndhrs_subset %>% mutate(CAGE2_T4 = CAGE_T4^2 / qscale, CAGE2_T5 = CAGE_T5^2 / qscale, CAGE2_T6 = CAGE_T6^2 / qscale, CAGE2_T7 = CAGE_T7^2 / qscale, CAGE2_T8 = CAGE_T8^2 / qscale, CAGE2_T9 = CAGE_T9^2 / qscale, CAGE2_T10 = CAGE_T10^2 / qscale, CAGE2_T11 = CAGE_T11^2 / qscale )


Input: put.pvalue   Function to put the pvalues accoridng to the journals guidelines [CODESPLIT] put.pvalue=function(p){ sapply(p, function(x){ if (is.na(x)){pc="NA"} else if (x<0.0001){pc="<0.0001"} else if (0.0001<=x & x<0.001){pc <- sprintf("%.4f", x)} else if (0.049<=x & x<0.05) {pc <- sprintf("%.3f", floor(x*1000)/1000)} else if (0.001<=x & x<0.1){pc <- sprintf("%.3f", x)} else if (0.1<=x){pc <- sprintf("%.2f", x)} return(pc) }) }


Input: wald.test   Function to perform Wald test in logistic or Cox model [CODESPLIT] wald.test <- function(model, ntest){ d <- length(ntest) a <- t(coefficients(model)[ntest]) mat <- vcov(model)[ntest,ntest] value <- as.numeric(a%*%solve(mat)%*%t(a)) pvalue <- pchisq(value, df=d, lower.tail=F) return(list(value=value, df=d, pvalue=pvalue)) }


Input: Function to change pvalues in the stat table with the ones from the model [CODESPLIT] update_table <- function(mymod) { modsum <- summary(mymod) p <- modsum$coefficients[, "Pr(>|t|)"] p <- as.vector(p) p <- pvalr(p, sig.limit = .001, digits = 3) p }


Input: Plot KM Curve [CODESPLIT] tiff("PRAD_KM Curve.tiff", units = "in", width=8, height=6, res=300) ggsurvplot(fit1, D2, risk.table=TRUE, palette = "jco", pval=TRUE, conf.int=FALSE, surv.median.line="hv", ylab= "Survival Probability (%)", xlab= "Time (months)", legend.title = "TX GROUP", pval.coord=c(10,0.25)) dev.off()


Input: now iterate through each participant, take that PP's data frame and add z scores for RT  afterwards, add that PP's data frame to the empty data frame to recreate the main df including z scores  [CODESPLIT] for (aPP in unique(excl2Exp$PP)){ dat <- excl2Exp[excl2Exp$PP == aPP,] dat$zScore <- scale(dat$RespRT, scale = TRUE) excl2Exp2 <- rbind(excl2Exp2, dat) }


Input: ttest on subset 1 (n6/sex/group) [CODESPLIT] p_6m6f = t.test(measure ~ group, data=simdata6each_sub1)$p.value #using 6 each sex, t-tests


Input: box and whisker plot for refined factor scores convert dataframe of factor scores and cluster membership to long form [CODESPLIT] KClusterScores.long <- KClusterScores %>% pivot_longer(c(Sensory, CognitiveDemand, ThreatToSelf, CrossSettings, Safety, States), names_to = c("Factor")) KClusterScores.long$Factor <- factor(KClusterScores.long$Factor, levels = c("Sensory", "CognitiveDemand", "ThreatToSelf", "CrossSettings", "Safety", "States"))


Input: box and whisker plot for nonrefined factor (scale) scores convert dataframe of factor scores and cluster membership to long form [CODESPLIT] scale.KClusterScores.long <- scale.KClusterScores %>% pivot_longer(c(Sensory, CognitiveDemand, ThreatToSelf, CrossSettings, Safety, States), names_to = c("Factor")) scale.KClusterScores.long$Factor <- factor(scale.KClusterScores.long$Factor, levels = c("Sensory", "CognitiveDemand", "ThreatToSelf", "CrossSettings", "Safety", "States"))


Input: calculate logrank Zstatistics assuming balanced risk set (in OE, E is always 0.5)  [CODESPLIT] zs <- sapply(1:(CureVobs1 + CureVobs0), function(n) (sum(CureVobs1s[1:n]) - n/2)/sqrt(n/4))


Input: Statistics  check distributions  check normal distribution of PSE's [CODESPLIT] qqnorm(AllPSEs$Tennis.thre) shapiro.test(AllPSEs$Tennis.thre) # p < .01, qqnorm(AllPSEs$SoccerD.thre) shapiro.test(AllPSEs$SoccerD.thre) # p = .14, qqnorm(AllPSEs$SoccerI.thre) shapiro.test(AllPSEs$SoccerI.thre) # p < .01 qqnorm(AllPSEs$Coin.thre) shapiro.test(AllPSEs$Coin.thre) # p = .04


Input: TEST 1: wilcoxon's signed rank test for direct/ indirect trials [CODESPLIT] (TestID <- wilcox.test(EffectDirect, EffectIndirect, paired = TRUE))


Input: add a column with "time_interval" : either 9:00;;13:00;;17:00;;21:00     for this, check the $created column and depending on which interval it is in, create a new column with mutate  [CODESPLIT] df_ESM_data_analysis = df_ESM_data_analysis %>% mutate( time_interval = case_when( format(created,"%H:%M") >= param_timepoints[1] & format(created,"%H:%M") < param_timepoints[2]  ~ param_timepoints[1], format(created,"%H:%M") >= param_timepoints[2] & format(created,"%H:%M") < param_timepoints[3]  ~ param_timepoints[2], format(created,"%H:%M") >= param_timepoints[3] & format(created,"%H:%M") < param_timepoints[4]  ~ param_timepoints[3], format(created,"%H:%M") >= param_timepoints[4] & format(created,"%H:%M") < param_t_end          ~ param_timepoints[4], ) )


Input: first find the duplicates according to n_obs and time_interval [CODESPLIT] df_ESM_data_analysis = df_ESM_data_analysis %>% arrange(session, created) %>% group_by(session, n_obs, time_interval) %>% mutate(num_dups = n(), dup_id = row_number()) %>% ungroup() %>%


Input: plot perseverance as a function of n_obs for each subject [CODESPLIT] gdat <- groupedData(perseverance ~ n_obs | session, data=df_ESM_data_analysis_noNAnoOutliers) plot(gdat)


Input: put alpha together with descriptive statistics [CODESPLIT] questionnaire_stats <- bind_cols(questionnaires_stats, scores_alpha) %>% dplyr::select(-name, -vars)


Input: Correlation plot (colors on top, numbers on bottom)  JUST MEANS (aggregated within person)  [CODESPLIT] corrplot(means, p.mat = res2$p, insig = "label_sig", sig.level = c(.001, .01, .05), pch.cex = .9, pch.col = "gray", method = "color", tl.col = "black", tl.cex = 1, cl.offset = 0.25, cl.cex = 0.75) corrplot(means, method="number", col = "black", add = TRUE, cl.pos = "n", tl.pos = "n", type = "lower", number.cex = .60, number.digits = 2, tl.col = "black", cl.offset = 4)


Input: Independence test: two ways (HSIC or Nonlinear corr)  HSIC [CODESPLIT] if (independence == "hsic") { hsic.p <- dhsic.test(ry, rx, method = "gamma", kernel = "gaussian")$p.value pval[i] <- hsic.p }