Input: Hypothesis 1.2 Hypothesis 1.2 was tested via partiallyoverlapping samples ttests. We report the analyses for the first panel of Table S2 (and for pvalues reported in Table 2). The remaining analyses are identical, but were performed on other goal classes [CODESPLIT] Partover.test(dt1$CP_Class_01, dt1$HP_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$EP_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$XP_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$AP_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$OP_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$HN_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$EN_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$XN_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$AN_Class_01, stacked = TRUE, alternative = "greater") Partover.test(dt1$CP_Class_01, dt1$ON_Class_01, stacked = TRUE, alternative = "greater")


Input: Examples of Tobit regressions of the subjective importance of specific goals on HEXACO traits (first two lines of Table 3). Pvalues need to be corrected using the Bonferroni method, considering that we performed 21 multiple regressions (multiply them by 21 and round values larger than 1 to 1) [CODESPLIT] predictors <- select(dt2, HEXACO_H:HEXACO_O) %>% scale() fit1 <- censReg(dt2$G_C_01_DimostrareQlcQln_Importance ~ predictors, left = 1, right = 9) summary(fit1) fit2 <- censReg(dt2$G_C_02_EssereDegnoFiducia_Importance ~ predictors, left = 1, right = 9) summary(fit2)


Input: Hierarchical regression predicting the willingness to change conscientiousness according to CBFI (Table 4). For ease of formatting, I used the R package AutoModel [CODESPLIT] Data4HierarchicalReg <- select(dt2, CBFI_C, POS, HEXACO_H:HEXACO_O, BFI2_O:BFI2_N, Importance_GC, Importance_GU) %>% scale() %>% data.frame() Data4HierarchicalReg$BFTGI_C_bin <- as.numeric(dt2$BFTGI_C == 3)


Input: Hypothesis 3.2 multiple regressions predicting each goal class from HEXACO traits (we report examples reproducing the first two rows of Table 8, the code for the others is similar, save for the goal class). Pvalues need to be corrected using the Bonferroni method, considering 9 multiple regressions (multiply them by 9 and transform values > 1 to 1) [CODESPLIT] lm(G08Rules ~ ., data = select(dt3, G08Rules, HEXACO_H:HEXACO_O)) %>% lm.beta %>% summary lm(G10Control ~ ., data = select(dt3, G10Control, HEXACO_H:HEXACO_O)) %>% lm.beta %>% summary


Input: DIFFERENTIAL ITEM FUNCTIONING Create trichotomous income variable [CODESPLIT] data = data %>% mutate( income3 = recode(income, '1=1;; 2=1;; 3=1;; 4=1;; 5=1;; 6=1;; 7=1;; 8=1;; 9=2;; 10=2;; 11=2;; 12=2;; 13=2;; 14=3;; 15=3;; 16=3;; 17=3;; 18=3')) q1merit = data[c("Q1A", "Q1B", "Q1H", "Q1N")] q1opportunity = data[c("Q1C", "Q1D", "Q1F", "Q1G")] q1chance = data[c("Q1I", "Q1O", "Q1P", "Q1Q")] q2merit = data[c("Q2A", "Q2B", "Q2H", "Q2N")] q2opportunity = data[c("Q2C", "Q2D", "Q2F", "Q2G")] q2chance = data[c("Q2I", "Q2O", "Q2Q", "Q2R")] q3merit = data[c("Q3A", "Q3B", "Q3H", "Q3N")] q3opportunity = data[c("Q3C", "Q3D", "Q3F", "Q3G")] q3chance = data[c("Q3I", "Q3O", "Q3P", "Q3Q")] q4merit = data[c("Q4B", "Q4C", "Q4I", "Q4N")] q4opportunity = data[c("Q4D", "Q4E", "Q4G", "Q4H")] q4chance = data[c("Q4J", "Q4O", "Q4P", "Q4Q")] sesmerit = data[c("hs_merit", "ls_merit", "ha_merit", "la_merit")] sesopportunity = data[c("hs_opportunity", "ls_opportunity", "ha_opportunity", "la_opportunity")] seschance = data[c("hs_chance", "ls_chance", "ha_chance", "la_chance")] merit_full = data[c("hs_efft", "hs_abil", "ls_efft", "ls_abil", "ha_efft", "la_efft")] gender = data$gender age = data$AGE4 politic = data$D3 income = data$income3 educ = data$EDUC4


Input: Display distribution of efficacy judgments (can be used to set a prior on the next experiment) [CODESPLIT] eff_all <- c(eff_nograph, eff_graph) par(mfrow=c(2,3)) myhist("Efficacy", eff_all, 1, 9, N/2) myhist("Efficacy - no graph", eff_nograph, 1, 9, N/4) myhist("Efficacy - graph", eff_graph, 1, 9, N/4) cat("Grand mean for efficacy: ", format_number(mean(eff_all)), "\n")


Input: Models by social network measure 1. Indegree [CODESPLIT] m1 <- glmer(pup_year_surv~indegree + valley + overall.index + pup_sex + pup_littersizeborn + mother_age + network_size + pup_emerjdate + overall.index*indegree + valley*indegree + (1|mother_uid) + (1|pup_yrborn), control = glmerControl("bobyqa", optCtrl=list(maxfun=2e5)), data=sur_data, family= binomial) summary(m1)


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


Input: put SDs in parantheses [CODESPLIT] mutate(gender_sd = paste0("(", gender_sd, ")"), age_sd = paste0("(", age_sd, ")"), parent_sd = paste0("(", parent_sd, ")"), pol_sd = paste0("(", pol_sd, ")")) %>% mutate(gender_sd = paste0("(", gender_sd, ")"), age_sd = paste0("(", age_sd, ")"), parent_sd = paste0("(", parent_sd, ")"), pol_sd = paste0("(", pol_sd, ")")) %>% mutate(intent_apply_job_sd = paste0("(", intent_apply_job_sd, ")"), intent_apply_ps_sd = paste0("(", intent_apply_ps_sd, ")"), psm_sd = paste0("(", psm_sd, ")"), pofit_sd = paste0("(", pofit_sd, ")"), pjfit_sd = paste0("(", pjfit_sd, ")")) %>% mutate(intent_apply_job_sd = paste0("(", intent_apply_job_sd, ")"), intent_apply_ps_sd = paste0("(", intent_apply_ps_sd, ")"), psm_sd = paste0("(", psm_sd, ")"), pofit_sd = paste0("(", pofit_sd, ")"), pjfit_sd = paste0("(", pjfit_sd, ")")) %>%


Input: 5.3 Pirateplot for dependent variables [CODESPLIT] df_pirate_dv <- tibble(dv = c(df$intent_apply_job, df$intent_apply_ps), group = c(rep.int(0, length(df$intent_apply_job)), rep.int(1, length(df$intent_apply_ps)))) %>% mutate(group = factor(group, labels = c("Intention to\napply for job", "Intention to apply\nfor public service"))) pirate_dvs <- yarrr::pirateplot(dv ~ group, data = df_pirate_dv, inf.method = "ci", xlab = "Dependent variable", ylab = "", theme = 2, cex.lab = 1.2, cex.axis = 1.2, cex.names = 1.2) pirate_dvs <- recordPlot() # contains all plotting information png("./output/Appendix_pirate_dvs.png") pirate_dvs dev.off()


Input: Load the functions for the raincloud plots [CODESPLIT] source('funcs/R_rainclouds.R')


Input: Save the result and load if you run the permutation test on a different computer than the visualizations [CODESPLIT] save(list.res,file="results.Rdata") load("results.Rdata")


Input: data as a scatter plot, column s for x and column v for y, size 4 points, use the sat_curve data frame as the source [CODESPLIT] geom_point(data = sat_curve, aes(x = s, y = v), size = 4) +


Input: fit as a line plot, use the mm_fit data frame as the data source [CODESPLIT] geom_line(data = mm_fit, aes(x = s, y = v)) +


Input: change the axis label text to size 22, bold, and black color [CODESPLIT] axis.text.x = element_text(size = 22, face = "bold", color = "black"), axis.text.y = element_text(size = 22, face = "bold", color = "black")) +


Input: sequence of age inputs within range of model: (15, 75) years old [CODESPLIT] seq.length <- length(seq(15, 75, 1))


Input: Define link function with softmax transformation The following function is taken from Koster and McElreath (2017) Modifications made to accommodate current model structure (e.g. addition of com_id, month) [CODESPLIT] link.mn <- function( data ) { K <- dim(post$v_id)[3] + 1 ns <- dim(post$v_id)[1] if ( missing(data) ) stop( "BOOM: Need data argument" ) n <- seq.length softmax2 <- function(x) { x <- max(x) - x exp(-x)/sum(exp(-x)) } p <- list() for ( i in 1:n ) { p[[i]] <- sapply( 1:K , function(k) { if ( k < K ) { ptemp <- post$a[,k] + post$bA[,k] * data$age_z[i] + post$bQ[,k] * data$age_zq[i] + post$bT[,k] * data$time_z[i] + post$bTQ[,k] * data$time_zq[i] if ( data$id[i]>0 ) ptemp <- ptemp + post$v_id[,data$id[i],k] if ( data$com_id[i]>0 ) ptemp <- ptemp + post$v_com[,data$com_id[i],k] if ( data$month_id[i]>0 ) ptemp <- ptemp + post$v_month[,data$month_id[i],k] } else { ptemp <- rep(0,ns) } return(ptemp) })


Input: The values are converted to probabilities using the softmax function which ensures that the predicted values across categories sum to 100% probabilities. [CODESPLIT] for ( s in 1:ns ) p[[i]][s,] <- softmax2( p[[i]][s,] ) } return(p) } for ( s in 1:ns ) p[[i]][s,] <- softmax2( p[[i]][s,] ) } return(p) } low_age <- (15 - mean_age_female)/sd_age_female high_age <- (75 - mean_age_female)/sd_age_female


Input: everything will be calculated over the "adult" interval from 15 to 75 [CODESPLIT] age_seq <- (seq(15, 75, 1)- mean_age_female)/sd_age_female


Input: We create a data frame from age_seq and its second order polynomial, holding most of predictors at their sample mean. In the original Koster+McElreath paper, they specified 8:00 am for the time of day in order to effect a more sensible alignment with the empirical data. In this case, we hold that parameter at 0, which therefore corresponds with the mean time of day in our dataset for behavioral observations (0.532 ~12:45). Also, as we noted earlier in the notes about the multinomial link function, we set "id" to zero in order to average over the random effects. [CODESPLIT] pred_dat <- data.frame( id = 0 , age_z = age_seq, age_zq = age_seq^2, time_z = 0, time_zq = 0, com_id = 0, month_id = 0 ) p <- link.mn ( pred_dat )


Input: Biodiversity conversion general form is Index (Maxent ^ wM + Abundance ^ wL )^(1/(wM+wL)) but would need to take care of how this scales [CODESPLIT] pro.fun <- function(x, abuntab, zonename){ (x^wM*abuntab[,which(names(abuntab)==zonename)]^wL)^(1/(wM+wL))}


Input: Construct variable for number of family members in country [CODESPLIT] famcountry = data4$partnerwhere + data4$mumwhere + data4$dadwhere table(famcountry) data4$famcountry <- famcountry hist(data4$famcountry) sum(is.na(data4$famcountry)) #175


Input: Plot network latent variable on CFA latent variable [CODESPLIT] layout(t(c(1,2))) plot(cfaLV, netLV, main = "Network Latent Variable\non CFA Latent Variable", ylab = "Network Latent Variable", xlab = "CFA Latent Variable")


Input: Plot participant means on CFA latent variable [CODESPLIT] plot(cfaLV, pmeans, main = "Participant Means on\nCFA Latent Variable", ylab = "Participant Means", xlab = "CFA Latent Variable")


Input: initialize matrices to store validation results [CODESPLIT] WklValidation <- matrix(nrow = nrow_max, ncol = 13, dimnames = list(seq(nrow_max), c("distribution", "nProfiles_checked", "day_after_burial", "timewindow_lower", "timewindow_upper", "likelihood_reported", "likelihoodSpread_reported", "distribution_reported", "sensitivity_reported", "size_reported", "sizeSpread_reported", "grain_size_reported", "data_quality"))) WklValidation_char <- matrix(nrow = nrow_max, ncol = 10, dimnames = list(seq(nrow_max), c("vf_uuid", "pwl_uuid", "pwl", "validation_date", "band", "timing_mode", "gtype_class", "gtype_rank", "comment", "danger_rating"))) vf_uuid <- NA


Input: run linear models on predicted probabilities, to calculate the trend [CODESPLIT] models <- pred %>% group_by(x, country) %>% nest() %>% mutate(models = map(data, ~ lm(predicted ~ wave, data = .))) %>% spread_coef(models, se = TRUE)


Input: one participant has a typing error in the age variable (stated he was 2). Set to NA. [CODESPLIT] mst1[which(mst1$age == 2), "age"] <- NA


Input: association between vote and ideology [CODESPLIT] ggplot(dat, aes(x = Ideology, y = Percent.Vote.Rep)) + geom_vline(xintercept = .50, color = "gray50", linetype = 2) + geom_hline(yintercept = .50, color = "gray50", linetype = 2) + stat_poly_line() + stat_correlation(label.x = "left", small.r = TRUE) + geom_point() + geom_text_repel(size = 3, aes(label = Group)) + labs(y = "Proportion Voting Republican", x = "Ideology") + coord_cartesian(xlim = c(0, 1), ylim = c(0, 1)) + theme_cowplot() ggsave("figures/predictor_scatter.pdf", width = 5.5, height = 5)


Input: Make a dot and a line color column depending on the significance level Check significance level and if significant add respective color to new column [CODESPLIT] ageR = data.frame(dotCol = rep(ifelse(summary(lm(initLevel ~ age, data = id_df))$coefficients[2,4]< 0.05, "khaki3", "lightgrey"), length(unique(id_df$userCode))), lineCol = rep(ifelse(summary(lm(initLevel ~ age, data = id_df))$coefficients[2,4]< 0.05, "cyan4", "darkgrey"), length(unique(id_df$userCode)))) educR = data.frame(dotCol = rep(ifelse(summary(lm(initLevel ~ educ_y, data = id_df))$coefficients[2,4]< 0.05, "khaki3", "lightgrey"), length(unique(id_df$userCode))), lineCol = rep(ifelse(summary(lm(initLevel ~ educ_y, data = id_df))$coefficients[2,4]< 0.05, "cyan4", "darkgrey"), length(unique(id_df$userCode)))) blpR = data.frame(dotCol = rep(ifelse(summary(lm(initLevel ~ BLP, data = id_df))$coefficients[2,4]< 0.05, "khaki3", "lightgrey"), length(unique(id_df$userCode))), lineCol = rep(ifelse(summary(lm(initLevel ~ BLP, data = id_df))$coefficients[2,4]< 0.05, "cyan4", "darkgrey"), length(unique(id_df$userCode)))) actR = data.frame(dotCol = rep(ifelse(summary(lm(initLevel ~ Act_total, data = id_df))$coefficients[2,4]< 0.05, "khaki3", "lightgrey"), length(unique(id_df$userCode))), lineCol = rep(ifelse(summary(lm(initLevel ~ Act_total, data = id_df))$coefficients[2,4]< 0.05, "cyan4", "darkgrey"), length(unique(id_df$userCode)))) motivR = data.frame(dotCol = rep(ifelse(summary(lm(initLevel ~ socioAffect_init, data = id_df))$coefficients[2,4]< 0.05, "khaki3", "lightgrey"), length(unique(id_df$userCode))), lineCol = rep(ifelse(summary(lm(initLevel ~ socioAffect_init, data = id_df))$coefficients[2,4]< 0.05, "cyan4", "darkgrey"), length(unique(id_df$userCode)))) tmp = rbind.data.frame(ageR, educR, blpR, actR, motivR) corrDF = cbind(corrDF, tmp)


Input: Sample from those names 200 times, with replacement [CODESPLIT] animal <- sample(categories, 200, replace = TRUE)


Input: Create random variables Use rnorm() with varying means and SDs [CODESPLIT] length <- rnorm(200, 30, 8) weight <- rnorm(200, 4, 2) happiness <- rnorm(200, 3.5, 1)


Input: Examine descriptive statistics Use the pipe, group_by(), and summarise() to get means, SDs, and medians for each category [CODESPLIT] animal_data %>% group_by(animal) %>% summarise( weight_mean = mean(weight), weight_sd = sd(weight), weight_median = median(weight) )


Input: Subset data to include only the first two categories Use filter() to select only rows that pass the given logical test [CODESPLIT] subset_1 <- animal_data %>% filter(animal == "puppy" | animal == "kitten")


Input: Use subset for ttest Welch's ttest [CODESPLIT] t.test(weight ~ animal, data = subset_1)


Input: plot spaghettiplot for minute 1 and minute 5 [CODESPLIT] df_1_5 <- rbind(df_min1, df_min5) df_1_5 <- df_1_5 %>% mutate(range=droplevels(range)) p <- ggplot(data = df_1_5, aes(x = range, y = count, group = pp)) p + geom_point() p + geom_line() p + geom_line() + facet_grid(. ~ condition) p <- ggplot(data = df_min, aes(x = range, y = count, group = pp)) p + geom_point() p + geom_line() p + geom_line() + facet_grid(. ~ condition)


Input: do 3 way anova including the factor in which condition they are in [CODESPLIT] bfFull = anovaBF(count ~ condition + range + experiment + condition:range:experiment, data = df_b) bfFull[4]/bfFull[3] bfFull[18]/bfFull[17] bf1 = anovaBF(count ~ condition + range + experiment, data = df_b)


Input: pc: critical pvalue Overview: Creates a vector of the same length as the number of tests submitted to pcurve, significant and not, and computes the proportion of pvalues expected to be smaller than {pc} given the d.f. and outputs the entire vector, with NA values where needed Ftests (& thus ttests) [CODESPLIT] prop=ifelse(family=="f" & p<.05,1-pf(qf(1-pc,df1=df1, df2=df2),df1=df1, df2=df2, ncp=ncp33),NA)


Input: Create vector that numbers studies 1 to N,includes n.s. studies [CODESPLIT] k=seq(from=1,to=length(raw))


Input: 1.2 Parse the entered text into usable statistical results 1.3 Create test type indicator [CODESPLIT] stat=substring(raw,1,1) #stat: t,f,z,c,r test=ifelse(stat=="r","t",stat) #test: t,f,z,c (r-->t)


Input: Make red dot at the estimate [CODESPLIT] points(hat,min(fit,na.rm=TRUE),pch=19,col="red",cex=2)


Input: This loop creates a vector, blue, with 5 elements, with the proportions of p.01,p.02...p.05 [CODESPLIT] for (i in c(.01,.02,.03,.04,.05)) blue=c(blue,sum(ps==i,na.rm=TRUE)/ksig*100)


Input: FIG 3: scree plot for parallel analysis [CODESPLIT] rscree<-as.data.frame(cbind(spar$fa.values, spar$fa.simr)) colnames(rscree)<-c("Actual","Resampled") rscree$item<-seq.int(1, 12, 1) refplot<-pivot_longer(rscree, cols=1:2, names_to="Method") refplot2<-refplot %>% filter(item<5) iscree<-as.data.frame(cbind(ipar$fa.values, ipar$fa.simr)) colnames(iscree)<-c("Actual","Resampled") iscree$item<-seq.int(1, 8, 1) insplot<-pivot_longer(iscree, cols=1:2, names_to="Method") insplot2<-insplot %>% filter(item<5) refeig<-ggline(refplot2, x="item", y="value", group = "Method", color="Method", size=1.1, palette = paletteer_d("palettetown::tangela", direction=-1), xlab="Factor", ylab="Eigenvalue", title="Self-reflection")+ theme_minimal_hgrid(font_size=12, font_family = "Fira Sans Medium") scree.a<-ggpar(refeig, ylim = c(0,6), yticks.by=1, legend = c(.7,.77), legend.title = "") scree.a inseig<-ggline(insplot2, x="item", y="value", group = "Method", color="Method", size=1.1, palette = paletteer_d("palettetown::tangela", direction=-1), xlab="Factor", ylab="", title="Insight")+ theme_minimal_hgrid(font_size=12, font_family = "Fira Sans Medium") scree.b<-ggpar(inseig, ylim = c(0, 6), yticks.by=1, legend = c(.7,.77), legend.title = "") scree.b


Input: make sure data are in chronological order [CODESPLIT] pollenData <- pollenData[order(pollenData$age),] lakeData <- lakeData[order(lakeData$age),] charcoalData <- charcoalData[order(charcoalData$age),] tail(pollenData) tail(lakeData) tail(charcoalData)


Input: examine descriptives of newly created variables here we are combining the dplyr and summarytools packages to subset the data and then get descriptives [CODESPLIT] eid_dat %>% dplyr::select(swl_mean, meim_ex_mean, meim_co_mean) %>% summarytools::descr()


Input: step 6: multiple regression with exploration and commitment predicting SWL this function is in base R so no package to call [CODESPLIT] regression <- lm(swl_mean ~ meim_ex_mean + meim_co_mean, data=eid_dat) summary(regression) confint(regression)


Input: step 7: create scattterplots using ggplot2 scatterplot of exploration with SWL there are many more options you can play with for customization. I just included some basics here [CODESPLIT] ex_swl_scatter <- ggplot2::ggplot(eid_dat, aes(meim_ex_mean, swl_mean)) + geom_point() + ggtitle("My Scatterplot") + xlab("Ethnic Identity Exploration (mean)") + ylab("Satisfaction with Life (mean)") + geom_smooth(method="lm") ex_swl_scatter


Input: scatterplot of commitment with SWL [CODESPLIT] co_swl_scatter <- ggplot2::ggplot(eid_dat, aes(meim_co_mean, swl_mean)) + geom_point() + ggtitle("My Scatterplot") + xlab("Ethnic Identity Commitment (mean)") + ylab("Satisfaction with Life (mean)") + geom_smooth(method="lm") co_swl_scatter


Input: step 8: indepedent samples ttests also in base R. note that Welch's ttest is the default this set is testing for mean differences by whether they were born in the U.S. [CODESPLIT] t.test(eid_dat$meim_ex_mean ~ eid_dat$usborn) t.test(eid_dat$meim_co_mean ~ eid_dat$usborn) t.test(eid_dat$swl_mean ~ eid_dat$usborn)


Input: step 11: create a series of boxplots to go with the previous ANOVAs note that the code here is only slightly different from the one variable case you can/should add elements to format the plots, as you did previously [CODESPLIT] borngen_ex_boxplot <- ggplot2::ggplot(eid_dat, aes(usborn, meim_ex_mean, fill=firstgen)) + geom_boxplot(alpha = 0.5) borngen_ex_boxplot borngen_co_boxplot <- ggplot2::ggplot(eid_dat, aes(usborn, meim_co_mean, fill=firstgen)) + geom_boxplot(alpha = 0.5) borngen_co_boxplot borngen_swl_boxplot <- ggplot2::ggplot(eid_dat, aes(usborn, swl_mean, fill=firstgen)) + geom_boxplot(alpha = 0.5) borngen_swl_boxplot


Input: Add a plotting function to get power curve [CODESPLIT] plot_power_extend <- function(object, target = .80, ...) { nsim <- object[[1]]$n df <- purrr::map_dfr(object, powerinterval, .id = "n", ...) df$n <- as.integer(df$n) ggplot(df, aes(x = n, y = mean, group = 1)) + geom_hline(yintercept = target) + geom_smooth(method = "glm", formula = cbind(y * nsim, (1 - y) * nsim) ~ x, method.args = list(family = binomial("probit"))) + geom_pointrange(aes(ymin = lower, ymax = upper)) + labs(y = "power") + ylim(0, 1) }


Input: check duplicate trials per participant (post) [CODESPLIT] xtabs(~subj+trial,data=rawdat.all) table(rawdat.all$subj)


Input: remove duplicate species per file, and species level data [CODESPLIT] data2.5 <- data2[!data2$species == 'Certhia_sp.',] data2.6 <- data2.5[!data2.5$species == 'Regulus_sp.',] data3 <- data2.6 %>% group_by(Plot_no) %>% mutate(whichday = as.integer(factor(date))) data4 <- data3 %>% group_by(Plot_no, filename) %>% mutate(seq=cur_group_id())


Input: Show sample sizes per country [CODESPLIT] pa12_resp_s %>% group_by(CNT) %>% summarise(n = n())


Input: Gaze Duration Descriptive stats per ID [CODESPLIT] BFSGDesc <- BirdFSG %>% group_by(ID, Stimuli) %>% summarise (MGaze = mean(Gaze), sd=sd(Gaze), n=n(), se = sd/sqrt(n)) ;; BFSGDesc$Stimuli <- paste( BFSGDesc$Stimuli, "S", sep="") BFSGDesc BNADDesc <- BirdNAD %>% group_by(ID, Stimuli) %>% summarise (MGaze = mean(Gaze), sd=sd(Gaze), n=n(), se = sd/sqrt(n)) ;; BNADDesc$Stimuli <- paste( BNADDesc$Stimuli, "S", sep="") BFSGDesc <- as.data.frame(BFSGDesc);; BNADDesc <- as.data.frame(BNADDesc);; BFSGDesc$Stimuli <- as.factor(as.character(BFSGDesc$Stimuli)) BNADDesc$Stimuli <- as.factor(as.character(BNADDesc$Stimuli)) BFSGDesc


Input: p<.05 ONEWAY ANOVA let's say we're interested in investigating the relationship between three species (setosa, versicolor, virginica) outcome: sepal width run Levene's test to check assumption of homogeneity of variance by default centres variable using median library(car) leveneTest(Sepal.Width~Species, datairis,centermean) p>.05 therefore assumption met running oneway ANOVA [CODESPLIT] mod.a<-aov(Sepal.Width~Species, data=iris) summary(mod.a)


Input: generate a random number between 1 and 1000 that functions as the index into an array of random numbers of size 1000 [CODESPLIT] return(randNo[floor(runif(1)*1000)]) }


Input: print the simulation number after every 10% of the simulations [CODESPLIT] if(s%%(sims/10) == 0){ cat(paste(" ", s)) } if(verbose){ print("",quote=FALSE) print("",quote=FALSE) print("=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-", quote=FALSE) print(paste(" Simulation", s, " "), quote=FALSE) print("=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-", quote=FALSE) } for(i in c(1:stages)){ if(i==picCreStage){ add.time(par.dat) if(verbose){ print(paste("------ Adding picture chunks -------"), quote=FALSE) } p.knopf[["ctime"]] = currTime add.chunk(p.knopf) p.flasche[["ctime"]] = currTime add.chunk(p.flasche) if(EXPT1){ p.ballon[["ctime"]] = currTime add.chunk(p.ballon) p.blume[["ctime"]] = currTime add.chunk(p.blume) } martin[["ctime"]] = currTime add.chunk(martin) sarah[["ctime"]] = currTime add.chunk(sarah) } if(verbose){ print("",quote=FALSE) print(paste("=============== ", "Stage ", i, ":", input.stages[i], " ==============="), quote=FALSE) }


Input: mean level of transitive respondents per wave [CODESPLIT] aggregate(long_svo_multi$trans,list(long_svo_multi$wave_cat),FUN=mean,na.rm =T)


Input: create variable with only NA values [CODESPLIT] long_svo_multi$vlengths = rep(NA, times = 2970)


Input: calculate vector length per row [CODESPLIT] for (i in 1:2970) {long_svo_multi$vlengths[i]=calculate_vlength(mean_self[i], mean_other[i])}


Input: criterion to select applicable cases select only rows with transitive and good vector length response profiles as well as respondents with NA values this criterion used to select applicable cases for data analyses and figures [CODESPLIT] data_criterion <- (long_svo_multi$trans == "TRUE" & long_svo_multi$trans_vlenght == "TRUE" | is.na(long_svo_multi$trans) | is.na(long_svo_multi$trans_vlenght))


Input: KolmogorovSmirnov ksamples test for SVO angles [CODESPLIT] ks.test(dropouts$SVO_angle, stayers$SVO_angle) ks.test(dropouts$SVO_angle, stayers$SVO_angle) ks.test(dropouts$SVO_angle, stayers$SVO_angle) ks.test(dropouts$SVO_angle, stayers$SVO_angle) ks.test(dropouts$SVO_angle, stayers$SVO_angle)


Input: Fishersexact test for SVO types [CODESPLIT] fisher.test(table(dropouts$SVO_dicho_num),table( stayers$SVO_dicho_num)) fisher.test(table(dropouts$SVO_dicho_num),table( stayers$SVO_dicho_num)) fisher.test(table(dropouts$SVO_dicho_num),table( stayers$SVO_dicho_num)) fisher.test(table(dropouts$SVO_dicho_num),table( stayers$SVO_dicho_num)) fisher.test(table(dropouts$SVO_dicho_num),table( stayers$SVO_dicho_num))


Input: lagged variables of distance to 45 boundary in SVO [CODESPLIT] long_svo_multi$distance_45<-round(abs(45 - long_svo_multi$prior_SVO),digits = 2)


Input: alter a variable to label dropouts as 1 and stayers as 0 for ML analysis and this variable as dependent variable [CODESPLIT] data_adjusted$stay_dropout <- data_adjusted$change_cat data_adjusted$stay_dropout <- ifelse(data_adjusted$stay_dropout == 1,0, ifelse(data_adjusted$stay_dropout == 0,0,1)) data_adjusted$stay_dropout <- replace_na(data_adjusted$stay_dropout,value = 1) data_adjusted_1 <- data_adjusted %>% filter(trans == "TRUE" & trans_vlenght == "TRUE" | is.na(trans) | is.na(trans_vlenght))


Input: grid arrange to create figure with distribution of angles and SVO categories [CODESPLIT] get_legend<-function(myggplot){ tmp <- ggplot_gtable(ggplot_build(myggplot)) leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box") legend <- tmp$grobs[[leg]] return(legend)} bp <- theme(legend.position="none")


Input: Assessing minor longitudinal differences in SVO angles select applicable cases and variables [CODESPLIT] adjust <-dplyr::select(long_svo_multi,id,SVO_angle,wave_cat,trans,trans_vlenght) data_input <- na.omit(adjust) data_input$SVO_angle <- round(data_input$SVO_angle, digits = 2) data_input <- data_input %>% filter(trans == "TRUE" & trans_vlenght == "TRUE") data_wide_2 <- dcast(data_input, id ~ wave_cat, value.var="SVO_angle") data_wide_2 <- na.omit(data_wide_2)


Input: cumulative change of difference in SVO angles wave per wave [CODESPLIT] data_wide_6$change_wave_1 <- data_wide_6$diff_w1 data_wide_6$change_wave_1_2 <- data_wide_6$diff_w1_w2 data_wide_6$change_wave_1_2_3 <- data_wide_6$change_wave_1_2 + data_wide_6$diff_w2_w3 data_wide_6$change_wave_1_2_3_4 <- data_wide_6$change_wave_1_2_3 + data_wide_6$diff_w3_w4 data_wide_6$change_wave_1_2_3_4_5 <- data_wide_6$change_wave_1_2_3_4 + data_wide_6$diff_w4_w5 data_wide_6$change_wave_1_2_3_4_5_6 <- data_wide_6$change_wave_1_2_3_4_5 + data_wide_6$diff_w5_w6 data_wide_7 <- data_wide_6[, c(1,8:13)] long_SVO_4 <- melt(data = data_wide_7, id.vars = c("id"), variable.name = "wave_compare", value.name = "cumulative_change_in_SVO")


Input: Set up ERGM formula and constraints [CODESPLIT] if (substr(thresh, 1, 4) == 'prop') { ergm_formula <- y ~ gwesp(0.75, fixed=TRUE) + gwnsp(0.75, fixed=TRUE) constraints <- ~edges } else { ergm_formula <- y ~ edges + gwesp(0.75, fixed=TRUE) + gwnsp(0.75, fixed=TRUE) constraints <- ~. } ergm_fit <- ergm(ergm_formula, constraints = constraints) f <- paste0("Output/Singles/", thresh, "/ergmFit_", sprintf("%03d",i), ".RDS") dir.create(dirname(f), showWarnings = FALSE, recursive = TRUE) saveRDS(bergm_fit, f)


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


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


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


Input: plot a correlation matrix with all the different measures Create a dataframe with all the different measures of above [CODESPLIT] df_corM <- data.frame(df_postQ$FW, df_postQ$DU, df_postQ$arousal, df_postQ$valence, df_postQ$control, df_postQ$responsibility, df_diff$Diff) colnames(df_corM) <- c('FW', 'DU', 'arousal', 'valence', 'control', 'responsibility', 'Diff')


Input: calculate posterior draws for regression lines [CODESPLIT] experiment_dat_virus <- dat[dat$material == material, ] print(experiment_dat_virus) experiment_dat_virus <- experiment_dat_virus %>% summarise(detection_limit = 10^first(detection_limit_log10_titer)) print(experiment_dat_virus) mat_dat <- dat[dat$material == material, ] if(material != "Aerosols") { scaling <- 1 ylab_expression <- expression("titer (TCID"[50] * "/mL media)") max_x <- mat_dat %>% group_by(trial_unique_id, replicate) %>% filter(log10_titer == detection_limit_log10_titer) %>% select(time, trial_unique_id, replicate) %>% summarise(min_time = min(time)) %>% ungroup() %>% select(min_time) %>% max() } else { scaling <- 10 / 3 ## convert to tcid50/L air ylab_expression <- expression("titer (TCID"[50] * "/L air)") max_x <- max(mat_dat$time) } print(max_x) plot_times <- dat %>% data_grid(time = seq_range(c(0, max_x), n = fineness)) print(material)


Input: draw n_lines random regression lines [CODESPLIT] func_samples <- tidy_draws %>% group_by(trial_unique_id, replicate) %>% sample_n(n_lines) %>% ungroup() print(func_samples)


Input: cross product decay_rates with x (time) values and calculate y (titer) values [CODESPLIT] to_plot <- func_samples %>% crossing(plot_times) to_plot <- to_plot %>% mutate(predicted_titer = scaling * 10^(intercept - decay_rate * time)) dat <- dat[dat$material == material, ] max_titer <- scaling * max(dat$titer)


Input: this function accepts a column containing hitnames, a target hitname to look for, and a ... starting and ending fixation index [CODESPLIT] is_hitname_in_range <- function(vec, hitname, fi_start, fi_end) { if (!"fi_pairs" %in% ls(envir = .GlobalEnv)) { fi_pairs <- get_fixationindex_pairs(df$FixationIndex)


Input: 0 get sensing/location data for the specific user [CODESPLIT] sensing = dplyr::tbl(phonestudy, "ps_activity") %>% dplyr::filter(user_id %in% user) %>% dplyr::filter(!activityName %in% c("PHONESTUDY", "DNAPSOUND", "DNAPACCELEROMETER", "DNAPLIGHT", "DNAPPROXIMITY", "DNAPGYROSCOPE")) %>% dplyr::mutate(timestamp = as.character(timestamp), created_at = as.character(created_at), updated_at = as.character(updated_at)) %>% data.frame() sensing$user_id = as.character(sensing$user_id)


Input: Creates the variable 'distances', a 540 X 540 distance matrix between stimuli [CODESPLIT] coordinates = read.xlsx("540_coordinates.xlsx", colNames = TRUE) coordinates = as.matrix(unname(coordinates)) coordinates = coordinates[,2:9] distances = as.matrix(dist(coordinates))


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


Input: make a blank output table to hold the derive stats, and fill it up [CODESPLIT] out.tbl <- data.frame(array(NA, c(800, 5)));; # just make it big for now colnames(out.tbl) <- c("load.type", "cat.type", "trial.type", "stat.name", "stat.value");; ctr <- 1;;


Input: creating healthcare / containment variable [CODESPLIT] measures_new <- measures_new %>% mutate(measure_category = if_else(str_starts(measure,"H"), "Healthcare", "Containment"))


Input: Number of subject in Group 0 [CODESPLIT] N0.subject = 2*N0.dyad


Input: Exclude data from students who changed class or school during the school year. [CODESPLIT] quop2$exclusion[quop2$change>0] <- 1


Input: create date variable for birthday [CODESPLIT] quop2$s_birth_date <- as.Date(quop2$s_birth, format = "%d.%m.%Y")


Input: set gavariables to NA if they have negative times where there are negative times recorded in the gqcvariables, use the corresponding gavariable value instead (hoping it is not negative) (!: ga also contains instruction pages) first and last item (one per page) between the instruction pages [CODESPLIT] js_start = c(2, 23, 37) js_end = c(21, 35, 49) for(i in 1:8){ for(j in 1:length(js_start)){ for(k in js_start[j]:js_end[j]){ eval(parse(text=paste0("quop_use$t",i,"_gqc",k-j,"<- ifelse(quop_use$t",i,"_gqc",k-j,"<=0,quop_use$t",i,"_ga",k,", quop_use$t",i,"_gqc",k-j,")"))) } } }


Input: Creat file paths for the raw data and the csv files that you get at the end [CODESPLIT] file_path = 'data_fullstudy1.txt' file_path2 = 'behavioral.csv' file_path3 = 'questionnaires.csv' file_path4 = 'boxes.csv'


Input: Create loop for every participant, put the relevant data into the dataframe [CODESPLIT] con <- file(file_path, open = "r") on.exit(close(con)) lines <- readLines(con) subjects_data <- list() game_data <- list() boxes_data <- list() subj <- 0 for (line in lines) { if (grepl("Enter your Prolific ID", line, fixed = TRUE)) { subj = subj + 1 metadata_beginning <- fromJSON(str_replace(line, "\\}\\{", ",")) subj_data <- ""


Input: Recode NAs to 0 for response frequency tables [CODESPLIT] recodeNAto0 <- function(var) { case_when(is.na(var) ~ 0, T ~ var) }


Input: Compute response frequency table for recoded items [CODESPLIT] proptable <- function(var) { table(ds$country_name, var) %>% addmargins() %>% data.frame() %>% rename(country = 1, response = 2, prop = 3) %>% spread(response, prop) %>% mutate(`0` = `0`/Sum, `1` = `1`/Sum, `2` = `2`/Sum, `3` = `3`/Sum, `4` = `4`/Sum, `5` = `5`/Sum) }


Input: Make density ridge plot [CODESPLIT] ggplot(data = brmsmeans_antisci_cntr_post, aes(x = antisci_mean, y = fct_reorder(country_name, antisci_mean, .fun = mean), fill = factor(continent))) + stat_density_ridges(inherit.aes = T, calc_ecdf = F, quantile_lines = T, quantiles = 2, alpha = 0.7, scale = 3.5) + stat_summary(aes(label = paste0(sprintf("%0.2f", round(..x.., 2)), " [", sprintf("%0.2f", round(brmsmeans_hdi_l, 2)), ", ", sprintf("%0.2f", round(brmsmeans_hdi_h, 2)), "]")), geom = "text", size = 3, hjust = 0, color = "black", position = position_nudge(x = 6.7 - brmsmeans_means)) + scale_fill_viridis_d(name = "Continent", option = "inferno", begin = 0.1, end = 0.9, direction = -1) + coord_cartesian(xlim = c(3.7, 6.3), clip = "off") + ggtitle(label = "Posterior probability distributions of anti-science attitudes across countries", subtitle = "Annotations provide distribution means and 89% HDIs") + xlab("Anti-science attitudes") + ylab("") + theme_minimal() + theme(plot.margin = unit(c(1, 10, 1, 1), "lines"), legend.position = "bottom")


Input: extract the head and convert it to image [CODESPLIT] extract_pdf_top <- function(pdf_path) { page_img <- image_read_pdf(pdf_path, page = 1, density = 72) width <- image_info(page_img)$width height <- image_info(page_img)$height left <- 0 top <- 75 height <- height / 4 image_crop(page_img, geometry = sprintf("%fx%f+%f+%f", width, height, left, top)) } dontcare <- first_page_paths %>% map(extract_pdf_top) %>% map2(png_paths, image_write)


Input: Figures function to create data summaries in figures calculating means and cis for the plot [CODESPLIT] ci <- function(x) (sd(x)/sqrt(length(x))*qt(0.975,df=length(x)-1) ) #function to compute size of confidence intervals data_summary <- function(x) { m <- mean(x) ymin <- m-ci(x) ymax <- m+ci(x) return(c(y=m,ymin=ymin,ymax=ymax)) }


Input: median thickness of new snow [CODESPLIT] medianThicknessNewSnow <- sapply(avgSP$sets, function(set) { median(sapply(set, function(sp) { sum(sp$layers$thickness[findPWL(sp, pwl_gtype = c("PP", "DF"))]) })) }) lines(avgSP$meta$date, avgSP$meta$hs_median - medianThicknessNewSnow, lty = "dashed", lwd = 1) avgSP$avgs <- snowprofileSet(lapply(avgSP$avgs, function(avg) { avg$layers$percentage <- avg$layers$ppu_all avg })) plot(avgSP$avgs[avgSP$meta$date >= xdaterange[1] & avgSP$meta$date <= xdaterange[2]], ColParam = "percentage", add = TRUE, yaxis = FALSE, ylab = "") legend(as.Date("2018-09-23"), 190, c("<HS>", "<NEW>", "PP", "DF", "SH", "DH", "FC", "FCxr", "RG", "MF", "MFcr"), lty = c("solid", "dashed", rep(NA, 9)), lwd = 2, col = c(rep("black", 2), getColoursGrainType(c("PP", "DF", "SH", "DH", "FC", "FCxr", "RG", "MF", "MFcr"))), pch = c(NA, NA, rep(15, 9)), pt.cex = 2.5, density = c(rep(0, 11)), border = "transparent", horiz = FALSE, bty = "o", box.lwd = 0, cex = 1.4) dev.off()


Input: Means and SDs of TOTAL LT TO THE SCREEN in the outcome phase (Okumura) Table 2 in the main manuscript: for mean.overall.data (analogously to the boxplots) [CODESPLIT] mean.overall.data %>% group_by(Condition) %>% summarise(mean=mean(LTScreenOut), sd=sd(LTScreenOut), na.rm = TRUE) %>% as.data.frame(.) %>% dplyr::mutate_if(is.numeric, round, 3)


Input: checking disctribution of the dependent variable [CODESPLIT] hist(overall.data$LTScreenOut) hist(overall.data$LTObjectOut) hist(overall.data$FirstLookDurationObjectOut)


Input: reduced model revealed a convergence warning, with high SDs for TrialRun and Concontext (random effects). model with simpler random effect structure revealed similar estimates suggesting that the warning can be ignored [CODESPLIT] red6_2 <- glmer(FirstLookDurationObjectOut ~ ConContext + Identity_change + Location_change + z.TrialRun + z.TrialCon + ObjectPosAct + (1 + z.TrialCon + ObjectPosAct | ID) , data=overall.data, family=Gamma(link=log), control=contr) summary(red6_2) summary(red6)


Input: Test the difference between correlations of the same skills vs. different skills based on multiple imputation [CODESPLIT] names(Data_Table2a)[4]<-"Bad_news" m <- 'Persuasion ~~ v1*Persuasion + s1*Unreasonable + d1*Crisis + d2*Bad_news + d3*Presentation + d4*Mistake Unreasonable ~~ v2*Unreasonable + d5*Crisis + d6*Bad_news + d7*Presentation + d8*Mistake Crisis ~~ v3*Crisis + s2*Bad_news + d9*Presentation + d10*Mistake Bad_news ~~ v4*Bad_news + d11*Presentation + d12*Mistake Presentation ~~ v5*Presentation + s3*Mistake Mistake ~~ v6*Mistake


Input: compute boxplot characteristics [CODESPLIT] x <- boxplot(rep.int(yn, wn), plot = FALSE) top_vp <- viewport(layout = grid.layout(nrow = 2, ncol = 3, widths = unit(c(ylines, 1, 1), c("lines", "null", "lines")), heights = unit(c(1, 1), c("lines", "null"))), width = unit(1, "npc"), height = unit(1, "npc") - unit(2, "lines"), name = paste("node_boxplot", nid, sep = ""), gp = gp) pushViewport(top_vp) grid.rect(gp = gpar(fill = bg, col = 0)) top <- viewport(layout.pos.col = 2, layout.pos.row = 1) pushViewport(top) if (is.null(mainlab)) { mainlab <- if (id) { function(id, nobs) sprintf("[%s] nWKL = %s", # Node %s id, length(unique(VS_$wkl_uuid[fitted_node(obj$node, obj$data) == nid]))) # id, nobs


Input: Calculate to and from percentages [CODESPLIT] from_id <- unique(AbbyLinks$from) for (i in 1:length(from_id)) { AbbyLinks$perc_from[AbbyLinks$from == from_id[i]] <- AbbyLinks$n[AbbyLinks$from == from_id[i]]/sum(AbbyLinks$n[AbbyLinks$from == from_id[i]]) } to_id <- unique(AbbyLinks$to) for (i in 1:length(to_id)) { AbbyLinks$perc_to[AbbyLinks$to == to_id[i]] <- AbbyLinks$n[AbbyLinks$to == to_id[i]]/sum(AbbyLinks$n[AbbyLinks$to == to_id[i]]) } rm(i, from_id, to_id) head(AbbyLinks, 10)


Input: Generate Data Generate the outcome (y) and mediator (m) in the population with a correlation of b, variances of 1, and means of 0. [CODESPLIT] sigma <- rbind(c(1, b), c(b, 1)) mu <- c(0, 0) df <- as.data.frame(mvrnorm(n = n, mu = mu, Sigma = sigma)) names(df) <- c("y", "m")


Input: create a plot that illustrats: Accuracy, Kappa, AUROC and MCC [CODESPLIT] plot_3 <- methods_plot %>% filter(indices %in% c("Accuracy", "Kappa", "AUROC" , "MCC")) ggplot(plot_3,aes(x=variable,y=value,fill=reorder(indices,value))) + geom_bar(stat = "identity",position = "dodge",color="black") + xlab("") + ylab("in %") + ggtitle("") + scale_fill_brewer(palette = "Pastel1",name="") + theme_bw() + theme(legend.position="bottom") + theme(legend.title=element_blank()) + theme(plot.title = element_text(hjust = 0.5)) + scale_y_continuous(breaks = c(0,12.5,25,37.5,50,62.5,75,87.5,100),limits = c(0,95)) + theme(axis.text.x = element_text(angle=30, hjust = 1, vjust = 1, size = 12)) + theme(axis.text.y = element_text( size = 12)) + theme(axis.title.y = element_text( size = 12)) + theme(legend.title = element_text( size = 12 ))


Input: round all numeric variables x: data frame digits: number of digits to round [CODESPLIT] numeric_columns <- sapply(x, class) == 'numeric' x[numeric_columns] <- round(x[numeric_columns], digits) x }


Input: M, SD, range of key sociodemographic variables (across countries) [CODESPLIT] summstats(ds, age, country_name) %>% print(n = nrow(.)) summstats(ds, sex_rec, country_name) %>% print(n = nrow(.)) summstats(ds, edu_9cat, country_name) %>% print(n = nrow(.)) summstats(ds, income_10cat, country_name) %>% print(n = nrow(.))


Input: plot 95% credible intervals [CODESPLIT] x<-plot(me, plot = FALSE)[[1]] + scale_color_grey() + scale_fill_grey() x+ylim(0,1)+ theme(panel.grid.major = element_line(colour="gray"), panel.grid.minor = element_blank(), panel.background = element_blank(), axis.line = element_blank(),panel.grid.major.x = element_blank())+xlab("")+ylab("")


Input: Calculating Bayes Factors for effects [CODESPLIT] bayes_factor(xfit1,xfit2) bayes_factor(xfit1,xfit3)


Input: plot of abstractlevel rating averages Scatterplot with overlaid box [CODESPLIT] eval.plot <- ggplot(abstract.plot, aes(y=eval, x=target.f, color=target.f)) + geom_jitter(aes(colour=target.f)) + geom_boxplot(outlier.shape = NA, alpha=0.5) eval.plot <- eval.plot + theme_bw() + scale_colour_manual(values=c("#9E2E2E","royalblue4")) + scale_x_discrete( labels = c("Conservatives", "Liberals") ) + scale_y_continuous(limits = c(1, 7), expand = c(0,0)) + labs(y="Evaluative Rating", x="") + theme( text = element_text(size=16), panel.grid.major.x = element_blank(), legend.position = "none" ) explain.plot <- ggplot(abstract.plot, aes(y=explain, x=target.f, color=target.f)) + geom_jitter(aes(colour=target.f)) + geom_boxplot(outlier.shape = NA, alpha=0.5) explain.plot <- explain.plot + theme_bw() + scale_colour_manual(values=c("#9E2E2E","royalblue4")) + scale_x_discrete( labels = c("Conservatives", "Liberals") ) + scale_y_continuous(limits = c(1, 7), expand = c(0,0)) + labs(y="Explanatory Rating", x="") + theme( text = element_text(size=16), panel.grid.major.x = element_blank(), legend.position = "none" ) grid.arrange(eval.plot,explain.plot, nrow = 1)


Input: plot the raw data and the 95% HPDI from m.arithmetic [CODESPLIT] d.gg.math <- d.math.agg d.gg.math$mean <- NA d.gg.math$low_ci <- NA d.gg.math$high_ci <- NA


Input: Linear mixedeffects model for reproduction bias [CODESPLIT] mod_full <- lmer(Prct_Bias ~ ContextC*(GMSI_Gen_Z + GroupC*OrderC*Distort) + (ContextC | Subject), data=dat2) summary(mod_full) Anova(mod_full, type=3, test='Chisq') # Wald tests


Input: Simple slopes: Model for testing effect of Context at high GMSI [CODESPLIT] mod_1 <- lmer(Prct_Bias ~ ContextC*(GMSI_Gen_hi + GroupC*OrderC*Distort) + (ContextC | Subject), data=dat2) summary(mod_1) Anova(mod_1, type=3, test='Chisq')


Input: Add informaiton on species + condition to each row of dplot [CODESPLIT] gramXspec <- as.factor(c(rep("Bird AD", 3), rep("Bird NAD", 3))) grammar <- as.factor(c(rep("AD", 3), rep("NAD", 3))) species <- as.factor(c(rep("Bird", 6))) dplot $ Condition <- as.factor(grammar) ;; dplot$Species <- as.factor(species) ;; dplot $ gramXspec <- as.factor(gramXspec) dplot


Input: exclude App Spirituality features (are accidentally still created in the data set as empty variables) [CODESPLIT] sensing = sensing %>% dplyr::select(!matches("Spirituality"), -date)


Input: Porportion of trials missed within each block, for each subj [CODESPLIT] miss.blk <- with(data, tapply(trialError, list(subj, data$block), function(x) sum(x!="FALSE") / length(x)))


Input: plot fit model marginal_effects( FIT ) compute marginal means and average marginal effects [CODESPLIT] mu_happy = rowMeans(getCAT_fitted_mean(FIT , 'emotion' , 'happy' )) mu_angry = rowMeans(getCAT_fitted_mean(FIT , 'emotion' , 'angry' )) mu_neutral = rowMeans(getCAT_fitted_mean(FIT , 'emotion' , 'neutral' )) contrast_mu_angry_neutral = mu_angry-mu_neutral contrast_mu_happy_neutral = mu_happy-mu_neutral contrast_mu_angry_happy = mu_angry - mu_happy


Input: Add column for centered logtransformed time series [CODESPLIT] habsos.ts$ctr <- habsos.ts$log10_CELLS - mean(habsos.ts$log10_CELLS) head( habsos.ts )


Input: Custom functions 1. Data management 1.1 Build mean indices from multiple variables [CODESPLIT] mean_index <- function (df, name, vars) { M1 <- dplyr::select(df, vars) M2 <- rowMeans(M1, na.rm = TRUE) M2 <- tibble::tibble(M2) colnames(M2) <- name df <- dplyr::bind_cols(df, M2) return(df) }


Input: 2. Stats 2.1 Calculate standard error (se_func) [CODESPLIT] se_func <- function(var) { sd <- sd(var) n <- length(var) se <- sd / sqrt(n) return(se) }


Input: Calculate confidence interval (upper bound) [CODESPLIT] upper_ci_func <- function(var) { m <- mean(var) sd <- sd(var) n <- length(var) se <- sd / sqrt(n) lower_ci <- m + qt(1 - (0.05 / 2), n - 1) * se return(lower_ci) }


Input: 2.6 Bayes Factor paired ttest (func_ttest_paired_bf) [CODESPLIT] func_ttest_paired_bf <- function(pre = df_merge1_s3$paffect_pre, post = df_merge1_s3$paffect_post, dv = "paffect") {


Input: calculate pvalues from ttests [CODESPLIT] tee <- with(df, t.test(formula = dep_var ~ group_var, paired = FALSE, alternative = side)) return(tee) } tee <- with(df, t.test(x = var_pre, y = var_post, paired = TRUE, alternative = side)) } tee <- with(df, t.test(x = var_pre, y = var_post, paired = TRUE, alternative = side)) tee <- tee[["statistic"]][["t"]] effsize <- tee / sqrt(length(var_pre)) return(effsize) }


Input: impute missing values with the median of the respective variable [CODESPLIT] phonedata <- impute(phonedata, target = "Soci", classes = list(numeric = imputeMedian(), integer = imputeMedian()))$data


Input: Print percents of stuff (used for displaying study demographics) [CODESPLIT] print.percents <- function(x) { t <- as.data.frame(sort(table(as.character(x)), decreasing = T)) t$Percent <- round(t$Freq/sum(t$Freq)*100) colnames(t) <- c("", "n", "%") print(t) }


Input: Linear mixed effect model (RTs) 1000/RT as preregistered [CODESPLIT] LDTword_LME = lmer(-1000/RT ~ primec + (1|item) + (1+primec|subject), data = byTrial, contrasts = list(primec = cc1), control=lmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) summary(LDTword_LME)


Input: Exploratory: Linear mixed effect model (RTs) with AuthorTest_Finnish [CODESPLIT] LDTword_LME_ARF = lmer(-1000/RT ~ primec*AR_Finnish + (1|item) + (1|subject), data = byTrial, contrasts = list(primec = cc1), control=lmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) summary(LDTword_LME_ARF) plot(allEffects(LDTword_LME_ARF), x.var = "AR_Finnish")


Input: Linear mixed effect model (RTs) nonwords [CODESPLIT] LDTword_LMEnw = lmer(-1000/RT ~ primec + (1|item) + (1+primec|subject), data = byTrialnw, contrasts = list(primec = cc1), control=lmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) summary(LDTword_LMEnw)


Input: Linear mixed effect model (RTs) [CODESPLIT] Nword_LME = lmer(-1000/RT ~ primec + (1|item) + (1+primec|subject), data = nbyTrial, contrasts = list(primec = cc1), control=lmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) summary(Nword_LME)


Input: Linear mixed effect model (RTs) with ART_English [CODESPLIT] Nword_LME_AR = lmer(-1000/RT ~ primec*AR_English + (1|item) + (1+primec|subject), data = nbyTrial, contrasts = list(primec = cc1), control=lmerControl(optimizer="bobyqa", optCtrl=list(maxfun=2e5))) summary(Nword_LME_AR) plot(allEffects(Nword_LME_AR), x.var = "AR_English")


Input: exclude features with zero or nearzero variance [CODESPLIT] exclude_zero.var = nearZeroVar(data[, which(!colnames(data) %in% no.features)], freqCut = 95/5, uniqueCut = 10, saveMetrics = FALSE, allowParallel = TRUE) length(exclude_zero.var) exclude_zero.var = colnames(data[, which(!colnames(data) %in% no.features)])[exclude_zero.var] data = data %>% dplyr::select(-all_of(exclude_zero.var))


Input: Add the posterior_samples values as a column in the dataframe. Repeat it as many times as there are cell in the factorial design, namely 2. factor estimates [CODESPLIT] post.data$b_GramGender2 <- rep(posterior_samples(model.study2)[['b_GramGender2']], 2)


Input: create dataset with only correct trials and only trials above 100 ms [CODESPLIT] data.3SD <- data[data$corr == 1, ] data.3SD <- data.3SD[data.3SD$min2000 == 1, ] data.3SD <- data.3SD[data.3SD$plus100 == 1, ]


Input: Function for showing parameter estimats with pvalues for polr models [CODESPLIT] showCoefWithPValue <- function(model) { coef <- coef(summary(model)) pvalue <- pnorm(abs(coef[, "t value"]), lower.tail = FALSE) * 2 coef <- cbind(coef, "pvalue" = pvalue) return(round(coef, 4)) }


Input: Correlation between bulletin user type and avalanche awareness training [CODESPLIT] cor.test(as.numeric(PartBkgr$BullUseType), as.numeric(PartBkgr$BackgrAvTraining), method = "spearman")


Input: This additional analysis test the influence of trialbytrial blink duration on response error by computing individual Bayes factors the Bayes factor is calculated by examining the residuals of a null model and how they correlate with blinkdurations the procedure use a 'default' prior for calculating bayes factors for correlations code here: [CODESPLIT] source("BF_correlations.R") bf_null <- rep(NA, length(unique(d$Subject))) dur_slope <- rep(NA, length(unique(d$Subject))) for(i in 1:length(bf_null)){ d_i <- d[d$Subject==unique(d$Subject)[i] & d$cond1==1,] m0 <- lm(ResponseError~vel1, d_i) m1 <- lm(ResponseError~vel1 + cond1:bdur, d_i) dur_slope[i] <- coef(m1)[3] bf_null[i] <- 1/bf10JeffreysIntegrate(n=nrow(d_i), r=cor(residuals(m0), d_i$bdur)) }


Input: median and range of BF supporting the null [CODESPLIT] round(median(bf_null[bf_null > 10^(1/2)]),digits=2) round(range(bf_null[bf_null > 10^(1/2)]),digits=2)


Input: calculate number of days between symptoms [CODESPLIT] mutate( ill_where_n=ifelse(sym_temp==1, 1, 0), ill_where_n=cumsum(ill_where_n), ill_where_n=ifelse(sym_temp==1, ill_where_n, NA), prev_day_ill=lag(sym_temp, 1), day_lag=lag(day_date, 1),


Input: recode illness vars as NA if no specific symptoms during episode [CODESPLIT] mutate_at(vars(ill_where_id, ill_where_n, ill_where_start, ill_where_end, ill_where_new), funs(ifelse(any_specif_sym==FALSE, NA,. ))) %>%


Input: remove spaces, brackets, periods in column names [CODESPLIT] names(df) <- gsub("\\s+", "", names(df)) names(df) <- gsub("\\(|\\)", "", names(df)) names(df) <- gsub("\\.", "", names(df)) cat(" Ã°ÂÂÂ Column names fixed (no spaces, brackets, periods)\n")


Input: initialization of the vectors with the names of the modueles/variables [CODESPLIT] names.modules.df.w <- names.var.modules <- NULL


Input: list of the directories included in the datadir directory [CODESPLIT] my.dirlist <- list.dirs(path = datadir) if (length(my.dirlist) == 0) stop("There are no subdirectories in the directory that you selected.")


Input: creates a list with the names of the variables included for each module [CODESPLIT] names.var.modules <- vector("list", num.waves) names(names.var.modules) <- paste("Wave", waves) if(verbose) cat("Reading data from the selected modules within the waves. \n")


Input: check which of the specified variables are actually present in the downloaded data [CODESPLIT] which.var.ok <- variables.in.modules[[i.mod]] %in% names(new.data) if (any(!which.var.ok)) warning( "Some of the variables that you selected from module ", modules[i.mod], " in wave ", waves[i.wave], " are not included in the data set. \n The variables that could not be imported were: ", variables.in.modules[[i.mod]][!which.var.ok], ". Please check these variables, the other variables were exported. \n" ) new.data <- select(new.data, variables.in.modules[[i.mod]][which.var.ok]) } names(new.data)[-1] <- paste(names(new.data)[-1], modules[i.mod], sep = "...")


Input: Trim outliers Perform winsorizing (replacefor each individual seperatelyvalues below 5th percentile and values above 95th percentile with 5th and 95th percentile values respectively) [CODESPLIT] for(i in min(all.df$person):max(all.df$person)){ all.df$zw.HR[all.df$person == i] <- Winsorize(all.df$z.HR[all.df$person==i]) }


Input: Create a lag variable the data is lag within person and within days [CODESPLIT] lag.Y = function(data){ Y_lag = rep(0,nrow(data)) subjno.i = unique(data$subjno) for (i in subjno.i){ n.i = which(data$subjno==i) Y_lag[n.i] = shift(data$Y[n.i],1) } return(Y_lag) }


Input: Personality models Extract standardized parameters and N from personality models [CODESPLIT] Values_Analysis1_Model1_Pers <- Values_Personality[which(Values_Personality$analysis == "analysis1" & ((Values_Personality$study %in% c("S1", "S2") & Values_Personality$DV == "well_being") | (Values_Personality$study == "S3" & Values_Personality$DV == "affect_balance")) & Values_Personality$output %in% c("standardized", "N")), ] Values_Analysis1_Model2_Pers <- Values_Personality[which(Values_Personality$analysis == "analysis2" & ((Values_Personality$study %in% c("S1", "S2") & Values_Personality$DV == "well_being") | (Values_Personality$study == "S3" & Values_Personality$DV == "affect_balance")) & Values_Personality$output %in% c("standardized", "N")), ] Values_Analysis1_Model3_Pers <- Values_Personality[which(Values_Personality$analysis == "analysis3" & ((Values_Personality$study %in% c("S1", "S2") & Values_Personality$DV == "well_being") | (Values_Personality$study == "S3" & Values_Personality$DV == "affect_balance")) & Values_Personality$output %in% c("standardized", "N")), ]


Input: Extract withinperson variances of interactions with close peers, family, and weak ties from unstandardized models [CODESPLIT] variances <- Values_Base$est[which(Values_Base$analysis == "analysis3" & ((Values_Base$study %in% c("S1", "S2") & Values_Base$DV == "well_being") | (Values_Base$study == "S3" & Values_Base$DV == "affect_balance")) & Values_Base$output == "unstandardized" & Values_Base$paramHeader == "Variances" & Values_Base$param %in% c("PEERS", "FAMILY", "WEAK_TIES") & Values_Base$BetweenWithin == "Within")] rows <- which(Values_Analysis1_Model3$paramHeader %in% c("S1|WB.ON", "S2|WB.ON", "S3|WB.ON") & Values_Analysis1_Model3$param %in% c("PEERS", "FAMILY", "WEAK_TIES")) # within-person effects variances <- Values_Personality$est[which(Values_Personality$analysis == "analysis3" & ((Values_Personality$study %in% c("S1", "S2") & Values_Personality$DV == "well_being") | (Values_Personality$study == "S3" & Values_Personality$DV == "affect_balance")) & Values_Personality$output == "unstandardized" & Values_Personality$paramHeader == "Variances" & Values_Personality$param %in% c("PEERS", "FAMILY", "WEAK_TIES") & Values_Personality$BetweenWithin == "Within")] rows <- which(Values_Analysis1_Model3_Pers$paramHeader %in% c("S1|WB.ON", "S2|WB.ON", "S3|WB.ON") & Values_Analysis1_Model3_Pers$param %in% c("PEERS", "FAMILY", "WEAK_TIES")) # within-person effects


Input: Model selection for four data sets First find bestfitting random effect model, then test for fixed effect predictors Process is backward by elimintating weakest terms sequentially, starting with full model, until only significant effects remain Nested model comparisons (likelihood ratio tests using anova command) are used to select best fitting models _ Pair Experiment 1 Random effects: selecting empty model [CODESPLIT] pair1_rand_full <- lmer(distance ~ (1 | group) + (1 + session0 | pair), data = pair_data1) # full random model;; fails to converge pair1_rand_full <- lmer(distance ~ (1 | group) + (1 + session0 | pair), data = pair_data1, control = lmerControl(optimizer = "bobyqa")) # full random model;; uses bobyqa optimizer pair1_rand2 <- lmer(distance ~ (1 + session0 | pair), data = pair_data1) # drops group ran.intercept;; fails to converge pair1_rand2 <- lmer(distance ~ (1 + session0 | pair), data = pair_data1, control = lmerControl(optimizer = "bobyqa")) # drops group ran.intercept;; uses bobyqa optimizer;; BEST pair1_rand3 <- lmer(distance ~ (1 | pair), data = pair_data1) # drops random slope


Input: Pearson's correlation calculation [CODESPLIT] calc_r <- function(model_vector, data_vector, S_0, D_0, M_0, E_0, filename) { sst_mean <- mean(data_vector) sst_vector <- (data_vector - sst_mean) ^ 2 sst <- sum(sst_vector) ssr_vector <- (data_vector - model_vector) ^ 2 ssr <- sum(ssr_vector) r_sq <- 1 - (ssr / sst) cat(r_sq, file = paste(format(Sys.time(),"%Y_%m_%d_%H_%M"), filename, "r_sq", "S", S_0, "D", D_0, "M", M_0, "E", E_0, ".txt", sep = "_")) return(r_sq) } r_sq <- calc_r(CO2_flux_ratios_hat_median, data_vector, S_0, D_0, M_0, E_0, filename)


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


Input: age recode values of 99 as missing [CODESPLIT] data$indager.w2[data$indager.w2 == 99] <- NA data$age <- data$indager.w2


Input: Fit models with trimmed weights Weighted regression model for SciPop Score (Goertz approach) [CODESPLIT] m3.scipopgoertz.trim.svyglm.fit <- svyglm(scipopgoertz ~ age + gender + education.comp + education.uni + sciprox.score + urbanity.log + languageregion.ger + languageregion.ita + polorientation + religiosity + interestscience + sciliteracy + trustscience + trustscientists, design = bar.design.scipopgoertz.trim, family = gaussian, na.action = na.omit)


Input: for each row assign fixation probability (1 or 0) to each picture based on the activation !! need a better decision criteria when the activations are the same;; !! right now it assigns '1' to both [CODESPLIT] dt.act$max.act = apply(dt.act[,4:7], 1, max) dt.act = subset(dt.act, max.act != 0)


Input: 4.4.4) Create data where u(x) is at sample means to get residuals based on rest of models to act as yobs Recall: columns 1 & 2 have y and u(x) in obs.data [CODESPLIT] data.xufixed =data.obs data.xufixed[,2]=mean(data.obs[,2]) #Note, the 1st predictor, 2nd columns, is always the one hypothesized to be u-shaped


Input: 6 RUN TWO LINE REGRESSIONS 6.1 First an interrupted regression at the midpoint of the flat region [CODESPLIT] rmid=reg2(f,xc=median(xflat),graph=0, axislabels=axislabels)


Input: Pairwise comparison of optimism scores for each cue and table Wilcoxon signedrank test [CODESPLIT] cue_diff_wilcox_ts = wilcox.paired.multcomp( opt_score ~ cue | id, subset(jbt_all, jbt_all$cjb_test == "ts"), p.method = "holm") cue_diff_wilcox_tunnel = wilcox.paired.multcomp( opt_score ~ cue | id, subset(jbt_all, jbt_all$cjb_test == "tunnel"), p.method = "holm")


Input: round the numeric values (p that is not < 0.001) [CODESPLIT] cue_diff_wilcox_ts$p.value[numeric_values] <- round(as.numeric(cue_diff_wilcox_ts$p.value[numeric_values]), 3) names(cue_diff_wilcox_ts) <- c("Cues compared","p-value")


Input: new tibble with IDs and emails [CODESPLIT] wos_emails <- tibble( "responseID" = wos$response_ID, "email" = wos$email ) aaas_emails <- tibble( "responseID" = aaas$response_ID, "email" = aaas$email )


Input: drop rows with empty email fields [CODESPLIT] wos_emails <- drop_na( wos_emails, email ) aaas_emails <- drop_na( aaas_emails, email )


Input: getmode() Get mode of a variable Input: numeric vector Output: single number [CODESPLIT] getmode <- function(v) { uniqv <- unique(v) uniqv[which.max(tabulate(match(v, uniqv)))] }


Input: For studyProgramme remove countries with only one programme [CODESPLIT] if(varname == "studyProgram" & length(lev) == 1){ return(NA) }


Input: Model for Frequency DV [CODESPLIT] mod1.1 <- lmer(frequency ~ ruleType + (1|sceneType) + (1|Participant), contrasts = my.contrasts, data = PD3a.Long) icc(mod1.1) summary(mod1.1) emmeans(mod1.1,list(pairwise~ruleType),adjust="satterthwaite") confint(mod1.1)


Input: Define functions Means, SDs, and two sample ttests comparing Swiss census data and the panel sample [CODESPLIT] census.msd <- function(v) { v <- reformulate(v) cbind( as.data.frame(svyby(v, ~t, dslong_dsgn, svymean, na.rm = T))[-c(1,3)], # M (exclude SE) sqrt(as.data.frame(svyby(v, ~t, dslong_dsgn, svyvar, na.rm = T)[[2]]))) %>% # SD (with a workaround) set_colnames(c("M", "SD")) %>% set_rownames(c("2019 (census)", "2019 (panel)")) }


Input: RQ1: Examine predictors of change in SciPop Scores and subscale scores .. Visual inspection with Sankey plot Visualize withinsubject change in SciPop Score in Sankey plot [CODESPLIT] dslongpnl %>% group_by(t, scipopgoertz) %>% summarise(scipopgoertz_freq = n()) %>% merge(dslongpnl, by = c("scipopgoertz", "t")) %>% transform(scipopgoertz_lvls = factor(scipopgoertz, levels = c("5", "4.5", "4", "3.5", "3", "2.5", "2", "1.5", "1", "NA"))) %>% replace_na(list(scipopgoertz_lvls = "NA")) %>% ggplot(aes(x = t, stratum = scipopgoertz_lvls, alluvium = id, y = scipopgoertz_freq, fill = scipopgoertz_lvls, label = scipopgoertz_lvls)) + scale_x_discrete(expand = c(.1, .1)) + scale_fill_viridis_d() + geom_flow(width = .1) + geom_stratum(alpha = .5, width = .1) + geom_text(stat = "stratum", size = 4) + ggtitle("Sankey plot of within-subject change in SciPop Score") + theme_minimal() + theme(legend.position = "none", panel.grid = element_blank(), axis.text.y = element_blank(), axis.ticks.y = element_blank())


Input: H1 analyses .. Descriptive analyses Plot means, SDs, skewness, kurtosis of alternative SciPop Scores [CODESPLIT] meantbl <- as.data.frame(matrix(0, nrow = 2)) groups <- quos(scipopgoertz, scipopbollenm, scipopbollencfa, scipopsartori75, scipopsartoricat) for (j in seq_along(groups)) { meantbl <- cbind(meantbl, group_by(dslongpnl, t) %>% summarise(mean = mean(!!groups[[j]], na.rm = T), sd = sd(!!groups[[j]], na.rm = T), skewness = skewness(!!groups[[j]], na.rm = T), kurtosis = kurtosis(!!groups[[j]], na.rm = T))) names(meantbl)[names(meantbl) == "mean"] <- paste0(quo_text(groups[[j]]), " (M)") names(meantbl)[names(meantbl) == "sd"] <- paste0(quo_text(groups[[j]]), " (SD)") names(meantbl)[names(meantbl) == "skewness"] <- paste0(quo_text(groups[[j]]), " (Skewness)") names(meantbl)[names(meantbl) == "kurtosis"] <- paste0(quo_text(groups[[j]]), " (Kurtosis)") meantbl <- select(meantbl, contains("scipop")) %>% set_rownames(c("2019", "2020")) }


Input: save means and compute their higher order terms [CODESPLIT] dfs$x.mean <- mean( dfs$x, na.rm = TRUE ) dfs$y.mean <- mean( dfs$y, na.rm = TRUE ) dfs$x2.mean <- dfs$x.mean^2 dfs$xy.mean <- dfs$x.mean*dfs$y.mean dfs$y2.mean <- dfs$y.mean^2 dfs }


Input: add column indicating if individual gave birth during testing (this will help with age classification) [CODESPLIT] birthsanc <- read_excel("motherssanctuary.xlsx", col_types=c("text", "date")) bigdatasanctuary$Individual<-as.factor(bigdatasanctuary$Individual) birthsanc$Mother <- as.factor(birthsanc$Mother) bigdatasanctuary$mother <- ifelse(bigdatasanctuary$Individual %in% birthsanc$Mother, "yes", "no") bigdatasanctuary$birth <- birthsanc$Date[match(bigdatasanctuary$Individual, birthsanc$Mother)] bigdatasanctuary$birth <- as.Date(bigdatasanctuary$birth, format="YY-mm-dd") bigdatasanctuary$testbeforebirth <- ifelse(!is.na(bigdatasanctuary$birth) & bigdatasanctuary$birth > bigdatasanctuary$TestDate, "yes", "no") bigdatasanctuary$AgeAtTesting <- as.numeric(bigdatasanctuary$AgeAtTesting)


Input: Step 1 compare the rising ridge asymmetric congruence model (RRCA) and the full thirdorder model (cubic) [CODESPLIT] rrca_comp <- compare2(rrca_myrsa, "RRCA", "cubic") rrca_comp


Input: How much variance in the outcome can be explained by the full thirdorder polynomial model/the rising ridge leveldependent congruence model? [CODESPLIT] getPar(rrcl_myrsa, model="cubic", type="R2") getPar(rrcl_myrsa, model="RRCL", type="R2")


Input: get subsequent fixation index (+1) and retrieve row number using fi_pars and assign [CODESPLIT] scope_start[i] <- fi_pairs$fistart[scope_start_fis[i] + 1] } return(scope_start) }


Input: Exclude participants who completed less than 10 surveys [CODESPLIT] dat <- dat[-which(dat$N < 10), ] dim(dat) # 36074 assessments length(unique(dat$id)) # 1177 participants (1109 participants excluded)


Input: define function to compute colors and point sizes that yield 3d effect [CODESPLIT] points3d <- function(data, xname, yname, zname, cex.limit.close = 1.7, cex.limit.far = 1, col.limit.close = 0.1, col.limit.far = 0.8, adapted_eye = list(x=-12, y=-16, z=2) ){


Input: for each row of the data, compute euclidean distance between the person's 3dim point and the plane [CODESPLIT] distance <- abs( (data[,xname] - a$x) * n$x + (data[,yname] - a$y) * n$y + (data[,zname] - a$z) * n$z ) / sqrt(n$x^2 + n$y^2 + n$z^2)


Input: Calculate delta change in testosterone pivot data sets for delta values [CODESPLIT] hormones_wide <-hormones %>% pivot_wider(id_cols = c("id", "sex"), names_from = condition, values_from = t_conc_corr) %>% mutate(delta_t = back_home - baseline) delta_t <- left_join(hormones, hormones_wide) delta_t <- delta_t %>% filter(condition == "baseline")%>% filter(!is.na(delta_t))


Input: Plot sex and time point Boxplot for sex differences [CODESPLIT] t_condition <- hormones %>% ggplot(aes(x = condition, y = log(t_conc_corr), fill = sex)) + geom_boxplot(outlier.shape = NA, width = 0.7) +


Input: Network Estimation Ising Model (Binary Data) can be estimated via estimateNetwork variables automatically binarized at median estimate regularized logistic nodewise regression network define where to binarize variables eLASSO (LASSO with EBIC model selection) listwise deletion of missing values (pairwise not possible for regressions) [CODESPLIT] Ising_net <- estimateNetwork(data, default = "IsingFit", missing = "listwise", rule = "OR")


Input: compare GGM and Ising model correlating weights matrices [CODESPLIT] cor.test(Wmat_GGM[upper.tri(Wmat_GGM)], Wmat_Ising[upper.tri(Wmat_Ising)]) #.80


Input: create a storage container (i.e. a empty lists) for all hit_names ... ... that track looking times over all trials (e.g., looking_times$left) [CODESPLIT] looking_times <- setNames(vector("list", length(hit_names)), hit_names)


Input: create a storage container for all looking frequencies (i.e., counting the number of looks within an AOI) [CODESPLIT] looking_frequencies <- setNames(vector("list", length(hit_names)), hit_names)


Input: init storage containers for looking frequencies [CODESPLIT] current_trial_total_looks <- setNames(vector("list", length(hit_names)), hit_names) for (hn in hit_names) {


Input: get first and last FixationIndex (remove NAs), which define the boundaries of a single trial [CODESPLIT] min_FixationIndex <- min(inter_trial_FixationIndexes, na.rm = TRUE) max_FixationIndex <- max(inter_trial_FixationIndexes, na.rm = TRUE)


Input: space between axis label and tick mark labels [CODESPLIT] my_settings$layout.widths$ylab.axis.padding <- 0.2 my_settings$layout.heights$axis.xlab.padding <- 0.2 my_settings$box.rectangle$col = 1 my_settings$box.umbrella$col = 1 my_settings$box.dot$col = 1 my_settings$plot.symbol$col = 1


Input: Overlay the basic grid with colourful grid corresponding to the limits of sensitive period rectangles. These colourful lines should start in the points indicating the change values. [CODESPLIT] cols<-colscale[sapply(result$p1,function(x){which.min(abs(x-scaleseq))})] cols<-colscale[sapply(result$p1.rand[,exrun],function(x){which.min(abs(x-scaleseq))})]


Input: Skew effect [CODESPLIT] neg <- apply(chains[,c(1,3)], 1, sum) pos <- apply(chains[,c(1,2)], 1, sum) quantile(neg-pos, prob=c(.025, .975)) neg <- apply(chains[,c(1,3)], 1, sum) pos <- apply(chains[,c(1,2)], 1, sum) quantile(pos-neg, prob=c(.025, .975))


Input: Fit hierarchical Bayesian model [CODESPLIT] fit.HBM <- stan(file='CAM_full_1.stan', data=c('Nobs','Nind','stim','bias','RM','AS','B1','id','mid','stim_sizes','Nstim'), chains=4, iter=2500, cores=no_cores, control=list(adapt_delta=.90, max_treedepth=15)) fit.HBM sum(summary(fit.HBM)$summary[,'Rhat'] > 1.01) pars <- extract(fit.HBM)


Input: Compute probabilities using MNL model [CODESPLIT] P[['choice']] = apollo_mnl(mnl_settings1, functionality) P[["indic_cost_tap"]] = apollo_mnl(mnl_settings2, functionality) P[["indic_na1"]] = apollo_mnl(mnl_settings3, functionality) P[["indic_na2"]] = apollo_mnl(mnl_settings4, functionality) P[["indic_na3"]] = apollo_mnl(mnl_settings5, functionality) P[["indic_cost_bottle"]] = apollo_ol(ol_settings5, functionality) P[["indic_bill"]]= apollo_normalDensity(normalDensity_settings1,functionality) P[["indic_qual"]] = apollo_ol(ol_settingsB1, functionality) P[["indic_qual_f"]] = apollo_ol(ol_settingsB3, functionality) P = apollo_combineModels(P, apollo_inputs, functionality)


Input: d) Ftest (Stephan Gries 2013, p. 218) [only for normally distributed variables!] use var.test() Output interpretation: 1) Is p > .05?;; 2) Does the CI include 1? [CODESPLIT] F.lextale <- var.test(pp.explicit.incidental$lextale~pp.explicit.incidental$learningtype);; F.lextale


Input: c) Wilcoxon ranksum test ( MannWhitney U test) [Nonparametric alternative if normality is violated, or if you have ordinal data] Continuous variables: ratioscaled lextale [CODESPLIT] wilcox.lextale <- wilcox.test(lextale~learningtype, data=pp.explicit.incidental, paired=FALSE);; wilcox.lextale


Input: Selfrated variables: ordinal proficiency_overall [CODESPLIT] wilcox.proficiency_overall <- wilcox.test(proficiency_overall~learningtype, data=pp.explicit.incidental, paired=FALSE);; wilcox.proficiency_overall


Input: Effect size (approximate) for Wilcoxon ranksum test Write the function (from Field, Miles & Fiels 2012, p.665) [CODESPLIT] rWilcox <- function(wilcoxModel, N){ z <- qnorm(wilcoxModel$p.value/2) r <- z/sqrt(N) cat(wilcoxModel$data.name, "Effect size, r = ", r) }


Input: create new variable for the IRV intraindividual response variability [CODESPLIT] data$irv <- irv( dplyr::select( data, belonging, control, meaningful_existence, self_esteem ), na.rm = TRUE, split = FALSE)


Input: display the correlations as a histogram and heatmap [CODESPLIT] cor_matrix_half <- cor_matrix[upper.tri(cor_matrix)] mean(cor_matrix_half) sd(cor_matrix_half) hist(as.vector(cor_matrix_half), breaks=24, cex.axis=2) # Note: Novich et al. suppressed correlations of r<.4 in their visualisation heatmap(x = cor_matrix, symm = TRUE)


Input: Create stringent dataset Exclude People with Strange Response Patterns These are identified as subclusters in the inclusive dendogram that group together [CODESPLIT] inclusive_data$weird_responses = inclusive_data$body_postures_shape + inclusive_data$punctuation_shape + inclusive_data$letter_shape + inclusive_data$number_shape + inclusive_data$people_name_shape + inclusive_data$english_word_shape + inclusive_data$foreign_word_shape + inclusive_data$tastes_taste + inclusive_data$smells_smell + inclusive_data$noises_noise + inclusive_data$music_music + inclusive_data$colour_colour + inclusive_data$shapes_shape + inclusive_data$smells_taste + inclusive_data$tastes_smell + inclusive_data$voices_noise + inclusive_data$voices_music + inclusive_data$noises_music + inclusive_data$music_noise hist(inclusive_data$weird_responses) table(inclusive_data$weird_responses)


Input: gives the prevalence of each cluster of data [CODESPLIT] colMeans(short_data) N_types <- matrix(apply(short_data[,1:i], 1, sum, na.rm=TRUE)) stringent_N_clusters <- cbind(stringent_N_clusters,N_types) }


Input: create a continuoius time metric (seconds since midnight of day0) [CODESPLIT] dat$sec_midnight.day0 <- dat$start.secmidnight + dat$day * 86400


Input: create a variable indicating, if the current observation is the first observation of the day ("morning") this variable is 1, if the current observation was obtained on a different day than the previous observation [CODESPLIT] dat[!is.na(dat$lagday) & dat$day!=dat$lagday, "morning"] <- 1 dat[!is.na(dat$lagday) & dat$day==dat$lagday, "morning"] <- 0


Input: create continuous time variable in hours and seconds [CODESPLIT] data$time_to_hours = lubridate::hour(data$timestamp.corrected) + lubridate::minute(data$timestamp.corrected)/60 + lubridate::second(data$timestamp.corrected)/3600 data$time_to_sec = data$time_to_hours*60*60 return(data) }


Input: set font size for facet labels [CODESPLIT] strip.text.x = element_text(size = font_size_facets_x), strip.text.y = element_text(size = font_size_facets_y), strip.text.x = element_text(size = font_size_facets_x), strip.text.y = element_text(size = font_size_facets_y),