Input: Correlation table (only with complete cases  so takes out data from single parent) [CODESPLIT] means <- cor(mean_data_mat[,c(2:12)], use = "complete.obs") # Correlation matrix res2 <- cor.mtest(mean_data_mat[,c(2:12)], conf.level = .95, use = "complete.obs") # p-values


Input: EXCLUDE PPN WITH RT < or > 3 SD [CODESPLIT] max_sd_rt <- print(mean(data.rt.check$rt)+3*sd(data.rt.check$rt)) ppn.exclude.rt <- print(filter(data.rt.check, rt >= max_sd_rt)$ppn)


Input: Calculate and plot difference between the distributions [CODESPLIT] postDiff <- forModel2plotA$b_cfaInequality_nat - forModel2plotB$b_cfaSocial_control_nat %>% as.data.frame() ggplot(postDiff, aes(.)) + geom_histogram(bins = 100, color = "black", fill = "lightgray") quantile(postDiff, c(0.025, 0.975)) #So 95% confidence interval of the difference lies above 0


Input: Exclude participants with accuracy less than 0.8 [CODESPLIT] d_lowAcc =  CQ_acc %>% filter(accuracy < 0.8) d = d[!d$Subject %in% d_lowAcc$Subject,] rm(list=ls()[! ls() %in% c("d")])


Input: check the correlation between even and oddnumbered sets  Pearson [CODESPLIT] print(corr.test(person$ConditionOr_even, person$ConditionOr_odd), short = FALSE) KH_Correct(-.09) #.16 print(corr.test(person$ConditionOr_even, person$ConditionOr_odd), short = FALSE) KH_Correct(-.11) #.20


Input: model criticism (remove data points with abs(standardized residuals) over 2.5) [CODESPLIT] de_trim<- de[abs(scale(resid(m_de)))<2.5,] do_trim<- do[abs(scale(resid(m_do)))<2.5,] m_de_mc = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = de_trim, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) m_do_mc = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = do_trim, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5)))


Input: Add new ParentIndex column in trialSummary and fill with NA [CODESPLIT] trialSummary[,"ParentIndex"] <- NA


Input: Lookup the parent row index of the stimulus string in s.data and insert it for social [CODESPLIT] for(k in 1:length(trialSummary$Stimulus)){ trialSummary$ParentIndex[k] <- which(s.data$Stimulus == trialSummary$Stimulus[k])[1] } trialSummary$AgeGroup <- s.info[i,3] trialSummary$Sex <- s.info[i,4] trialSummary$ID <- i


Input: Fixation Count   custom mean function: mean of fixation count left and right eye (if only ONE eye contains 0.0 > no averaging)  https://stackoverflow.com/questions/45998419/aggregategroupmeanswhileignoringzerosunless0istheonlyvalue [CODESPLIT] meanSubset.FixCount = aggregate(Fixation.Count~Stimulus+AOI.Name, data=s.data,  FUN=(function(x){ifelse(sum(x==0)>0 & sum(x !=0) >0, mean(x[x>0]), mean(x))}))


Input: 3) CALCULATION OF ESTIMATED MARGINAL MEANS   Tests for differences in response to jargon and get data for plots [CODESPLIT] at_jarg <- list(Jargon = c("Less", "More"), TrvlAdv_Atten = "Cons", BackgrYrsOfExp = "6-10 yrs", BackgrDaysPerYr = "11-20 days", BullUseType = "D", cut = "3|4") grid_jarg <- ref_grid(clmm_underjar, 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: create data frame for mean acceptrate (%) per participant, per effortlevel in 'young' group  [CODESPLIT] d.young.effort.1 <- filter(d, Group == 'Young') %>% group_by(ID, Agent, Effort) %>% summarise(m = mean(Choice)*100)


Input: create data frame reflecting mean accept rate (%) per participant at each rewardlevel in 'old' group [CODESPLIT] d.reward.old.1 <- filter(d, Group == 'Old') %>% group_by(ID, Agent, Reward) %>% summarise(m = mean(Choice)*100)


Input: create data frame reflecting overall mean accept rate (%) and SE at each rewardlevel in 'old' group [CODESPLIT] d.reward.old.2 <- d.reward.old.1 %>% group_by(Agent, Reward) %>% summarise(SE = std.error(m), M = mean(m, na.rm = T))


Input: Welch's oneway ANOVA [CODESPLIT] anova_dehyd = df_dehyd %>% welch_anova_test(dehyd ~ cond) anova_dist_ran = df_dist_ran %>% welch_anova_test(dist ~ cond) anova_run_time = df_run_time %>% welch_anova_test(time ~ cond) anova_heat_time = df_heat_time %>% welch_anova_test(time ~ cond) anova_tcmax = df_tcmax %>% welch_anova_test(tcmax ~ cond) anova_tcmin = df_tcmin %>% welch_anova_test(tcmin ~ cond) anova_duration = df_duration %>% welch_anova_test(duration ~ cond) anova_thermal_load = df_thermal_load %>% welch_anova_test(thermal_load ~ cond) anova_heat_time = df_heat_time %>% welch_anova_test(heat_time ~ cond)


Input: Function to generate the true value for the Diamond Ratio [CODESPLIT] true.ratio <- function(n1, n2, tau, delta){ v <- (n1 + n2)/(n1*n2) + delta^2/2/(n1 + n2) j <- 1 - 3/(4*(n1 + n2 - 2) - 1) v.g <- (j^2)*v w <- 1/v.g w.star <- 1/(v.g + tau^2) var.fixed <- 1/sum(w) var.random <- 1/sum(w.star) sqrt(var.random/var.fixed) }


Input: lmer model for dimorphism [CODESPLIT] Lat.ML<-lmer(Latency.cen~Sex+scale(Mass, scale = F)+ Generation+Pop+Stage+Injured+scale(Temp, scale = F)+ scale(Time, scale = F)+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(Lat.ML) drop1(Lat.ML) OF.ML<-lmer(sqrt(OF.Dist)~Sex+scale(Mass, scale = F)+ Generation+Pop+Stage+Injured+scale(Temp, scale = F)+ scale(Time, scale = F)+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(OF.ML) drop1(OF.ML) AP.ML<-lmer(sqrt(AP.Dist)~Sex+scale(Mass, scale = F)+ Generation+Pop+Stage+Injured+scale(Temp, scale = F)+ scale(Time, scale = F)+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(AP.ML) drop1(AP.ML) Lat.ML<-lmer(Latency.Cens~Sex+Mass+Generation+Pop+Stage+Injured+Temp+ Time+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(Lat.ML) drop1(Lat.ML) OF.ML<-lmer(OF.Dist~Sex+Mass+Generation+Pop+Stage+Injured+Temp+ Time+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(OF.ML) drop1(OF.ML) AP.ML<-lmer(AP.Dist~Sex+Mass+Generation+Pop+Stage+Injured+Temp+ Time+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(AP.ML) drop1(AP.ML)


Input: return the lastN characters of a string [CODESPLIT] fn$lastN<-function(string, n){ l<-nchar(string) result<-substr(string,l-n+1,l) result }


Input: Linear mixed effects model for reproduction bias [CODESPLIT] mod_full <- lmer(Prct_Bias ~ ContextC*(GMSI_Gen_Z + OrderC*Distort) + (1|Subject), data=dat2)


Input: Extra function   MM to inchconversion for plot [CODESPLIT] MMtoInch <- function(MM) { z <- MM / 25.4 return(z) }


Input: plot mean force (+/ SE) at each effortlevel in old group AND show individual data points [CODESPLIT] plot.force.old.2 <- ggplot(d.force.old, aes(x = Effort, y = m)) + geom_point(aes(group = Agent, color = Agent), position = position_dodge(width = 0.3), alpha = 0.4, shape = 1, size = 0.5) + geom_errorbar(data = d.force.old.summary, aes(group = Agent, color = Agent, ymin = m - SE, ymax = m + SE), position = position_dodge(0.02), alpha = 1, width = 0.2) + geom_line(data = d.force.old.summary, aes(group = Agent, color = Agent), position = position_dodge(0.02)) + scale_x_continuous(name = 'Effort level', breaks = seq(2, 6, 1)) + scale_y_continuous(name = 'Force exerted (normalised AUC)', breaks = seq(0.0, 1.0, 0.2)) + scale_color_brewer(palette = 'Set1') + coord_cartesian(xlim = c(2, 6), ylim = c(0.30, 1.0)) + theme_classic() + theme(legend.position = c(0.9, 0.15)) + theme(axis.text=element_text(size = 11), axis.title=element_text(size = 13)) plot.force.old.2 ggsave(filename = 'plot_force_old_v2.pdf', plot.force.old.2, height = 5, width = 4)


Input: plot mean force (no SE) at each effortlevel in old group AND show individual data points [CODESPLIT] plot.force.old.3 <- ggplot(d.force.old, aes(x = Effort, y = m, group = Agent, color = Agent, fill = Agent)) + geom_point(data = d.force.old, aes(group = Agent, color = Agent), position = position_dodge(width = 0.3), alpha = 0.4, shape = 1, size = 0.5) + geom_smooth(method = 'lm', alpha = 0.3, size = 0.6, se = F) + coord_cartesian(xlim = c(2, 6), ylim = c(0.35, 0.9)) + scale_x_continuous(name = 'Effort level', breaks = seq(2, 6, 1)) + scale_y_continuous(name = 'Force exerted (normalised AUC)', breaks = seq(0, 1.0, 0.2)) + scale_color_brewer(palette = 'Set1') + scale_fill_brewer(palette = 'Set1') + theme_classic() + theme(legend.position = c(0.9, 0.15)) + theme(axis.text=element_text(size = 11), axis.title=element_text(size = 13)) plot.force.old.3 ggsave(filename = 'plot_force_old_v3.pdf', plot.force.old.3, height = 5, width = 4)


Input: bootstrap modindices of item residual covariances [CODESPLIT] cfa.csurf.bl.full.1.boot <- bootstrapLavaan(cfa.csurf.bl.full.1, R = 5000, FUN = function(x) {modindices(x)$mi}, verbose = TRUE) cfa.csurf.bl.full.1.boot <- data.frame(cfa.csurf.bl.full.1.boot) cfa.csurf.fu1.full.1.boot <- bootstrapLavaan(cfa.csurf.fu1.full.1, R = 5000, FUN = function(x) {modindices(x)$mi}, verbose = TRUE) cfa.csurf.fu1.full.1.boot <- data.frame(cfa.csurf.fu1.full.1.boot) cfa.csurf.bl.deponly.1.boot <- bootstrapLavaan(cfa.csurf.bl.deponly.1, R = 5000, FUN = function(x) {modindices(x)$mi}, verbose = TRUE) cfa.csurf.bl.deponly.1.boot <- data.frame(cfa.csurf.bl.deponly.1.boot) cfa.csurf.fu1.deponly.1.boot <- bootstrapLavaan(cfa.csurf.fu1.deponly.1, R = 5000, FUN = function(x) {modindices(x)$mi}, verbose = TRUE) cfa.csurf.fu1.deponly.1.boot <- data.frame(cfa.csurf.fu1.deponly.1.boot)


Input: recode played hours into numeric (if multiple numbers, choose the first one)  [CODESPLIT] mydf$Hours <- as.numeric(stri_extract_first_regex(mydf$Hours, "[0-9]+"))


Input: recode streamed hours into numeric (if multiple numbers, choose the first one)  [CODESPLIT] mydf$streams <- as.numeric(stri_extract_first_regex(mydf$streams, "[0-9]+"))


Input: recode narcisiim scale into numeric (if multiple numbers, choose the first one)  [CODESPLIT] mydf$Narcissism <- as.numeric(stri_extract_first_regex(mydf$Narcissism, "[0-9]+"))


Input: Display and rank games by frequency [CODESPLIT] tGames <- as.data.frame(table(data_main$Game)) View(tGames[order(tGames$Freq, decreasing = TRUE), ])


Input: Display and rank residence country by frequency [CODESPLIT] tResidence <- as.data.frame(table(data_main$Residence)) View(tResidence[order(tResidence$Freq, decreasing = TRUE), ])


Input: Display and rank country of birth by frequency [CODESPLIT] tBirth <- as.data.frame(table(data_main$Birthplace)) View(tBirth[order(tBirth$Freq, decreasing = TRUE), ])


Input: Loop to downsample data based on minimum time between points Time parameter is set in "while(diff < time in minutes)"  [CODESPLIT] trajectory_dsmpl <- data.frame() ids <- unique(trajectory.df$id) for(i in ids) { traj = subset(trajectory.df, trajectory.df$id == i) for(i in 1:nrow(traj)) { diff <- difftime(traj$dt[i+1], traj$dt[i], units = "mins") if(is.na(diff)) {break} while(diff < 15) { traj <- traj[-(i+1),] diff <- difftime(traj$dt[i+1], traj$dt[i], units = "mins") if(is.na(diff)) {break} } } trajectory_dsmpl <- bind_rows(trajectory_dsmpl, traj) } trajectory_dsmpl <- trajectory_dsmpl %>% group_by(id) %>% mutate(time_diff = difftime(dt, lag(dt, n = 1L), units = "min"), delta_x = x_utm - lag(x_utm, n = 1L), delta_y = y_utm - lag(y_utm, n = 1L), dist = sqrt(delta_x^2+delta_y^2))


Input: Clean up dataframe and create a grouping variable 50m or 200m based on translocation distance [CODESPLIT] trajectory.df <- trajectory.df %>% ungroup %>% mutate(trans_group = ifelse(dist.y > 100, "200m", "50m")) %>% dplyr::select(id, sex, trans_group, trans_dist = dist.y, dt = dt.x, x_utm = x_utm.x, y_utm = y_utm.x, x_new, y_new, dist = dist.x, time_lag_min)


Input: Barplot of homing success with percents as title 50m [CODESPLIT] bar_50m <- homing_variables %>% filter(trans_group == "50m") %>% ggplot(aes(x = sex, fill = sex, alpha = as.factor(homing_bin))) + geom_bar(position = "fill", color = "black", size = 2) + scale_fill_manual(values = c("#F8766D", "#00BFC4")) + coord_flip() + theme(legend.position="none", aspect.ratio = 0.4, axis.ticks.length = unit(.25, "cm"), axis.ticks.y = element_blank(),


Input: Barplot of homing success with percents as title 200m [CODESPLIT] bar_200m <- homing_variables %>% filter(trans_group == "200m") %>% ggplot(aes(x = sex, fill = sex, alpha = as.factor(homing_bin))) + geom_bar(position = "fill", color = "black", size = 2) + scale_fill_manual(values = c("#F8766D", "#00BFC4")) + coord_flip() + theme(legend.position="none", aspect.ratio = 0.4, axis.ticks.length = unit(.25, "cm"), axis.ticks.y = element_blank(),


Input: 2 Factor Model, correlated factors  [CODESPLIT] model_2f <- 'f_a =~ parcel_a_1+parcel_a_2+parcel_a_3 # Agency f_c =~ parcel_c_1+parcel_c_2+parcel_c_3 # Communion ' fit.model_2f <- cfa(model_2f, data=data, std.lv=T) summary(fit.model_2f, fit.measures=TRUE, standardized = TRUE) # Robust model: CFI = .99, RMSEA = .02


Input: Factor Anaylsis with 3 factors [CODESPLIT] factors <- fa(items, nfactors = 3)


Input: binomial logistic regression testing for effect of condition [CODESPLIT] model1 <- glm(cbind(PredictTotal, PredictTrials-PredictTotal) ~ Condition, data = study1, family=binomial) summary(model1) Anova(model1, type="III", test="Wald")


Input: binomial logistic regression testing for effects of behavior and context [CODESPLIT] model3 <- glm(cbind(PredictMatch, NumQs-PredictMatch) ~ Behavior + Context + Behavior*Context, data = study2, family=binomial) Anova(model3, type="III", test="Wald")


Input: Function that creates a TRUE/FALSE matrix of nonbiological father availibility from two numbers that are recorded in the data  FROM and TILL. The function does this by evaluating the presence of the caretaker using < and >  for each interval in question. [CODESPLIT] giveage<-function(data){ FROM<-data$Grew_up_from_nonbiol TILL<-data$Grew_up_till_nonbiol ages<-data.frame(x=rep(NA,nrow(data))) for(i in 1:15){ j<-i-1 text<-paste("grew",j,i,"<-TILL>",j,"&FROM<",i,sep="") eval(parse(text=text)) text<-paste("ages<-cbind(ages,grew",j,i,")",sep="") eval(parse(text=text)) } ages<-ages[,-1] return(ages) }


Input: Function that calculates differences between nonbiological fathers and partners in both groups (Nonbiological father currently present, nonbiological father currently absent) for each year in the analysis.  [CODESPLIT] deltas<-function(diff,ages){ deltaT<-NA deltaF<-NA for(i in 1:15){ deltaT[i]<-mean(diff[ages[i]==T],na.rm=T) deltaF[i]<-mean(diff[ages[i]==F],na.rm=T) } return(rbind(deltaT,deltaF)) }


Input: Function that repeats last and first item of a vector  usefull if we want to draw plots and CI all the way to the border of the plotting region. [CODESPLIT] ad<-function(v){ return(c(v[1],v,v[length(v)])) }


Input: Function that plots a text with an outline. it is equivalent to TeachingDemos shadowtext function described at: https://stackoverflow.com/questions/29303480/textlabelswithoutlineinr [CODESPLIT] shadowtext <- function(x, y=NULL, labels, col='white', bg='black', theta= seq(pi/4, 2*pi, length.out=40), r=0.1, ... ) { xy <- xy.coords(x,y) xo <- r*strwidth('A') yo <- r*strheight('A') for (i in theta) { text( xy$x + cos(i)*xo, xy$y + sin(i)*yo, labels, col=bg, ... ) } text(xy$x, xy$y, labels, col=col, ... ) }


Input: Functions coonducting logit and inverse logit transformation (p to logodds and back) [CODESPLIT] logit<-function(x){log(x/(1-x))} inv_logit<-function(x){exp(x)/(1+exp(x))}


Input: read in all text files at working directory:  all_data  read_dir(      pattern  "\\.txt$",      stringsAsFactors  FALSE,      fill  TRUE,      header  TRUE  )  look at the columns and what they contain:  str(all_data)  look at data range, potential outliers:  peek_neat(all_data, 'rt')  the same per various groupings: ' peek_neat( '     dat  all_data, '     values  'rt', '     group_by  'response', '     round_to  1 ' ) ' peek_neat(all_data, 'rt', c('color', 'valence'), '           round_to  1)  histogram and QQ plots for the same:  peek_neat(all_data, 'rt', c('color', 'valence'), f_plot  plot_neat)  peek_neat(all_data, 'rt', c('color', 'valence'), f_plot  ggpubr::ggqqplot)  [CODESPLIT] filenames = list.files(pattern = "^expsim_color_valence_.*\\.txt$") # get all result file names for (file_name in enum(filenames)) {


Input: look at rt data range and distribution, potential outliers  [CODESPLIT] peek_neat( data_final, values = c( 'rt_green_negative', 'rt_red_negative', 'rt_green_positive', 'rt_red_positive' ), group_by = 'condition', f_plot = plot_neat )


Input: now ANOVA on RTs for the main question: Color/Valence/Group interaction  with basic factorial plot of mean rt means  (95% CI for error bars by default) [CODESPLIT] anova_neat( data_final, values = c( 'rt_green_negative', 'rt_green_positive', 'rt_red_negative', 'rt_red_positive' ), within_ids = list( color = c('green', 'red'), valence = c('positive', 'negative') ), between_vars = 'condition', plot_means = TRUE, norm_tests = 'all', norm_plots = TRUE, var_tests = TRUE )


Input: kmeans clustering   Repeating exhaustive search for the kmeans clustering,  with a plot of the best clustering for each k  [CODESPLIT] KM2 <- kmeans.ex(PCA.Z$x, 2) KM2b <- KM2$best with(PCA.Z, { plot(x[, 1:2], pch = 20, asp = 1, col = cols[KM2b$cluster]) text(x[, 1:2], rownames(x), pos = 3) addhull(x[, 1], x[, 2], factor(KM2b$cluster), col.h = cols[1:2]) }) points(KM2b$centers[, 1], KM2b$centers[, 2], pch = 15, col = cols[1:2]) KM3 <- kmeans.ex(PCA.Z$x, 3) KM3b <- KM3$best with(PCA.Z, { plot(x[, 1:2], pch = 20, asp = 1, col = cols[KM3b$cluster]) text(x[, 1:2], rownames(x), pos = 3) addhull(x[, 1], x[, 2], factor(KM3b$cluster), col.h = cols[1:3]) }) points(KM3b$centers[, 1], KM3b$centers[, 2], pch = 15, col = cols[1:3]) KM4 <- kmeans.ex(PCA.Z$x, 4) KM4b <- KM4$best with(PCA.Z, { plot(x[, 1:2], pch = 20, asp = 1, col = cols[KM4b$cluster]) text(x[, 1:2], rownames(x), pos = 3) addhull(x[, 1], x[, 2], factor(KM4b$cluster), col.h = cols[1:4]) }) points(KM4b$centers[, 1], KM4b$centers[, 2], pch = 15, col = cols[1:4])


Input: write the number of observed variables to the top [CODESPLIT] header[1] <- paste(ifelse(Flow==FALSE , length(unique(df$Point)), length(unique(df$Point)) + 1), "     : number of observed variables") write(header[1:(grep("subbasin number",header) - 2)], file = outfile) header[1] <- paste(n + n1,"     : number of observed variables") write(header[1:(grep("subbasin number",header) - 2)], file = outfile)


Input: "Remove" first word of each page, except on the first page where the title was the first word (but the title has already been removed)   [CODESPLIT] PAST_M_21$gazedur[!duplicated(PAST_M_21$page) & PAST_M_21$page > 1] <- NaN PAST_M_21$fixdur[!duplicated(PAST_M_21$page) & PAST_M_21$page > 1] <- NaN PRES_O_21$gazedur[!duplicated(PRES_O_21$page) & PRES_O_21$page > 1] <- NaN PRES_O_21$fixdur[!duplicated(PRES_O_21$page) & PRES_O_21$page > 1] <- NaN PRES_M_21$gazedur[!duplicated(PRES_M_21$page) & PRES_M_21$page > 1] <- NaN PRES_M_21$fixdur[!duplicated(PRES_M_21$page) & PRES_M_21$page > 1] <- NaN PAST_O_21$gazedur[!duplicated(PAST_O_21$page) & PAST_O_21$page > 1] <- NaN PAST_O_21$fixdur[!duplicated(PAST_O_21$page) & PAST_O_21$page > 1] <- NaN


Input: create a vector with the rounded values (names(valM)  adj_dimension) [CODESPLIT] valM <- round(colMeans(d, na.rm = T), 2)


Input: Divide estimates, posterior sd, lower CI, and upper CI of the withinperson effects by the withinperson SDs of social interactions  to obtain coefficients that are standardized with respect to the DV only  [CODESPLIT] Values_Analysis1_Model1$est[rows] <- Values_Analysis1_Model1$est[rows] / sqrt(variances) Values_Analysis1_Model1$posterior_sd[rows] <- Values_Analysis1_Model1$posterior_sd[rows] / sqrt(variances) Values_Analysis1_Model1$lower_2.5ci[rows] <- Values_Analysis1_Model1$lower_2.5ci[rows] / sqrt(variances) Values_Analysis1_Model1$upper_2.5ci[rows] <- Values_Analysis1_Model1$upper_2.5ci[rows] / sqrt(variances) Values_Analysis1_Model1_Pers$est[rows] <- Values_Analysis1_Model1_Pers$est[rows] / sqrt(variances) Values_Analysis1_Model1_Pers$posterior_sd[rows] <- Values_Analysis1_Model1_Pers$posterior_sd[rows] / sqrt(variances) Values_Analysis1_Model1_Pers$lower_2.5ci[rows] <- Values_Analysis1_Model1_Pers$lower_2.5ci[rows] / sqrt(variances) Values_Analysis1_Model1_Pers$upper_2.5ci[rows] <- Values_Analysis1_Model1_Pers$upper_2.5ci[rows] / sqrt(variances)


Input: Heart rate  median considered as mean when mean not "available"  [CODESPLIT] DATA$HR <-  ifelse(is.na(DATA$"all_mean_HR")==T, DATA$all_median_HR, DATA$"all_mean_HR")


Input: Keep the removed people to plot separately [CODESPLIT] nograph_removed <- nograph[nograph$belief_in_medicine >= 7,] graph_removed <- graph[graph$belief_in_medicine >= 7,]


Input: Means and Standard Deviations of Conditions  Experiencer [CODESPLIT] exp <- data.all[ which(data.all$condition == 'experiencer'),] round(mean(exp$rating), 2) round(sd(exp$rating), 2)


Input: Q3 create a new data set that contains the first 300 cases from the subset you have just created above [CODESPLIT] working_data_2 <- slice(working_data_1, 1:300)


Input: Q5 create one single subset (based on your original dataset) where you   select the variables id sex age source1 discuss flushot vacc1 and refus   select cases 150  450 only   change the name of the variable source1 to 'Main_Source'   select particpants older than 39 years of age, and who vaccinate their own children (mandatory and reccommended vaccines) hint: %>%  MAGRITTR package  [CODESPLIT] working_data_final <- ex1_data %>% select(id, sex, age, source1, discuss, flushot, vacc1, refus) %>% rename(Main_Source=source1) %>% slice(150:450) %>% filter(age > 39 & vacc1 == 'Mandatory + all recommended')


Input: calculating r for each iteration, r as the mean of those five r  RAQ_R and QoL  [CODESPLIT] r_QoL <- (with(subsample_PG, cor(RAQ_Totalscore[.imp==1 & Sample==1], QoL[.imp==1 & Sample==1]))+ with(subsample_PG, cor(RAQ_Totalscore[.imp==2 & Sample==1], QoL[.imp==2 & Sample==1]))+ with(subsample_PG, cor(RAQ_Totalscore[.imp==3 & Sample==1], QoL[.imp==3 & Sample==1]))+ with(subsample_PG, cor(RAQ_Totalscore[.imp==4 & Sample==1], QoL[.imp==4 & Sample==1]))+ with(subsample_PG, cor(RAQ_Totalscore[.imp==5 & Sample==1], QoL[.imp==5 & Sample==1])))/5 p_QoL <- pt((r_QoL*sqrt(nrow(subsample_PG)/6-2)/sqrt(1-r_QoL)), nrow(subsample_PG)/6-2)


Input: scaling RAQR Score [CODESPLIT] reg_with_PG_CG_scaled <- with(data=as.mids(reg_PG_CG), exp=lm(scale(RAQ_Totalscore)~Sample+Gender+Age_groups+Level_of_education)) str(summary(pool(reg_with_PG_CG_scaled))) pooled_reg_PG_CG_scaled <- summary(pool(reg_with_PG_CG_scaled)) pooled_reg_PG_CG_scaled$p.value pooled_reg_PG_CG_scaled$estimate


Input: regression for each iteration in order to check diagnostic plots  look for differences between the adjusted Rsquared of the five iterations [CODESPLIT] reg_PG_CG_1 <- reg_PG_CG[reg_PG_CG$.imp == 1, ] summary(lm(data=reg_PG_CG_1, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_1 <- with(data=reg_PG_CG_1, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_1) reg_PG_CG_2 <- reg_PG_CG[reg_PG_CG$.imp == 2, ] summary(lm(data=reg_PG_CG_2, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_2 <- with(data=reg_PG_CG_2, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_2) reg_PG_CG_3 <- reg_PG_CG[reg_PG_CG$.imp == 3, ] summary(lm(data=reg_PG_CG_3, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_3 <- with(data=reg_PG_CG_3, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_3) reg_PG_CG_4 <- reg_PG_CG[reg_PG_CG$.imp == 4, ] summary(lm(data=reg_PG_CG_4, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_4 <- with(data=reg_PG_CG_4, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_4) reg_PG_CG_5 <- reg_PG_CG[reg_PG_CG$.imp == 5, ] summary(lm(data=reg_PG_CG_5, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_5 <- with(data=reg_PG_CG_5, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_5)


Input: calculating the mean of the five residual standard errors, R squared, adjusted Rsquared and F statistic  [CODESPLIT] Residual_standard_error_reg_PG <- (10.35+10.45+10.16+10.29+10.28)/5 R_squared_reg_PG <- (0.639+0.630+0.652+0.642+0.642)/5 R_squared_adjusted_reg_PG <-(0.6267+0.6175+0.6403+0.6301+0.6298)/5 F_statistic_reg_PG <- (53.04+51.05+56.18+53.81+53.73)/5


Input: Graph the correlation between secure attachment and visual cortex response [CODESPLIT] ggplot(mydata, aes(SECURE.ATTACHMENT, LINGUAL.GYRUS..VISUAL.CORTEX.), scale="globalminmax") + geom_smooth(method = "lm", fill = "green", alpha = 0.6)+ geom_point(size =5 ) + theme_minimal()+ theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))+ labs(title = "Visual Cortex & Secure Attachment", x = "Secure Attachment", y = "Lingual Gyrus Activation") scale_x_continuous(limits = c(1,5), breaks = c(1,2,3,4,5))


Input: Graph the correlation between avoidant attachment and visual cortex response [CODESPLIT] ggplot(mydata, aes(AVOIDANT.ATTACHMENT, LINGUAL.GYRUS..VISUAL.CORTEX.), scale="globalminmax") + geom_smooth(method = "lm", fill = "red")+ geom_point(size = 5) + theme_minimal()+ theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))+ labs(title = "Visual Cortex & Avoidant Attachment", x = "Avoidant Attachment", y = "Lingual Gyrus Activation")+ scale_x_continuous(limits = c(1,5), breaks = c(1,2,3,4,5))


Input: Graph the interaction plot of amygdala and visual cortex activation, with AVOIDANT attachment as the moderator.  [CODESPLIT] p1 = interact_plot(fiti, pred = AMYGDALA, modx = AVOIDANT.ATTACHMENT,robust = FALSE, x.label = "Amygdala", y.label = "LG Visual Cortex", main.title = "Avoidant Attachment",  legend.main = "Avoidant Levels", colors = "red",interval = TRUE, int.width = 0.8)+ theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black")) p1


Input: Graph the interaction plot of amygdala and visual cortex activation, with SECURE attachment as the moderator.  [CODESPLIT] p2 = interact_plot(fiti2, pred = AMYGDALA, modx = SECURE.ATTACHMENT,robust = FALSE, x.label = "Amygdala", y.label = "LG Visual Cortex", main.title = "Secure Attachment",  legend.main = "Secure Levels", colors = "green",interval = TRUE, int.width = 0.8)+ theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black")) p2


Input: Returns the ratio between the geometric means of two independent samples and its  95% BCa bootstrap CI. [CODESPLIT] ratioGeomMeanCI.bootstrap <- function(group1, group2) { group1 <- log(group1) group2 <- log(group2) samplemean <- function(x, d) {return(mean(x[d]))} pointEstimate <- samplemean(group1) - samplemean(group2) set.seed(0) # make deterministic bootstrap_samples <- two.boot(sample1 = group1, sample2 = group2, FUN = samplemean, R = 5000) bootci <- boot.ci(bootstrap_samples, type = "bca", conf = conf.level) exp(c(pointEstimate,  bootci$bca[4], bootci$bca[5])) }


Input: Returns the 95% confidence interval of a single proportion using the Wilson score interval. [CODESPLIT] propCI <- function(numberOfSuccesses, sampleSize) { CI <- scoreci(x = numberOfSuccesses, n = sampleSize, conf.level = conf.level) c(numberOfSuccesses/sampleSize, CI$conf.int[1], CI$conf.int[2]) }


Input: Returns the difference between two linear regression slopes and its 95% BCa bootstrap CI. [CODESPLIT] diff.slopes.bootstrap <- function(x1, y1, x2, y2) { groups <- c(rep(1, length(x1)), rep(2, length(y1)), rep(3, length(x2)), rep(4, length(y2))) data <- data.frame(obs = c(x1, y1, x2, y2), group = groups) diffslope <- function(d, i) { db <- d[i,] x1 <- db[db$group==1,]$obs y1 <- db[db$group==2,]$obs x2 <- db[db$group==3,]$obs y2 <- db[db$group==4,]$obs fit1 <- lm(y1 ~ x1) a1 <- fit1$coefficients[[2]] fit2 <- lm(y2 ~ x2) a2 <- fit2$coefficients[[2]] a2 - a1 } a1 <- lm(y1 ~ x1)$coefficients[[2]] a2 <- lm(y2 ~ x2)$coefficients[[2]] pointEstimate <- a2 - a1 set.seed(0) # make deterministic bootstrap_samples <- boot(data = data, statistic = diffslope, stype = "i", strata = data$group, R = 5000) bootci <- boot.ci(bootstrap_samples, type = "bca") c(pointEstimate, bootci$bca[4], bootci$bca[5]) }


Input: replace current subjects "fixdata" by fixation_info  [CODESPLIT] if (any(S==replace_eye)){ fixdata[[S]] <- data.frame(fixation_info) colnames(fixdata[[S]]) <- c("Event.Start.Raw.Time..ms.","Event.End.Raw.Time..ms.","Event.Duration.Trial.Time..ms.", "Fixation.Position.X..px.","Fixation.Position.Y..px.","AOI.Name","intrialonset","trialnr") } }


Input: Mean Differences Comparing signed and unsigned reviews on four aspects For each, first ttest then violin plot Paneled plot created at end of series Testing word count  [CODESPLIT] t.test(revdat$wc ~ revdat$signed) wc_sign <- ggplot(revdat, aes(signed, wc, fill=signed)) + geom_violin( trim = FALSE, draw_quantiles = c(0.25, 0.5, 0.75), alpha = 0.5) + geom_jitter( width = 0.20, height = 0, alpha = 0.5, size = 1) + xlab("Signed Reviews") + ylab("Word Count")


Input: Correlations Examining correlations between time and aspects of reviews For each, first compute r and then scatter plot Plots also mark whether or not review was signed Paneled plot created at end of series  [CODESPLIT] cor.test(revdat$order, revdat$wc) wc_time <- ggplot(revdat, aes(order, wc, color=signed)) + geom_point(size=1)+ xlab("Time") + ylab("Word Count") cor.test(revdat$order, revdat$posemo) pos_time <- ggplot(revdat, aes(order, posemo, color=signed)) + geom_point(size=1) + xlab("Time") + ylab("Positive Emotion Words") cor.test(revdat$order, revdat$negemo) neg_time <- ggplot(revdat, aes(order, negemo, color=signed)) + geom_point(size=1) + xlab("Time") + ylab("Negative Emotion Words") cor.test(revdat$order, revdat$cogmech) cog_time <- ggplot(revdat, aes(order, cogmech, color=signed)) + geom_point(size=1) + xlab("Time") + ylab("Cognitive Mechanism Words")


Input: removes nonalphanumeric characters [CODESPLIT] full.data <- multigsub("[^[:alnum]]", " ", full.data, fixed = TRUE) train.data <- multigsub("[^[:alnum]]", " ", train.data, fixed = TRUE) valid.data <- multigsub("[^[:alnum]]", " ", valid.data, fixed = TRUE)


Input: removes leading & trailing whitespaces [CODESPLIT] full.data <- trimws(full.data) train.data <- trimws(train.data) valid.data <- trimws(valid.data)


Input: construct a maximal glmer() model  This model contains a fixed withinsubjects effect of Ambiguity (effectcoded with 0.5 amb),  codes for modality effects and interactions,  plus random effects by participants and items.  [CODESPLIT] Acc.max <- glmer(Correct ~ 1 + Ambiguity.code + Modality.code1 + Modality.code2 + Interaction.code1 + Interaction.code2 + (1 + Ambiguity.code + Modality.code1 + Modality.code2 + Interaction.code1 + Interaction.code2 | Participant.Private.ID) + (1   | Item), data = Data.CohOnly, family = "binomial", control = glmerControl(optimizer ="bobyqa")) Acc.max <- glmer(Correct ~ 1 + Ambiguity.code + Modality.code2 + Interaction.code2 + (1 + Ambiguity.code + Modality.code2 + Interaction.code2 | Participant.Private.ID) + (1   | Item), data = Data.ListandRead, family = "binomial", control = glmerControl(optimizer ="bobyqa")) Acc.max <- glmer(Correct ~ 1 + Ambiguity.code + Modality.code3 + Interaction.code3 + (1 + Ambiguity.code + Modality.code3 + Interaction.code3 | Participant.Private.ID) + (1   | Item), data = Data.ListandRSVP, family = "binomial", control = glmerControl(optimizer ="bobyqa"))


Input: construct a maximal lmer() model  This model contains codes for modality effects,  plus random effects by participants and items.  [CODESPLIT] RT.AmbOnly.max <- lmer(logRT ~ 1 + Modality.code1 + Modality.code2 + (1 + Modality.code1 + Modality.code2 | Participant.Private.ID) + (1   | Item), data = Data.AmbOnly, REML=FALSE) RT.ListandRead.max <- lmer(logRT ~ 1 + Modality.code2 + (1 + Modality.code2 | Participant.Private.ID) + (1   | Item), data = Data.ListandRead, REML=FALSE) RT.ListandRSVP.max <- lmer(logRT ~ 1 + Modality.code3 + (1 + Modality.code3 | Participant.Private.ID) + (1   | Item), data = Data.ListandRSVP, REML=FALSE) RT.ReadandRSVP.max <- lmer(logRT ~ 1 + Modality.code3 + (1 + Modality.code3 | Participant.Private.ID) + (1   | Item), data = Data.ReadandRSVP, REML=FALSE) RT.UAOnly.max <- lmer(logRT ~ 1 + Modality.code1 + Modality.code2 + (1 + Modality.code1 + Modality.code2 | Participant.Private.ID) + (1   | Item), data = Data.UAOnly, REML=FALSE) RT.ListandRead.max <- lmer(logRT ~ 1 + Modality.code2 + (1 + Modality.code2 | Participant.Private.ID) + (1   | Item), data = Data.ListandRead, REML=FALSE) RT.ListandRSVP.max <- lmer(logRT ~ 1 + Modality.code3 + (1 + Modality.code3 | Participant.Private.ID) + (1   | Item), data = Data.ListandRSVP, REML=FALSE) RT.ReadandRSVP.max <- lmer(logRT ~ 1 + Modality.code3 + (1 + Modality.code3 | Participant.Private.ID) + (1   | Item), data = Data.ReadandRSVP, REML=FALSE)


Input: construct a maximal lmer() model  This model contains a fixed effect for Ambiguity,  plus random effects by participants and items.  [CODESPLIT] RT.ListeningOnly.max <- lmer(logRT ~ 1 + Ambiguity.code + (1 + Ambiguity.code | Participant.Private.ID) + (1   | Item), data = Data.ListeningOnly, REML=FALSE) RT.ReadingOnly.max <- lmer(logRT ~ 1 + Ambiguity.code + (1 + Ambiguity.code | Participant.Private.ID) + (1   | Item), data = Data.ReadingOnly, REML=FALSE) RT.RSVPOnly.max <- lmer(logRT ~ 1 + Ambiguity.code + (1 + Ambiguity.code | Participant.Private.ID) + (1   | Item), data = Data.RSVPOnly, REML=FALSE)


Input: As this may be problematic for later analyses, we transform urbanity into its log:  [CODESPLIT] dslong %<>% mutate(urbanity_log = log(urbanity))


Input: calculate Bayes factors for difference using logspline fit [CODESPLIT] prior <- dnorm(0,1) fit.posterior <- logspline(samples$BUGSoutput$sims.list$mu_alpha) posterior <- dlogspline(0, fit.posterior) # this gives the pdf at point delta = 0 prior/posterior


Input: use normal distribution to approximate pvalue [CODESPLIT] FullAim1aPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim1aPNcoefs$t.value))) FullAim1aPNcoefs effectsize::standardize_parameters(FullAim1aPN) FullAim1bPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim1bPNcoefs$t.value))) FullAim1bPNcoefs effectsize::standardize_parameters(FullAim1bPN) FullAim1cPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim1cPNcoefs$t.value))) FullAim1cPNcoefs effectsize::standardize_parameters(FullAim1cPN) FullAim2aPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim2aPNcoefs$t.value))) FullAim2aPNcoefs effectsize::standardize_parameters(FullAim2aPN) FullAim2bPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim2bPNcoefs$t.value))) FullAim2bPNcoefs effectsize::standardize_parameters(FullAim2bPN) FullAim3PNPPcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim3PNPPcoefs$t.value))) FullAim3PNPPcoefs effectsize::standardize_parameters(FullAim3PNPP) FullAim4aPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim4aPNcoefs$t.value))) FullAim4aPNcoefs effectsize::standardize_parameters(FullAim4aPN) FullAim4bPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim4bPNcoefs$t.value))) FullAim4bPNcoefs effectsize::standardize_parameters(FullAim4bPN) FullAim5bPosPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim5bPosPNcoefs$t.value))) FullAim5bPosPNcoefs effectsize::standardize_parameters(FullAim5bPosPN) FullAim5bNegPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim5bNegPNcoefs$t.value))) FullAim5bNegPNcoefs effectsize::standardize_parameters(FullAim5bNegPN)


Input: this function give the integral of the survival curve given by S.hat ont the time.grid: Y.grid [CODESPLIT] expected_survival <- function(S.hat, Y.grid) { grid.diff <- diff(c(0, Y.grid, max(Y.grid))) c(base::cbind(1, S.hat) %*% grid.diff) } threshol_list <- function(l,threshold){ l_threshold = c() for (x in (l)){ if (is.na(x)){ return(NA) } else{ if (x < - threshold){ l_threshold <- c(l_threshold,- threshold) } else{ if(x > threshold){ l_threshold <- c(l_threshold,threshold) } else{ l_threshold <- c(l_threshold, x) } } } } return(l_threshold) }


Input: change data type of PHDYEAR to numeric [CODESPLIT] author_phd_data$PHDYEAR <-as.numeric(author_phd_data$PHDYEAR)


Input: calculate seniority of each author at the time of each article [CODESPLIT] author_phd_data$status_article1 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.1.Year.published, "Grad Student", ifelse(author_phd_data$yrs_to_article1 == 0|author_phd_data$yrs_to_article1 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article1 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article2 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.2.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article2 == 0|author_phd_data$yrs_to_article2 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article2 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article3 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.3.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article3 == 0|author_phd_data$yrs_to_article3 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article3 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article4 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.4.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article4 == 0|author_phd_data$yrs_to_article4 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article4 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article5 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.5.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article5 == 0|author_phd_data$yrs_to_article5 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article5 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article6 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.6.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article6 == 0|author_phd_data$yrs_to_article6 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article6 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article7 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.7.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article7 == 0|author_phd_data$yrs_to_article7 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article7 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article8 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.8.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article8 == 0|author_phd_data$yrs_to_article8 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article8 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article9 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.9.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article9 == 0|author_phd_data$yrs_to_article9 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article9 > 6, "Senior Scholar", "NA"))) author_phd_data$status_article10 <- ifelse(author_phd_data$PHDYEAR == 0 |author_phd_data$PHDYEAR > author_phd_data$Article.10.Year.Published, "Grad Student", ifelse(author_phd_data$yrs_to_article10 == 0|author_phd_data$yrs_to_article10 < 7, "Junior Scholar", ifelse(author_phd_data$yrs_to_article10 > 6, "Senior Scholar", "NA")))


Input: run check to see if any authors have missing data [CODESPLIT] check <- subset(mmcpsr_authors, is.na(mmcpsr_authors$Title))


Input: stacked graph regarding how participants came to see each advocacy type [CODESPLIT] ggplot(detected_advocacy, aes(x = Advocacy, y = Percentage, fill = Response, label = Percentage)) + geom_bar(position ="stack", stat="identity") + coord_flip(ylim=c(0,100)) + scale_y_continuous(labels = scales::percent_format(scale = 1)) + geom_text(aes(label = Percentage), size = 3, position = position_stack(vjust = 0.5) ) + labs(y= "Porcentaje de Participantes", x = "Tipo de Defensa") + theme(text = element_text(family = "Arial", size = 14), panel.background = element_rect("white"), panel.border = element_rect(fill = NA), panel.grid.major.x = element_line(colour = "grey"), axis.title.x = element_text(color = "#39363D", size = 14, hjust=0.5), axis.title.y = element_text(color = "#39363D", size = 14), legend.position="bottom", legend.text = element_text(size = 12), legend.title = element_blank())


Input: Define adjustment to calculate Hedge's g. To calculate Cohen's d set J < 1. Remember to change the true.ratio value of J as well. [CODESPLIT] J <-   j <- 1 - 3/(4*(n + m - 2) - 1) G <- J*SMD sds <- sqrt((n + m)/(n*m) + SMD^2/2/(n + m)) V <- (J^2)*(sds^2) w <- 1/V if(method == "REML"){r.model <- rma(yi = G, vi = V,method = method, control=list(stepadj=0.5, maxiter=10000000000000000000000000))} else{ r.model <- rma(yi = G, vi = V,method = method) } fit.model <- rma(yi = G, vi = V, method = "FE") ratio <- abs(r.model$ci.ub - r.model$ci.lb)/abs(fit.model$ci.ub - fit.model$ci.lb) log.ratio <- log(ratio) w.star <- 1/(V + r.model$tau2) log.var <- ((r.model$se.tau2)^2)/4*1/(sum(w.star))^2*(sum(w.star^2))^2 log.sd <- sqrt(log.var) bias <- 1/2*(r.model$se.tau2)^2*(1/2/sum(w.star)^2 - 1/sum(w.star)*sum(w.star^3))


Input: Generate parcellated data and do CFA   generate parcellated datasets  must specify data and the number of allocations (nAlloc) [CODESPLIT] list1=parcelAllocation(mod.par, data=usm, par.names, mod.items, nAlloc=2, do.fit=F, std.lv=T)


Input: Multifit() conducts a CFA for each data.frame in a list (saved from parcelAllocation) and returns all of the results of interest on one row per data.frame  The results consist of 21 columns with fit measures ("npar", "chisq", "df", "pvalue", "cfi", "tli", "rmsea", "rmsea.pvalue", "srmr") followed by the latent r between scales ("IA_NFC", "IA_URS", etc.)  WARNING: running each CFA takes roughly 20 seconds (Intel i58350U CPU), so running it for 200 data.frames should take 11.5 hours.  [CODESPLIT] multifit=function(data) { rows=c(131:136) # rows indexing the parameter estimates of interest (correlations among general factors) names=c("npar", "chisq", "df", "pvalue", "cfi", "tli", "rmsea", "rmsea.pvalue", "srmr", "IA_NFC", "IA_IU", "IA_URS", "NFC_IU", "NFC_URS", "IU_URS", "IA_NFC_se", "IA_IU_se", "IA_URS_se", "NFC_IU_se", "NFC_URS_se", "IU_URS_se") results=sapply(data, function(x){ output=cfa(data=x, model=mod.par, std.lv=T) # save CFA output est=as.matrix(out@ParTable[["est"]][rows]) # save the parameter estimates of interest se=as.matrix(out@ParTable[["se"]][rows]) fit=as.matrix(fitMeasures(output)[c(1,3,4,5,9,10,23,26,29)]) # save fit measures of interest bind=round(do.call("rbind", (list(fit,est,se))),3) # bind the data }) results.t=t(results) # transpose the matrix colnames(results.t)=names # name columns results.t }


Input: Get residuals of tie strength adjusted tie strength model_tiestrength glm(strength.mean~no.of.papers:Gender, family"gaussian", data new) model with strength not transformed looked a bit dodgy, so we logtransformed strength [CODESPLIT] model_tiestrength = glm(log(strength.mean)~no.of.papers:Gender+no.of.papers, family="gaussian", data = new) model_tiestrength = glm(log(strength.mean)~no.of.papers:Gender, family="gaussian", data = new) hist(resid(model_tiestrength), main = "residuals of model with log(tie strength)") qqnorm(resid(model_tiestrength)) summary(model_tiestrength) summ(model_tiestrength) new$residuals.strength <- resid(model_tiestrength) hist(new$residuals.strength)


Input: get number of papers (and other stats) per gender [CODESPLIT] ddply(new, "Gender",summarise, mean = mean(no.of.papers, na.rm = TRUE), median = median(no.of.papers, na.rm = TRUE), sd = sd(no.of.papers, na.rm = TRUE), N = sum(!is.na(no.of.papers)), se = sd / sqrt(N), min = min(no.of.papers, na.rm = TRUE), max = max(no.of.papers, na.rm = TRUE))


Input: Create censoring VARIABLE PI status: 1 if PI, 0 if author did not make it to PI [CODESPLIT] new.PI$status.PI = ifelse(!is.na(new.PI$Time.to.PI),1,0)


Input: Gender effect of Gender on time to PI [CODESPLIT] flexgender<-flexsurvreg(Surv(new.PI$time.PI,new.PI$status.PI)~Gender, dist="lnorm", data=new.PI) flexgender


Input: fit_lognormal Lowest AIC, best fit Package flexsurv provides access to additional distributions Also allows plotting options want red lines to match as close as possible to KM curve [CODESPLIT] fit_exp<-flexsurvreg(Surv(new$n.years,new$status)~1, dist="exp") fit_weibull<-flexsurvreg(Surv(new$n.years,new$status)~1, dist="weibull") fit_gamma<-flexsurvreg(Surv(new$n.years,new$status)~1, dist="gamma") fit_gengamma<-flexsurvreg(Surv(new$n.years,new$status)~1, dist="gengamma") fit_genf<-flexsurvreg(Surv(new$n.years,new$status)~1, dist="genf") fit_lognormal<-flexsurvreg(Surv(new$n.years,new$status)~1, dist="lnorm") fit_gompertz<-flexsurvreg(Surv(new$n.years,new$status)~1, dist="gompertz") fit_exp fit_weibull fit_gamma fit_gengamma fit_genf fit_lognormal fit_gompertz plot(fit_exp) plot(fit_weibull) plot(fit_gamma) plot(fit_gengamma) plot(fit_genf) plot(fit_lognormal) plot(fit_gompertz)


Input: Generalized gamma distribution is not sig. better fit than lognormal distribution. Justifies using lognormal. AFT model AFT model uses survreg function from Survival package using lognormal distribution according to earlier exploration of the best distribution for the data use survreg for stepwise then flexsurvreg to generate graphs GENDER Examine gender differences first, ignoring any of the social metrics Effect of gender on career length (n.years) [CODESPLIT] flexAFTgender<-flexsurvreg(Surv(n.years,status)~Gender,dist="lnorm",data=new) flexAFTgender plot(flexAFTgender,col=c("blue","red"),ci=T,xlab="Years",ylab="Survival probability")


Input: Reverses the factor level ordering for labels after coord_flip() [CODESPLIT] df$labeltext<-factor(df$labeltext, levels=rev(df$labeltext)) df$colour <- c("dark grey","dark grey","black","black","dark grey","dark grey") df_TPICL$labeltext_TPICL <- factor(df_TPICL$labeltext_TPICL, levels=rev(df_TPICL$labeltext_TPICL)) df_TPICL$colour <- c("dark grey","dark grey","dark grey","dark grey","dark grey","dark grey","black","black","dark grey","dark grey","dark grey","dark grey") plotTPICL1<- ggplot(data=df_TPICL, aes(x=labeltext_TPICL, y=estimate_TPICL, ymin=lower_TPICL, ymax=upper_TPICL, col=Gender_TPICL, shape=Gender_TPICL))+ annotate("rect", xmin = 0, xmax = 6.5, ymin = 1, ymax = 5, alpha = .2, fill = "grey") + annotate("rect", xmin = 6.5, xmax = 12.7, ymin = 0, ymax = 1, alpha = .2, fill = "grey") + geom_point(aes(size=2,col = colour, fill = colour),show.legend=FALSE)+ geom_pointrange(size=0.7, col = df_TPICL$colour, fill = df_TPICL$colour,show.legend=FALSE) + geom_hline(yintercept=1, lty=2) + # Add a dotted line at x=1 after flip geom_vline(xintercept=6.5, lty=1) + # Adds a solid line at y=6.5 after flip to differentiate between top panel = career longevity and bottom panel = time to PI geom_errorbar(aes(ymin=lower_TPICL, ymax=upper_TPICL,width=0.6,cex=1,col=colour, fill = colour),show.legend=FALSE) + scale_x_discrete(breaks=c(1,3,5,7,9,11), labels=c("Adj. Network Size","Adj. Tie Strength","Adj. Clustering Coef.", "Adj. Network Size","Adj. Tie Strength","Adj. Clustering Coef.")) + coord_flip() + # Flip coordinates (puts labels on y axis) xlab("Label") + ylab("Deceleration factor") + scale_fill_manual(values=c("dark grey","dark grey","black","black","dark grey","dark grey","black","black","dark grey","dark grey","dark grey","dark grey"))+ scale_colour_manual(values=c("black","dark grey","dark grey","dark grey","black","black")) + scale_shape_manual(values=c(17,16))+ annotate("text",x=7.2, y=5, label="Time to become a PI",size=5,fontface="bold",hjust=1) + annotate("text",x=1, y=5, label="Career length", size=5,fontface="bold",hjust=1) + theme(axis.title.y = element_blank(), # Remove y axis title axis.text.y = element_text(size=12, colour="black"), # Change size of y axis labels axis.text.x = element_text(size=12,colour="black"), # Change size of x axis numbers axis.title.x = element_text(size=14,vjust=0.5,colour="black",face="bold"), # Change size and font of x axis title and move it down a bit panel.grid.major = element_blank(), # Formatting to create blank plot with box around it axis.line = element_line(colour="black"), panel.background = element_rect(colour = "black", size=1, fill=NA), legend.title =element_blank())+ guides(colour=FALSE)


Input: Add label to plot C [CODESPLIT] plotTPICL2<-plotTPICL1+ labs(tag="C")+ theme(plot.tag.position = c(0.19,0.5),plot.tag = element_text(size=14,face="bold"))


Input: Now layout plots and plot them labels for plots A and B added here [CODESPLIT] ggarrange(plotPIstatus,plotTPICL2,heights=c(1,1.7),ncol=1,nrow=2,labels=c("A","B"),label.x=0.18,label.y=0.95)


Input: Display raincloud plot [CODESPLIT] ggplot(dataset_anova, aes(session, score, fill = group)) + geom_rain(alpha = .5, cov = "group", rain.side = 'f2x2') + theme(text=element_text(size=20))


Input: Create a covariance matrix of the means in the placebo group [CODESPLIT] cov_group1 = matrix(c(vcov(cov_fit)[1,1],vcov(cov_fit)[1,3],vcov(cov_fit)[3,1], vcov(cov_fit)[3,3]),2,2)


Input: Create a covariance matrix of the means in the treatment group [CODESPLIT] cov_group2 = matrix(c(vcov(cov_fit)[2,2],vcov(cov_fit)[2,4],vcov(cov_fit)[4,2], vcov(cov_fit)[4,4]),2,2)


Input: Contrasting Two vs Fourstakes paradigms Decision generates table of beta coefficients and associated statistics [CODESPLIT] coef.stakes_decision <- data.frame(cbind(summary(m.stakes_decision)$coefficients, m.stakes_decision.CI)) %>% tibble::rownames_to_column('Variable') %>% rename(SE = Std..Error) %>% rename(Z = z.value) %>% rename(P = Pr...z..) %>% rename(CI_L = X2.5..) %>% rename(CI_U = X97.5..) %>% mutate(Variable = factor(Variable, levels = c('fairnessunfair:recodedDecisionreject:stakes4', 'recodedDecisionreject:stakes4', 'fairnessunfair:stakes4', 'fairnessunfair:recodedDecisionreject', 'stakes4', 'recodedDecisionreject', 'fairnessunfair', 'genderfemale', 'centredAge', '(Intercept)' )))


Input: Calculating the conditional entropy of denomination given designs by authorities separately for each df HIGHER/LOWER Higher denominations [CODESPLIT] authority <- sort(unique(higher$AUTHORITY)) CEDenomination.Designs <- c() HDenominations <- c() NormCEDenomination.Designs <- c() Ncoins <- c() AUTHORITY <- c() for(i in authority){ high_sub <- subset(higher, higher$AUTHORITY == i) denom_high <- as.data.frame(high_sub[,256:309]) motifs_high <- as.data.frame(high_sub[,318:681]) AUTHORITY[i] <- i CEDenomination.Designs[i] <- condentropy(denom_high, motifs_high) HDenominations[i] <- entropy(denom_high) NormCEDenomination.Designs[i] <- condentropy(denom_high, motifs_high) / entropy(denom_high) Ncoins[i] <- nrow(high_sub) } results_higher <- data.frame("AUTHORITY" = AUTHORITY, "CEDenomination.Designs" = CEDenomination.Designs, "Entropy.Denominations" = HDenominations, "NormCEDenomination.Designs" = NormCEDenomination.Designs, "Ncoins" = Ncoins) write.csv2(results_higher,"P3test_byauth_higher.csv")


Input: destructure string into an array using "_" as the delimiter [CODESPLIT] stringArr <- unlist(strsplit(as.character(string), split = "_", fixed = T))


Input: log transform RTs for statistical analysis [CODESPLIT] RTdata$logRT <- log10(RTdata$rt) hist(RTdata$logRT)


Input: fit a lienar mixed effects model with all theoretically relevant fixed effects and random intercepts for participant and target context [CODESPLIT] modelRT <- mixed(logRT ~ congruency*soa*mask_contrast + (1| participant) + (1|target_context), data = RTdata, method = "S", type=3) modelRT


Input: pearon correlations within each of these four conditions [CODESPLIT] ca_subset <- CA %>% filter(soa == "200 ms" & mc == "100% contrast") cor.test(ca_subset$PC, ca_subset$CE) ca_subset <- CA %>% filter(soa == "400 ms" & mc == "100% contrast") cor.test(ca_subset$PC, ca_subset$CE) ca_subset <- CA %>% filter(soa == "200 ms" & mc == "20% contrast") cor.test(ca_subset$PC, ca_subset$CE) ca_subset <- CA %>% filter(soa == "400 ms" & mc == "20% contrast") cor.test(ca_subset$PC, ca_subset$CE)


Input: descriptive statistics of accuracy / errors [CODESPLIT] er_desc <- data_er %>% group_by(participant) %>% summarize(n_correct = sum(acc), n_trials = length(participant))


Input: fit a GLMM model with all theoretically relevant fixed effects [CODESPLIT] modelER <- mixed(acc ~ congruency*soa*mask_contrast + (1| participant) + (1|target_context), family = binomial("logit"), data = data_er, method = "LRT", type =3) summary(modelER) anova(modelER)


Input: fit a GLMM model with all theoretically relevant effects [CODESPLIT] modelER <- mixed(acc ~ soa*mask_contrast + (1| participant) + (1|prime_context), family = binomial("logit"), data = acc_data, method = "LRT", type=3) modelER


Input: calculate overall proportion [CODESPLIT] prop_overall := N / sum(N)]


Input: creating variables for lagged values and moving averages [CODESPLIT] delay_rf <- function(v,lag) c(rep(NA,lag),v[1:(length(v)-lag)]) moving_avg <- function(x,n) c(stats::filter(x,rep(1/n,n),sides=1)) res <- lapply(res,transform,cd4Rcd8=cd4/cd8) res <- lapply(res,transform,cd4_ma12=moving_avg(cd4,12),cd8_ma12=moving_avg(cd8,12),cd4Rcd8_ma12=moving_avg(cd4Rcd8,12),cd4_ma24=moving_avg(cd4,24),cd8_ma24=moving_avg(cd8,24),cd4Rcd8_ma24=moving_avg(cd4Rcd8,24), rna_ma12=moving_avg(rna,12),rna_ma24=moving_avg(rna,24)) res <- lapply(res,transform,cd4_lag12=delay_rf(cd4,12),cd4_lag24=delay_rf(cd4,24),cd4_lag36=delay_rf(cd4,36), cd8_lag12=delay_rf(cd8,12),cd8_lag24=delay_rf(cd8,24),cd8_lag36=delay_rf(cd8,36), cd4Rcd8_lag12=delay_rf(cd4Rcd8,12),cd4Rcd8_lag24=delay_rf(cd4Rcd8,24),cd4Rcd8_lag36=delay_rf(cd4Rcd8,36), rna_lag12=delay_rf(rna,12),rna_lag24=delay_rf(rna,24),rna_lag36=delay_rf(rna,36), cd4_ma12_lag12=delay_rf(cd4_ma12,12),cd4_ma24_lag12=delay_rf(cd4_ma24,12),cd4_ma12_lag24=delay_rf(cd4_ma12,24), cd8_ma12_lag12=delay_rf(cd8_ma12,12),cd8_ma24_lag12=delay_rf(cd8_ma24,12),cd8_ma12_lag24=delay_rf(cd8_ma12,24), cd4Rcd8_ma12_lag12=delay_rf(cd4Rcd8_ma12,12),cd4Rcd8_ma24_lag12=delay_rf(cd4Rcd8_ma24,12),cd4Rcd8_ma12_lag24=delay_rf(cd4Rcd8_ma12,24), rna_ma12_lag12=delay_rf(rna_ma12,12),rna_ma24_lag12=delay_rf(rna_ma24,12),rna_ma12_lag24=delay_rf(rna_ma12,24)) res <- lapply(res,transform,haart_lag6=delay_rf(haart,6),haart_lag12=delay_rf(haart,12),hepC_aHCVpos_lag12=delay_rf(hepC_aHCVpos,12),hepC_RNApos_lag12=delay_rf(hepC_RNApos,12), hepC_RNAdet_lag12=delay_rf(hepC_RNAdet,12),hepB_pos_lag12=delay_rf(hepB_pos,12),CDC_lag12_cat=delay_rf(CDC_cat,12),bpn_lag12=delay_rf(bpn,12)) res_df <- rbind.fill(res) res_df$CDC_lag12_cat[res_df$CDC_lag12_cat==1] <- "A" res_df$CDC_lag12_cat[res_df$CDC_lag12_cat==2] <- "B" res_df$CDC_lag12_cat[res_df$CDC_lag12_cat==3] <- "C" res_df$CDC_lag12_cat <- factor(res_df$CDC_lag12_cat,levels=c("A","B","C")) res_df$hepC_aHCVpos_lag12[is.na(res_df$hepC_aHCVpos_lag12)] <- FALSE res_df$hepC_RNApos_lag12[is.na(res_df$hepC_RNApos_lag12)] <- FALSE res_df$hepC_RNAdet_lag12[is.na(res_df$hepC_RNAdet_lag12)] <- FALSE res_df <- transform(res_df,hepC_RNA=(hepC_RNApos | hepC_RNAdet),hepC_RNA_lag12=(hepC_RNApos_lag12 | hepC_RNAdet_lag12)) res_df$bpn_lag12[is.na(res_df$bpn_lag12)] <- FALSE rownames(res_df) <- NULL if(write_df) save(res_df,file=paste(filepath_read_R,"\\monthly_rf_df_",max_dist,".RData",sep='')) print(proc.time()-ptm)


Input: create dummy variables gender [CODESPLIT] Sample2$Dfemale <- recode(Sample2$gender, "'weiblich'=1;; 'maennlich'=0;; 'divers'=0;; 'keine Angabe'=0") Sample2$Dmale <- recode(Sample2$gender, "'maennlich'=1;; 'weiblich'=0;; 'divers'=0;; 'keine Angabe'=0") Sample2$Ddiverse <- recode(Sample2$gender, "'divers'=1;; 'weiblich'=0;; 'maennlich'=0;; 'keine Angabe'=0") Sample2$DNoGenderInd <- recode(Sample2$gender, "'keine Angabe'=1;;'weiblich'=0;; 'maennlich'=0;; 'divers'=0") Sample2$DComplianceFully <- recode(Sample2$complianceCurrent, "'Ja'=1;; 'Ja, teilweise'=0;; 'Nein auch zuvor nicht'=0;; 'Nein, nicht mehr'=0") Sample2$DCompliancePartly <- recode(Sample2$complianceCurrent, "'Ja'=0;; 'Ja, teilweise'=1;; 'Nein auch zuvor nicht'=0;; 'Nein, nicht mehr'=0") Sample2$DComplianceNever <- recode(Sample2$complianceCurrent, "'Ja'=0;; 'Ja, teilweise'=0;; 'Nein auch zuvor nicht'=1;; 'Nein, nicht mehr'=0") Sample2$DComplianceNotAnymore <- recode(Sample2$complianceCurrent, "'Ja'=0;; 'Ja, teilweise'=0;; 'Nein auch zuvor nicht'=0;; 'Nein, nicht mehr'=1")


Input: Plots Anxiety main effects LISD [CODESPLIT] ggplot(Sample2_Reg,aes(y=Anxiety,x=z_LISD_State_F1))+ geom_point(color = "indianred4")+geom_smooth(method="lm", color = "black", size = 0.5)+theme_classic() ggplot(Sample2_Reg,aes(y=Anxiety,x=z_LISD_Trait_F1))+ geom_point(color = "indianred4")+geom_smooth(method="lm", color = "black", size = 0.5)+theme_classic() ggplot(Sample2_Reg,aes(y=Anxiety,x=z_LISD_Trait_F2))+ geom_point(color = "indianred4")+geom_smooth(method="lm", color = "black", size = 0.5)+theme_classic()


Input: Plots Depressed plot preparation: divide z_age into SD, mean, +SD [CODESPLIT] attach(Sample2_Reg) Sample2_Reg$age_3groups <- case_when(z_age > mean(z_age)+sd(z_age) ~ "high", z_age < mean(z_age)+sd(z_age) & z_age > mean(z_age)-sd(z_age) ~ "mean", z_age < mean(z_age)-sd(z_age) ~ "low") detach(Sample2_Reg)


Input: Plots Manuscript Plots Manuscript with raw WLISD scores Anxiety [CODESPLIT] plot1_1 <- Sample2_Reg %>% ggplot(aes(x = LISD_State_F1, y = Anxiety)) + geom_point(color = "#00AFBB")+ geom_smooth(method = lm, color = "black", size = 0.5)+ xlim(1,5)+ ylim(-2,3)+ labs(x = "lonely & isolated (State 1)", y = "Anxiety (z)", Title = "State Factor 1")+ theme_classic() plot2_1 <- Sample2_Reg %>% ggplot(aes(x = LISD_State_F2, y = Anxiety)) + geom_point(color = "#55C667FF")+ geom_smooth(method = lm, color = "black", size = 0.5)+ xlim(1,5)+ ylim(-2,3)+ labs(x = "supported & connected (State 2)", y = "Anxiety (z)", Title = "State Factor 2")+ theme_classic() plot3_1 <- Sample2_Reg %>% ggplot(aes(x = LISD_Trait_F1, y = Anxiety)) + geom_point(color = "#E7B800")+ geom_smooth(method = lm, color = "black", size = 0.5)+ xlim(1,5)+ ylim(-2,3)+ labs(x = "loneliness & isolation (Trait 1)", y = "Anxiety (z)", Title = "Trait Factor 1")+ theme_classic() plot4_1 <- Sample2_Reg %>% ggplot(aes(x = LISD_Trait_F2, y = Anxiety)) + geom_point(color = "#FC4E07")+ geom_smooth(method = lm, color = "black", size = 0.5)+ xlim(1,5)+ ylim(-2,3)+ labs(x = "sociability & sense of belonging (Trait 2)", y = "Anxiety (z)", Title = "Trait Factor 1")+ theme_classic() plot1_1 plot2_1 plot3_1 plot4_1


Input: Create a line graph articles per year [CODESPLIT] ggplot(ArticlesbyYear, aes(x=Year, y=n, group = 1)) + geom_line(color="orange") + labs(y = "Number of Articles", angle = 45) + theme_minimal(base_size = 12)


Input: Create a barplot articles per year [CODESPLIT] ggplot(ArticlesbyYear, aes(x = Year, y = n)) + geom_bar(stat = "identity", color = "steelblue3", fill = "steelblue3") + theme_minimal(base_size = 12) + labs(y = "Articles", angle = 45) + geom_text(aes(label = n), vjust ="center", size=3, hjust = "center", nudge_y = 1)


Input: Create a barplot articles per journal [CODESPLIT] ggplot(Journals, aes(x = reorder(Journal, Percent), y = Percent)) + geom_bar(stat = "identity", color = "steelblue3", fill = "steelblue3") + coord_flip() + theme_minimal(base_size = 11) + labs(y = "Percent", x = "Journal") + geom_text(aes(label = Percent), vjust ="center", size=3, hjust = "center", nudge_y = 0.01)


Input: Create barplot Subfields Percents counts [CODESPLIT] ggplot(subfield_count, aes(x = reorder(Subfield, Percent) , y = Percent, fill = Subfield)) + geom_bar(stat = "identity") + scale_fill_brewer(palette = "Blues", guide = FALSE) + coord_flip() + theme_minimal(base_size = 13) + labs(y = "Percent of Articles", x = "Subfield") + geom_text(aes(label = Percent), vjust ="center", size=3, hjust = "center", nudge_y =.1) + scale_y_continuous(labels = scales::percent, limits = c(0,1))


Input: authorlevel count and proportion for all gender identity categories [CODESPLIT] gender_author <- author_data %>% subset(!is.na(Gender.apsa)) %>% dplyr::summarize(count = c(sum(male_apsa, na.rm=T), sum(female_apsa, na.rm=T), sum(nonbinary_apsa, na.rm=T))) gender_author <- gender_author %>% mutate(proportion = round(count / sum(count), 2)) %>% mutate(gender = c("male", "female", "nonbinary")) %>% dplyr::select(gender, count, proportion)


Input: calculate count and proportion of gender author structure [CODESPLIT] gender_article_dedup <- gender_article %>% distinct(article_title, single_authored_male, single_authored_female, co_authored_male, co_authored_female, co_authored_mixed) gender_article_count <- data.frame(matrix(NA, nrow = 5, ncol = 3)) colnames(gender_article_count) <- c("Author_Gender", "Frequency", "Percent") gender_article_count$Author_Gender <- c("Single Authored Male", "Single Authored Female", "Co-authored Male", "Co-authored Female", "Co-authored Mixed Gender") gender_article_count$Frequency <- c(sum(gender_article_dedup$single_authored_male, na.rm=T), sum(gender_article_dedup$single_authored_female, na.rm=T), sum(gender_article_dedup$co_authored_male, na.rm=T), sum(gender_article_dedup$co_authored_female, na.rm=T), sum(gender_article_dedup$co_authored_mixed, na.rm=T)) gender_article_count$Percent <- formattable::percent(gender_article_count$Frequency/sum(gender_article_count$Frequency), digits = 1)


Input: articlelevel authorship structure for race / ethnic identity categories [CODESPLIT] race_ethnicity_article <- race_ethnicity_article %>% group_by(article_title) %>% mutate(white_authors = ifelse(mean(white) == 1, 1, 0), black_authors = ifelse(mean(black) == 1, 1, 0), east_asian_authors = ifelse(mean(east_asian) == 1, 1, 0), south_asian_authors = ifelse(mean(south_asian) == 1, 1, 0), latino_authors = ifelse(mean(latino) == 1, 1, 0), mena_authors = ifelse(mean(mena) == 1, 1, 0), native_authors = ifelse(mean(native) == 1, 1, 0), pacific_authors = ifelse(mean(pacific) == 1, 1, 0), other_authors = ifelse(mean(other) == 1, 1, 0), mixed_authors = ifelse(mean(white) < 1 & n() > 1, 1, 0))


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


Input: Number (%) of articles drawing on data collected via Survey (alone + in combo. w/other techniques) Raw Count/percent alone [CODESPLIT] SurveySoloCount <- sum(MMCPSR_emp$`Ethnography / participant observation` ==0 & MMCPSR_emp$`Interviews/focus groups` == 0 & MMCPSR_emp$Survey == 1 & MMCPSR_emp$EHPdata == 0 & MMCPSR_emp$gendataNHP == 0 & MMCPSR_emp$`Employed data/information from pre-existing primary or secondary sources`==0) SurveySoloCount formattable::percent(SurveySoloCount/nrow(MMCPSR_emp), digits = 1)


Input: Number (%) of articles using Field experiments (alone + in combo. w/other techniques) Count/percent alone [CODESPLIT] FieldExpSoloCount <- sum(MMCPSR_emp$`Survey experiment` ==0 & MMCPSR_emp$Field == 1 & MMCPSR_emp$Lab == 0 & MMCPSR_emp$OHPdata == 0 & MMCPSR_emp$gendataNHP == 0 & MMCPSR_emp$`Employed data/information from pre-existing primary or secondary sources`==0) FieldExpSoloCount formattable::percent(FieldExpSoloCount/nrow(MMCPSR_emp), digits = 1)


Input: Number (%) of articles using data generated through interaction with Dom gov [CODESPLIT] sum(MMCPSR_emp$`EHP - Domestic government` == 1 | MMCPSR_emp$`OHP - Domestic government`==1) formattable::percent(sum(MMCPSR_emp$`EHP - Domestic government` == 1 | MMCPSR_emp$`OHP - Domestic government`==1) /nrow(MMCPSR_emp), digits = 1)


Input: Number (%) of articles using data generated through interaction with Media [CODESPLIT] sum(MMCPSR_emp$`EHP - Media` == 1 | MMCPSR_emp$`OHP - Media`==1) formattable::percent(sum(MMCPSR_emp$`EHP - Media` == 1 | MMCPSR_emp$`OHP - Media`==1)/nrow(MMCPSR_emp), digits = 1)


Input: probit and marginal effects experimental data vs time [CODESPLIT] out.1.probit <-glm(EHPdata~Year, data = MMCPSR_emp, family = binomial(link = "probit")) summary(out.1.probit) probitmfx(out.1.probit, data = MMCPSR_emp)


Input: create correlation matrix author gender vs methods categories [CODESPLIT] MethodGender_cor <- rcorr(as.matrix(MethodGender_sub))


Input: DV Formal modeling only OLS Modeling only vs time [CODESPLIT] out.12 <- lm(MMCPSR_emp$ModelingOnly ~ MMCPSR_emp$Year) summary(out.12) out.15$coefficients[2]


Input: Conclusion Policy Recommendations count and percent of all articles [CODESPLIT] sum(MMCPSR_Data$`Policy Recommendation`) formattable::percent(sum(MMCPSR_Data$`Policy Recommendation`)/nrow(MMCPSR_Data), digits = 1)


Input: DV time OLS policy recommendations vs time [CODESPLIT] out.21 <- lm(MMCPSR_emp$`Policy Recommendation`~MMCPSR_emp$Year) summary(out.21) out.21$coefficients[2] out.21b <- lm(MMCPSR_emp$`Policy Recommendation`~as.factor(MMCPSR_emp$Year)) summary(out.21b) plot_coefs(out.21b) plot_coefs(lm(MMCPSR_emp$`Policy Recommendation`~ 0 + as.factor(MMCPSR_emp$Year)))


Input: scaling all the variables of interest (between 01) for a composite score [CODESPLIT] data8$gincdif_s = rescale(data8$gincdif) data8$smdfslv_s = rescale(data8$smdfslv) data8$sbstrec_r = 6 - data8$sbstrec # reverse scores first data8$sbstrec_r_s = rescale(data8$sbstrec_r)


Input: create one index of political engagement using: interest, media reception, and political action [CODESPLIT] polit_eng = c("polintr_r_s", "nwspol_s", "polit_action_s") data8$polit_eng = rowMeans(data8[polit_eng], na.rm = TRUE) mean(data8$polit_eng, na.rm = TRUE) # 0.22 sd(data8$polit_eng, na.rm = TRUE) # 0.14 psych::alpha(data8[polit_eng]) # 0.39 data8$polit_eng_c = c(scale(data8$polit_eng, center = TRUE, scale = FALSE)) # center


Input: Calculate values scores for PVQ recoding PVQ items (ESS uses 1 as "like me" and 6 "totally not like me) [CODESPLIT] data8$ipcrtiv_r = 7 - data8$ipcrtiv data8$imprich_r = 7 - data8$imprich data8$ipeqopt_r = 7 - data8$ipeqopt data8$ipshabt_r = 7 - data8$ipshabt data8$impsafe_r = 7 - data8$impsafe data8$impdiff_r = 7 - data8$impdiff data8$ipfrule_r = 7 - data8$ipfrule data8$ipudrst_r = 7 - data8$ipudrst data8$ipmodst_r = 7 - data8$ipmodst data8$ipgdtim_r = 7 - data8$ipgdtim data8$impfree_r = 7 - data8$impfree data8$iphlppl_r = 7 - data8$iphlppl data8$ipsuces_r = 7 - data8$ipsuces data8$ipstrgv_r = 7 - data8$ipstrgv data8$ipadvnt_r = 7 - data8$ipadvnt data8$ipbhprp_r = 7 - data8$ipbhprp data8$iprspot_r = 7 - data8$iprspot data8$iplylfr_r = 7 - data8$iplylfr data8$impenv_r = 7 - data8$impenv data8$imptrad_r = 7 - data8$imptrad data8$impfun_r = 7 - data8$impfun


Input: evaluate goodness of fit of psychometric function using deviance test [CODESPLIT] d_fit <-{} for(i in unique(d$Subject)){ m_1 <- glm(Response ~ JumpSize * Velocity +BlinkDuration , d[d$Subject==i & d$cond1==1,], family=binomial(probit)) m_0<- glm(Response ~ Velocity +BlinkDuration , d[d$Subject==i & d$cond1==1,], family=binomial(probit)) LRT <- anova(m_0, m_1,test="LRT") d_fit <- rbind(d_fit, data.frame(id=i, D=LRT$Deviance[2], df=LRT$Df[2], p=LRT$`Pr(>Chi)`[2])) } print(d_fit,digits=2,row.names=F) round(d_fit$p,digits=10)


Input: use lmList to fit individual GLM models in one go [CODESPLIT] mo <- lmList(Response ~ cond1 * JumpSize * Velocity +bdur:cond1 | Subject, d, family=binomial(probit))


Input: visualize Bayes factors and parameter estimates [CODESPLIT] par(mfrow=c(1,2)) slope_bdur <- B[,8] / (((B[,3]+B[,5]) + (B[,3]+B[,7]+B[,5]+B[,9]))/2) slope_bayes <- outB$beta_5 / (((outB$beta_2) + (outB$beta_2+outB$beta_4))/2)


Input: sanity check to ensure that we get same estimates from frequentist or Bayesian analysis [CODESPLIT] plot(slope_bdur, slope_bayes, ylab="slope (Bayesian)",xlab="slope (frequentist)", pch=19) abline(a=0,b=1,lty=2) cor.test(slope_bdur, slope_bayes)


Input: n: sample size of each study simtot: number of simulations seed 1 Compute d33, ncp33 and df for the original sample [CODESPLIT] d33=pwr.t.test(n=n,sig.level=0.05,power=1/3,type="two.sample")$d ncp33=sqrt(n/2)*d33 df=2*n-2


Input: point estimate p hat (just mean average of coefficients) [CODESPLIT] pe <-mean(cors)


Input: next, we use the bridge_sampler() function which will stabilize the calculated BFs see Schad et al 2022 https://psycnet.apa.org/doi/10.1037/met0000472 [CODESPLIT] model.intox.seq.bf <- bridge_sampler(model.intox.seq, silent = TRUE) model.intox.seq.null.bf <- bridge_sampler(model.intox.seq.null, silent = TRUE)


Input: figure out which columns contain NAs [CODESPLIT] missing_cols <- colSums(is.na(data.conseq)) > 0 print(names(data.conseq)[missing_cols])


Input: age recored as 1 18, to correct we added 17 to all age variables [CODESPLIT] data$age <- data$age + 17


Input: User language variable into a factor [CODESPLIT] data$UserLanguage <- ifelse(data$UserLanguage == "EN", "EN", "NL") data$UserLanguage <- as.factor(data$UserLanguage) contrasts(data$UserLanguage) <- c(0, 1)


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


Input: Plot effect of first and third principal component [CODESPLIT] eigenfunctions.df = read.table(file="../data/final/eigenfunctions_breach.dat", header=T) fig.df1 <- data.frame(HR = c(eigenfunctions.df$pc1*-0.0305, eigenfunctions.df$pc1*0.1355), Condition = rep(c(rep("Breach", 51), rep("Fulfilment", 51))), Time=rep(seq(0,1, by=1/50),2), pc="Principal component 1") fig.df2 <- data.frame(HR = c(eigenfunctions.df$pc3*0.0278, eigenfunctions.df$pc3*-0.0617), Condition = rep(c(rep("Breach", 51), rep("Fulfilment", 51))), Time=rep(seq(0,1, by=1/50),2), pc="Principal component 3") fig.df = rbind(fig.df1, fig.df2) fig <- ggplot(fig.df, aes(x=Time, y =HR, linetype=Condition))+ geom_line()+ geom_vline(xintercept=.20, linetype="dashed")+ facet_grid(~pc)+ theme_bw() fig ggsave(file="../figures/figure3.png", width=8, height=6)


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


Input: function R2 gives you two different types of R2 and of predicted values input pcor a partial correlation matrix / network output a matrix of betas, each column corresponds to a dependent variable so that you can get predicted values by a matrix multiplication in the form betas %*% data this function gives you R2 and predicted values from betas + data two types of R2 and predicted values are considered: R2_orig and predicted_orig use beta weights directly implied by the graphical lasso regularization R2_refit and predicted_refit use only the sparsity pattern of the network and then refit linear regression using the network only for prediction but not for shrinkage (this one should do better in terms of prediction) refit: logical, regulates whether R2_refit and predicted_refit are computed. set it to FALSE to speed up computations [CODESPLIT] R2 <- function(betas, dt, refit = TRUE) { dt <- data.frame(scale(dt)) out <- list() p <- ncol(betas)


Input: refit the model considering the sparsity pattern inicated by the network first fit regression using the sparsity indciated in the matrix of betas [CODESPLIT] betas_refit <- matrix(0, ncol = p, nrow = p) for(i in 1:p) { if(any(betas[,i] != 0)) { fit <- lm(dt[,i] ~ as.matrix(dt[,betas[,i] != 0])) betas_refit[betas[,i] != 0, i] <- fit$coefficients[-1] } else betas_refit[,i] <- 0 } predicted <- as.matrix(dt) %*% betas_refit


Input: fit the data using the lm function [CODESPLIT] bcafit <- lm(Abs562 ~ BSA, data = bca)


Input: rename the columns for display [CODESPLIT] colnames(samptab) <- c("Absorbance", "Concentration (mg/mL)")


Input: departure time (12 hours so we can calculate easy the mean) [CODESPLIT] d1[, time_ := strftime(datetime_ - 60*60*12, format="%H:%M:%S")] d1[, time_ := as.POSIXct(time_, format="%H:%M:%S")]


Input: This creates a variable "period" in the dataframe myDataISO: [CODESPLIT] myDataISO$period<-gl(2, 1202, labels = c("first", "second")) # We created 2 sets of 1202 scores, the labels option then specifies the names to attach to these 2 sets, which correspond to the levels of "period" (first measurement and follow-up).


Input: MIXED DESIGNS AS A GLM Setting contrasts for quarantine subperiod: [CODESPLIT] myDataISO$quar.duration<-as.factor(myDataISO$quar.duration) is.factor(myDataISO$quar.duration) basvs10days<-c(0,1,0,0) # this compares the baseline (prior to quarantine) to a quarantine sub.period of up to 10-days duration basvs50days<-c(0,0,1,0) # this compares the baseline (prior to quarantine) to a quarantine sub.period of up to 50-days duration basvs103days<-c(0,0,0,1) # this compares the baseline (prior to quarantine) to a quarantine sub.period of up to 103-days duration contrasts(myDataISO$quar.duration)<-cbind(basvs10days, basvs50days, basvs103days) myDataISO$quar.duration # To check we setted the contrasts correctly myDataISOIMP2$quar.duration<-as.factor(myDataISOIMP2$quar.duration) is.factor(myDataISOIMP2$quar.duration) basvs10days<-c(0,1,0,0) # this compares the baseline (prior to quarantine) to a quarantine sub.period of up to 10-days duration basvs50days<-c(0,0,1,0) # this compares the baseline (prior to quarantine) to a quarantine sub.period of up to 50-days duration basvs103days<-c(0,0,0,1) # this compares the baseline (prior to quarantine) to a quarantine sub.period of up to 103-days duration contrasts(myDataISOIMP2$quar.duration)<-cbind(basvs10days, basvs50days, basvs103days) myDataISOIMP2$quar.duration # To check we setted the contrasts correctly


Input: Calculating effect sizes library(DSUR.noof) We got effect sizes of meaningful predictors by executing: rcontrast(t,df) periodsecond [CODESPLIT] rcontrast(-2.685100, 97) rcontrast(-5.280908, 1201)


Input: Simulate time varying variable X [CODESPLIT] data.X = expand.grid(Obs=1:T.obs,ID=1:N.dyad) var.diag.X = c(sigma.XF,sigma.XM) Sigma.X = diag(length(var.diag.X)) Sigma.X[lower.tri(Sigma.X, diag=FALSE)] = rho.X Sigma.X = pmax(Sigma.X, t(Sigma.X), na.rm=TRUE) Sigma.X = diag(var.diag.X)%*%Sigma.X%*%diag(var.diag.X) data.X = cbind(data.X,mvrnorm(N.dyad*T.obs,c(mu.XF,mu.XM),Sigma.X)) colnames(data.X) = c('Obs','ID','X.F','X.M') X.F = data.X[,'X.F'] X.M = data.X[,'X.M'] D.dyad = rbinom(N.dyad*T.obs,1,prob.D) data.X = cbind(data.X,D.dyad)


Input: left_join remaining_uncertain_matched to author_data, subset to remove non [CODESPLIT] author_data <- left_join(author_data, remaining_uncertain_matched, by = c("index" = "index")) author_data$match <- as.integer(author_data$match)


Input: remerge (left_join) author_names with author_data [CODESPLIT] author_data <- left_join(test, author_data, by = c("Contact.apsa", "NameSort.apsa")) %>% subset(duplicated(Contact.apsa) == FALSE)


Input: Number of subjects in each group [CODESPLIT] n.group = c(rep(0,N.0),rep(1,N.1)) n.group = c(rep(0,N.0),rep(1,N.1)) n.group = c(rep(0,N.0),rep(1,N.1)) n.group = c(rep(0,N.0),rep(1,N.1))


Input: Create variables days, beeps per day and Z [CODESPLIT] data.IL = expand.grid(Time=1:T,Z=n.group) data.IL = expand.grid(Time=1:T,W=W.i) data.IL = expand.grid(Time=1:T,subjno=1:N) data.IL = expand.grid(Time=1:T,subjno=1:N) data.IL = expand.grid(Time=1:T,Z=n.group) data.IL = expand.grid(Time=1:T,Z=n.group) data.IL = expand.grid(Time=1:T,W=W.i) data.IL = expand.grid(Time=1:T,W=W.i) data.IL = expand.grid(Time=1:T,subjno=1:N) data.IL = expand.grid(Time=1:T,Z=n.group) data.IL = expand.grid(Time=1:T,W=W.i)


Input: Create variable subjno [CODESPLIT] subjno = expand.grid(1:T,1:N)[,2] data.IL = cbind(subjno,data.IL) Z = data.IL$Z subjno = expand.grid(1:T,1:N)[,2] data.IL = cbind(subjno,data.IL) W = data.IL$W subjno = expand.grid(1:T,1:N)[,2] data.IL = cbind(subjno,data.IL) Z = data.IL$Z subjno = expand.grid(1:T,1:N)[,2] data.IL = cbind(subjno,data.IL) Z = data.IL$Z subjno = expand.grid(1:T,1:N)[,2] data.IL = cbind(subjno,data.IL) W = data.IL$W subjno = expand.grid(1:T,1:N)[,2] data.IL = cbind(subjno,data.IL) W = data.IL$W subjno = expand.grid(1:T,1:N)[,2] data.IL = cbind(subjno,data.IL) Z = data.IL$Z subjno = expand.grid(1:T,1:N)[,2] data.IL = cbind(subjno,data.IL) W = data.IL$W


Input: Create lag Y variable within days for each individual [CODESPLIT] Ylag = lag.Y(data) data = data.frame(cbind(data,Ylag)) } Ylag = lag.Y(data) data = data.frame(cbind(data,Ylag)) } Ylag = lag.Y(data) data = data.frame(cbind(data,Ylag)) }


Input: Parameters of random intercept and random slope are generated from a Beta distribution Parameters of Group0 Stationarity condition: sigma.v1 < sqrt(1b10^2) [CODESPLIT] if (sigma.v1 > sqrt(1-b10^2)) {stop('To ensure that the model in Group 0 is stationary check that standard deviation of the random slope is smaller than sqrt(1-b10^2) where b10 is the fixed autorregressive effect')} mu.beta.0 = (b10+1)/2 sigma.beta.0 = sigma.v1/2 alpha.beta.0 = mu.beta.0^2*(((1-mu.beta.0)/sigma.beta.0^2) - (1/mu.beta.0)) beta.beta.0 = alpha.beta.0*((1/mu.beta.0) - 1) gamma.01 = rbeta(N.0, alpha.beta.0, beta.beta.0)*2-1 gamma.00 = sigma.v0*(rho.v*scale(gamma.01)+sqrt(1-rho.v^2)*rnorm(N.0)) + rep(b00,N.0)


Input: Parameters of random intercept and random slope are generated from a Beta distribution [CODESPLIT] mu.beta.1 = (b10+b11.W*W.i[i]+1)/2 sigma.beta.1 = sigma.v1/2 alpha.beta.1 = mu.beta.1^2*(((1-mu.beta.1)/sigma.beta.1^2) - (1/mu.beta.1)) beta.beta.1 = alpha.beta.1*((1/mu.beta.1) - 1) gamma.1 = rbeta(1, alpha.beta.1, beta.beta.1)*2-1 gamma.0 = sigma.v0*((rho.v*(gamma.1-(b10+b11.W*W.i[i]))/sigma.v1) + sqrt(1-rho.v^2)*rnorm(1)) + b00+b01.W*W.i[i] if (Ylag.center == TRUE){ AR.epsilon = list(order=c(1,0,0), ar=gamma.1, include.mean = FALSE) Y[which(data.IL$subjno==i)] = arima.sim(n=T,AR.epsilon)*sqrt(1-gamma.1^2)*sigma + gamma.0 } if (Ylag.center == FALSE){ AR.epsilon = list(order=c(1,0,0), ar=gamma.1, include.mean = FALSE) Y[which(data.IL$subjno==i)] = arima.sim(n=T,AR.epsilon)*sqrt(1-gamma.1^2)*sigma + gamma.0/(1-gamma.1) }}


Input: Get statistics for observed networks [CODESPLIT] obs_df <- GetNetStats(group_fit$networks, group_fit$formula, "model") colnames(obs_df) <- stat_labels obs_df <- obs_df %>% mutate(n=1:200, Group=rep(c("Young","Old"), each=100)) %>% melt(measure.vars=stat_labels, variable.name="Stat") obs_df <- rbind(obs_df, data.frame(n=1:200, Group=rep(c("Young","Old"), each=100), Stat = "Local efficiency", value = local_eff), data.frame(n=1:200, Group=rep(c("Young","Old"), each=100), Stat = "Global efficiency", value = global_eff)) sim_df <- obs_df[0, ] young_nets <- group_fit$networks[1:100] for (i in 1:n_sample){ y <- young_nets[[sample(length(young_nets),1)]] myformula <- statnet.common::nonsimp_update.formula(group_fit$formula, y ~., from.new = "y")


Input: Source functions that allow to easily draw nice visualizations [CODESPLIT] source("visual_functions_all.R") source("visualize_niceplot.R")


Input: Test H1d. "Compliance with behavioural guidelines" by Countries random intercept (country) + the fixed effect of country for all coefficients, priors ~ Cauchy (0, 1) [CODESPLIT] prior.coef <- brms::prior(cauchy(0,1),class='b')


Input: Calculate total number of language selected by each subj. We will use this to compute a mean weight [CODESPLIT] sum.home.languages <- adj.home %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, language) %>% dplyr::summarise(n=any(val==1)) %>% dplyr::summarise(n_languages=sum(n)) sum.fam.languages <- adj.fam %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, language) %>% dplyr::summarise(n = any(val == 1)) %>% dplyr::summarise(n_languages=sum(n)) sum.social.languages <- adj.social %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, language) %>% dplyr::summarise(n = any(val == 1)) %>% dplyr::summarise(n_languages=sum(n)) sum.work.languages <- adj.work %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, language) %>% dplyr::summarise(n = any(val == 1)) %>% dplyr::summarise(n_languages=sum(n))


Input: Sum up the adjacency values for each subject for each topictopic pairing, merge with the number of contexts containing responses, and compute mean [CODESPLIT] sum.adj.home <- adj.home %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, topic,topic2) %>% dplyr::summarise(sum=sum(val)) %>% dplyr::left_join(sum.home.languages) %>% dplyr::mutate(avg=sum/n_languages) %>% ungroup() sum.adj.fam <- adj.fam %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, topic,topic2) %>% dplyr::summarise(sum=sum(val)) %>% dplyr::left_join(sum.fam.languages) %>% dplyr::mutate(avg=sum/n_languages) %>% ungroup() sum.adj.school <- adj.school %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, topic,topic2) %>% dplyr::summarise(sum=sum(val)) %>% dplyr::left_join(sum.school.languages) %>% dplyr::mutate(avg=sum/n_languages) %>% ungroup() sum.adj.social <- adj.social %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, topic,topic2) %>% dplyr::summarise(sum=sum(val)) %>% dplyr::left_join(sum.social.languages) %>% dplyr::mutate(avg=sum/n_languages) %>% ungroup() sum.adj.work <- adj.work %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, topic,topic2) %>% dplyr::summarise(sum=sum(val)) %>% dplyr::left_join(sum.work.languages) %>% dplyr::mutate(avg=sum/n_languages) %>% ungroup() sum.adj.dom <- adj.dom %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, topic,topic2) %>% dplyr::summarise(sum=sum(val)) %>% dplyr::left_join(sum.dom.context) %>% dplyr::mutate(avg=sum/n_context) %>% ungroup() sum.adj.non <- adj.non %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, topic,topic2) %>% dplyr::summarise(sum=sum(val)) %>% dplyr::left_join(sum.non.context) %>% dplyr::mutate(avg=sum/n_context) %>% ungroup()


Input: Calculate total number of languages selected by each subj. We will use this to compute a mean weight [CODESPLIT] sum.school.languages <- adj.school %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, language) %>% dplyr::summarise(n = any(val == 1)) %>% dplyr::summarise(n_languages=sum(n))


Input: NETWORK SIZE (i.e., how many topics are used in each network?) [CODESPLIT] c.size.long <- contexts.mean %>% select(subject, contains("networkSize")) %>% gather(context, network.size, contains("networkSize")) c.size.long$context = factor(c.size.long$context, levels = c("work.networkSize", "school.networkSize", "home.networkSize", "fam.networkSize", "social.networkSize"), labels = c("Work", "School", "Home", "Family", "Social")) c.size.long = c.size.long %>% filter(!is.na(network.size)) c.size.summary = convenience::sem(c.size.long, dv = network.size, id = subject, context)


Input: Calculate total number of contexts selected by each subj. We will use this to compute a mean weight [CODESPLIT] sum.dom.context <- adj.dom %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, context) %>% dplyr::summarise(n = any(val == 1)) %>% dplyr::summarise(n_context=sum(n)) sum.non.context <- adj.non %>% gather(topic2, val, chitchat:gossip) %>% dplyr::group_by(subject, context) %>% dplyr::summarise(n = any(val == 1)) %>% dplyr::summarise(n_context=sum(n))


Input: Language network stats NETWORK WEIGHT (i.e., how many contexts is each topictopic pair used in this language?) [CODESPLIT] language.wide <- sum.adj.dom %>% dplyr::full_join(sum.adj.non, by = c("subject", "topic", "topic2")) %>% select(-contains("n_context")) %>% select(-contains("avg")) names(language.wide) <- c("subject","topic", "topic2", "Dominant Language", "Non-dominant Language") language.long <- gather(language.wide, language, weight, "Dominant Language":"Non-dominant Language") language.long = language.long %>% filter(!is.na(weight)) l.weight.summary = convenience::sem(language.long, dv = weight, id = subject, language) language.aov <- aov(weight ~ language, data = language.long) summary.aov(language.aov) # sig***


Input: Mutate targets to uppercase [CODESPLIT] SPD_all <- SPD_all %>% mutate(target = toupper(target)) dat <- dat %>% mutate(target = toupper(target))


Input: Compute Zscores separately for each participant and each session [CODESPLIT] group_by(Subject, Session) %>% mutate(Ztarget.RT = scale(target.RT)) %>% ungroup() %>%


Input: look up pchange in table based on reward (yes/no) and confidence unselected advisor [CODESPLIT] sel.row <- subset(p_switch, Reward == reward & Conf.unsel.adv == unselect.adv.conf) sel.row pswitch <- sel.row$Changed pswitch


Input: exploratory bifactor analysis [CODESPLIT] fa(resp, fm="ml", cor="tet", nfactors = 5, rotate = "bifactor", correct = 0)


Input: estimating Rasch Tree models for gender & age [CODESPLIT] gender.dif<-raschtree(dat~gender, data=bdat, deriv="numeric", alpha=.01, bonferroni=TRUE) age.dif<-raschtree(dat~age, data=bdat, deriv="numeric", minsize=400, alpha=.01, bonferroni=TRUE) summary(gender.dif) summary(age.dif) plot(gender.dif) plot(age.dif)


Input: set those study grades to NA which are outside the range of the grading system [CODESPLIT] mSI$crt.gru_s_w2[mSI$crt.gru_s_w2 == 0] <- NA mSI$crt.gru_s_w2[mSI$crt.gru_s_w2 > 6] <- NA


Input: compute and save descriptives statistics of variables before aggregation and standardization [CODESPLIT] descriptives <- round(select(psych::describe(mSI_descr), n, min, max, mean, sd),2) write.table(descriptives, file="Descriptives/descriptives_Sample_E_mSI.dat", sep="\t")


Input: mean 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: paired contrasts on estimated marginal means to unpack interaction [CODESPLIT] emm_options(lmer.df = "satterthwaite") fitlmer2.em <- emmeans::emmeans(fitlmer2, specs = ~ target*condition | target) fitlmer2.em # estimated marginal means contrast(fitlmer2.em, method = "trt.vs.ctrl", adjust = "none") # paired contrasts with no correction confint(contrast(fitlmer2.em, method = "trt.vs.ctrl", adjust = "none")) # 95% confidence intervals contrast(fitlmer2.em, method = "trt.vs.ctrl", adjust = "holm") # paired contrasts with holm correction s <- as.data.frame(summary(fitlmer2.em))


Input: Statistical tests: ECT Choice score vs Training criteria Did mice reduce their choice score in the test compared to 80% criteria? using JBTxECT_id.csv dataset [CODESPLIT] wilcox.test(md_id$choice_score[md_id$rat_bedding != "mixed"], mu = 0.6) # 80% big = NCT score 0.6


Input: Make figures and tables check for correlaitons between individuals [CODESPLIT] chart.Correlation(ind_res[[14]][,1:6] , histogram=TRUE, pch=19)


Input: define plot styling pp_color for predictive draw lines, set in plotting_style.R [CODESPLIT] cat("\n\nPlotting posterior predictive checks...\n") cat("Ignore coordinate system and colour warnings;;", "these are expected behavior\n") chains <- rstan::extract(fit) n_checks = length(chains$titer_rep_censored[, 1]) sample_checks = sample(1:n_checks, n_to_plot) print(sample_checks) print(names(chains)) cat(sprintf("\nPlotting pp checks...\n\n")) real_titers <- dat$log10_titer rep_titers <- chains$titer_rep_censored[sample_checks, ] plot_upper <- pp_check(10^(real_titers), yrep = 10^(rep_titers), ## convert to RML titer fun = ppc_dens_overlay, alpha = 0.2) + ggtitle("Predictive checks") + scale_color_manual(name="", labels = c("real data", "posterior predictive draws"), values = c("black", pp_color)) + scale_x_continuous( trans = 'log10', labels = trans_format('log10', math_format(10^.x))) + coord_cartesian(xlim = c(10^0.5, 10^6.5)) + expand_limits(x = 0.5, y = 0) + theme_project(base_size = 30)


Input: extract relevant data & calculate Brier score for each participant [CODESPLIT] lay.data <- NULL for (i in 1:nsubjects) { study.order <- as.numeric(unlist(strsplit(prediction.data$preorder[i], split="|", fixed = TRUE)))[2:28] label <- ifelse(prediction.data$Conditie[i]==1,"des.","bf.") subject.data <- NULL for (j in 1:nstudies){ understanding <- eval(parse(text = paste0("prediction.data$`",study.order[j],"_",label,"0`" )))[i] # 1 = did not understand, otherwise: NA replication.belief <- eval(parse(text = paste0("prediction.data$`",study.order[j],"_",label,"belief`" )))[i] - 1 # now 0 = will not be replicated, 1 = will be replicated confidence.rating <- eval(parse(text = paste0("prediction.data$`",study.order[j],"_",label,"conf_1`")))[i] # on a scale from 0 - 100 confidence.rating <- ifelse(replication.belief == 0, confidence.rating*-1, confidence.rating) # make confidence in replication failure negative confidence.rating <- confidence.rating / 200 + .5 # convert to 0-1 scale study <- j condition <- ifelse(label == "des.","DescriptionOnly","DescriptionPlusStatistics") replication.outcome <- replication.outcomes[j] replication.effectsize <- replication.effectsizes[j] ind.subject.data <- cbind(study,condition,understanding,replication.belief,confidence.rating, replication.outcome,replication.effectsize) subject.data <- rbind(subject.data,ind.subject.data) } subject <- i ind.lay.data <- cbind(subject,subject.data) lay.data <- rbind(lay.data,ind.lay.data) } rm(study.order,label,condition,subject.data,understanding,replication.belief,confidence.rating, i,j,study,replication.outcome,replication.effectsize,ind.subject.data,subject,ind.lay.data)


Input: 3. Data exclusion based on set criteria criteria: 1. if participants failed the attention check (i.e., did not press 'NO' and 75% (range 7080 is allowed)) 2. if a study description is not understood, exlcude this study for this participant 3. if a study is not understood by > 50% of the participants, exclude this study 4. if a participant does not understand > 50% of the studies, exclude this participant [CODESPLIT] bogus.study <- 27 clean.data <- as.data.frame(lay.data, stringsAsFactors = FALSE) correct.range <- clean.data[clean.data$study==bogus.study,]$confidence.rating correct.range <- rep(correct.range >= .1 & correct.range <= .15, each = nstudies) # correct range NO and 70-80% --> .1-.15 on the confidence scale clean.data.1 <- clean.data[correct.range,] # apply 1. clean.data.2 <- clean.data.1[is.na(clean.data.1$understanding),] # apply 2. remove.studies <- which(table(clean.data.2$study)<nsubjects/2) # indicate which studies are understood by less than half of the people clean.data.3 <- clean.data.2[! clean.data.2$study %in% remove.studies,] # apply 3. remove.subjects <- which(table(clean.data.3$subject)<nstudies/2) # indicate which subjects understood less than half of the studies clean.data.4 <- clean.data.3[! clean.data.3$subject %in% remove.subjects,] # apply 4. full.data <- clean.data.4 full.data$understanding <- NULL # delete empty column


Input: total_distance of roads surveyed [CODESPLIT] sum(unique(site_data_cleaned$Site_Length_m))


Input: Bring in census data for each site. [CODESPLIT] census_data <- fread("StudyAreas/Demographic_Site_Data/PDB_2015_Tract.csv")


Input: Plot Quantiles against one another. [CODESPLIT] p2 <- ggplot() + geom_point(aes(y = receipt_distance_quantiles, x = montecarlo_distance_quantiles)) + geom_smooth(aes(y = receipt_distance_quantiles, x = montecarlo_distance_quantiles), method = "lm", se = F) + scale_x_log10(breaks= 10^c(1:5)) + scale_y_log10() + theme_classic(base_size = 20) + labs(x = "Human Trip Quantile Distance (m)", y = "Receipt Quantile Distance (m)") + coord_equal() + geom_abline(intercept = 0, slope = 1)


Input: join the trash bearing data and wind data into single frame for plotting. [CODESPLIT] CompleteDataCoordPlot <- CompleteDataWithGoogle %>% filter(!is.na(windxcoordmeanbearing) & !is.na(trashxcoordbearing)) %>% #Removes data where we don't have wind or dont have receipt direction from the analysis. dplyr::select(windxcoordmeanbearing, windycoordmeanbearing, row) %>% rename(x = windxcoordmeanbearing, y = windycoordmeanbearing) %>% bind_rows(CompleteDataWithGoogle %>% filter(!is.na(windxcoordmeanbearing) & !is.na(trashxcoordbearing)) %>% dplyr::select(trashycoordbearing, trashxcoordbearing, row) %>% rename(x = trashycoordbearing, y = trashxcoordbearing))


Input: Check if Trial column exists, if not create it [CODESPLIT] if (!"Trial" %in% colnames(df)) { df <- cbind(Trial = NA, df) } trial_counter <- 1 for (i in seq_along(index_pairs$start)) { start_pos <- index_pairs$start[i] end_pos <- index_pairs$end[i]


Input: group level Pi/Pb for each set size on probability scale [CODESPLIT] PiIdx <- NULL for (j in 1:nsubj) PiIdx <- c(PiIdx, which(names(as.data.frame(mcmcChain)) == paste0("Pi[", j, ",", s, "]"))) PbIdx <- NULL for (j in 1:nsubj) PbIdx <- c(PbIdx, which(names(as.data.frame(mcmcChain)) == paste0("Pb[", j, ",", s, "]"))) meanPi[s,experiment,] <- rowMeans(mcmcChain[, PiIdx]) # means across subjects of posterior means of Pi for each set size meanPb[s,experiment,] <- rowMeans(mcmcChain[, PbIdx]) } DeltaPi[,experiment] <- mcmcChain[, paste0("dPi")] # posterior samples of slope of Pi over set size DeltaPb[,experiment] <- mcmcChain[, paste0("dPb")] print(colMeans(DeltaPi>0)) # proportion of posterior samples > 0 save(MuPi, MuPb, meanPi, meanPb, DeltaPi, DeltaPb, file=parChainFile) }


Input: determine manifestations and visualize cultural value dimensions [CODESPLIT] d$SVS_d1 <- d$SVS_harmony - d$SVS_mastery d$SVS_d2 <- d$SVS_egalit - d$SVS_hierarchy d$SVS_d3 <- (d$SVS_autona+d$SVS_autoni)/2 - d$SVS_embed cor(d[grepl("_d",names(d))]) f$SVS_d1 <- f$SVS_harmony - f$SVS_mastery f$SVS_d2 <- f$SVS_egalit - f$SVS_hierarchy f$SVS_d3 <- (f$SVS_autona+f$SVS_autoni)/2 - f$SVS_embed cor(f[grepl("_d",names(f))]) pcf <- princomp(f[,3:9], cor=T) summary(pcf) loadings(pcf)


Input: CTRees analyze the trees for each agreement indicator individually: Variationcorrelation of reported likelihood ~ proportion unstable: [CODESPLIT] png("output/figures/paper/ctree_rhopsi.png", width = 600, height = 350) VS_ <- VS VS_ <- VS_[!is.na(VS_$rho_llhd) & !is.na(VS_$lagZ_20), ] VS_ <- VS_[!VS_$gtype_class %in% c("IFrc", "IFsc", "MFcr", "FCxr") & VS_$band == "TL", ] VS_$gtype_class[VS_$gtype_class %in% "SH" & VS_$gtype_rank == "secondary"] <- "SH/FC" CT <- partykit::ctree(rho_llhd ~ nPDays , data = VS_, alpha = 0.05, maxdepth = 2) Vars <- setVars4ctreeColoring(VS_) plotCTree(CT) dev.off()


Input: Selecting and recoding items that were measured in all waves [CODESPLIT] d <- df %>% select(id, wave, lsat = sat6, fsat = sat1i3, per1i2, per1i7, per1i13) %>% mutate(per1i2 = invert(per1i2, 5))


Input: 6. Extract & plot estimates Is evolution more comparable to B0 or B1? [CODESPLIT] describe_posterior((r.delta.z[,1,])) # B0_Conc describe_posterior((r.delta.z[,2,])) # B0_Disc describe_posterior((r.delta.z[,3,])) # B1_Conc describe_posterior((r.delta.z[,4,])) # B1_Disc


Input: for each subject, aggregate his/her selfratings across all interactions (in second and third week of eventbased assessment) [CODESPLIT] app_SR_aggr <- aggregate(app_SR, by=list(app_SR$id_a), mean)


Input: recode abitur grades which were not provided but stored as 0, and grades that were provided in units of the wrong grading system [CODESPLIT] surv2345$abitur_grade[surv2345$abitur_grade == 0] <- NA surv2345$abitur_grade[surv2345$abitur_grade == 12] <- 2.0 surv2345$abitur_grade[surv2345$abitur_grade == 13] <- 1.7


Input: define a function which, for each person, selects the first nonNA measurement he provided out of three time points ( out of three variables) [CODESPLIT] firstnonNA_3timepoints <- function(df) {if(all(is.na(df))){ NA } else if (!is.na(df[1])){ df[1] } else if (!is.na(df[2])){ df[2] } else if (!is.na(df[3])){ df[3] } }


Input: for the exam grades 15 to 18 which have been assessed only at the last occasions (Survey 5), save the grade in new variable for consistency in notation [CODESPLIT] surv2345$retro_grades_15 <- surv2345$retro_grades_15_t5 surv2345$retro_grades_16 <- surv2345$retro_grades_16_t5 surv2345$retro_grades_17 <- surv2345$retro_grades_17_t5 surv2345$retro_grades_18 <- surv2345$retro_grades_18_t5


Input: select variables (all 18 exam grades) to be aggregated for mean exam grade [CODESPLIT] retro_grades_df <- as.matrix(surv2345[,paste0("retro_grades_",1:18)])


Input: Select variables for the analyses and save data frame that will be uploaded in the OSF [CODESPLIT] connect_osf <- select(connect, Z_Raven_self:Z_MWTB_obj, Z_global_selfeval:Z_achievement) write.table(connect_osf, file="Data_Sample_C_connect.txt",sep = "\t",col.names=TRUE)


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


Input: compute and save correlation table of variables before aggregation and standardization [CODESPLIT] cor_raw <- corcons(connect_descr) write.table(cor_raw, file="Descriptives/correlations_raw_Sample_C_connect.dat", sep="\t")


Input: Hypothesis 1.1 Hypothesis 1 was tested via pairedsample t.tests (alphas need to be Bonferronicorrected) Examples for conscientious goal classes (first two rows of Table 1 Conscientious Goals). Remaining tests are simialr [CODESPLIT] t.test(x = dt1$CP_Class_01, y = dt1$CN_Class_01, paired = TRUE, alternative = "greater") t.test(x = dt1$CP_Class_02, y = dt1$CN_Class_02, paired = TRUE, alternative = "greater")