drndr/statcodesearch huggingface dataset:
File: P1_motif-by-motif_newbins.R

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

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

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

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

Comment: In renamed "gender" variable replace "son" with "Male" etc. 
Category: Data Variable
Code:
StataGDIM$gender <- gsub('son', 'Male', StataGDIM$gender) StataGDIM$gender <- gsub('daughter', 'Female', StataGDIM$gender) StataGDIM$gender <- gsub('all', 'Mixed', StataGDIM$gender)

Comment: Create cohort (decade of birth) variable in ACE data
Category: Data Variable
Code:
StataACE <- StataACE %>% mutate(cohort = as.integer(dob_midrange/10)*10)

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

Comment: Inverse variance weightings for variance of h2, c2 and e2 
Category: Statistical Modeling
Code:
ETmerged<-ETmerged %>% mutate (h2weight = 1/h2var) ETmerged<-ETmerged %>% mutate (c2weight = 1/c2var) ETmerged<-ETmerged %>% mutate (e2weight = 1/e2var)

Comment: Manually derive pvalues from tvalues for Alt_Norway (for a twosided ttest):
Category: Statistical Test
Code:
2*pt(abs(-1.0320512), df=14,lower.tail=FALSE) 2*pt(abs(2.48367345), df=14,lower.tail=FALSE) 2*pt(abs(-2.828329), df=14,lower.tail=FALSE) 2*pt(abs(1.2811099), df=14,lower.tail=FALSE) 2*pt(abs(3.4124371), df=14,lower.tail=FALSE) 2*pt(abs(0.6433726), df=14,lower.tail=FALSE) 2*pt(abs(-1.0321), df=14,lower.tail=FALSE) 2*pt(abs(2.4837), df=14,lower.tail=FALSE) 2*pt(abs(-2.8283), df=14,lower.tail=FALSE)
File: Study3B_analyses.R

Comment: correlations separately for each partner partner 1
Category: Data Variable
Code:
chart.Correlation(data_dyadic[ , c("pes_1","p_self_1","d_self_1","p_other_1","d_other_1")], use = "pairwise.complete.obs", pch = 20, histogram = TRUE)
File: subject19.R

Comment:  Remove" AoI > 1200 or < 50 ms  
Category: Data Variable
Code:
prevalues_gaze <- sum(PAST_O_19$gazedur > 0, na.rm=T)+sum(PAST_M_19$gazedur > 0, na.rm=T)+ sum(PRES_M_19$gazedur > 0, na.rm=T)+sum(PRES_O_19$gazedur > 0, na.rm=T) prevalues_fix <- sum(PAST_O_19$fixdur > 0, na.rm=T)+sum(PAST_M_19$fixdur > 0, na.rm=T)+ sum(PRES_M_19$fixdur > 0, na.rm=T)+sum(PRES_O_19$fixdur > 0, na.rm=T) PAST_M_19$gazedur[PAST_M_19$gazedur  > 1200 | PAST_M_19$gazedur < 50] <- NaN PAST_M_19$fixdur[PAST_M_19$fixdur > 1200 | PAST_M_19$fixdur < 50] <- NaN PRES_O_19$gazedur[PRES_O_19$gazedur > 1200 | PRES_O_19$gazedur < 50] <- NaN PRES_O_19$fixdur[PRES_O_19$fixdur > 1200 | PRES_O_19$fixdur < 50] <- NaN PRES_M_19$gazedur[PRES_M_19$gazedur > 1200 | PRES_M_19$gazedur < 50] <- NaN PRES_M_19$fixdur[PRES_M_19$fixdur > 1200 | PRES_M_19$fixdur < 50] <- NaN PAST_O_19$gazedur[PAST_O_19$gazedur > 1200 | PAST_O_19$gazedur < 50] <- NaN PAST_O_19$fixdur[PAST_O_19$fixdur > 1200 | PAST_O_19$fixdur < 50] <- NaN postvalues_gaze <- sum(PAST_O_19$gazedur > 0, na.rm=T)+sum(PAST_M_19$gazedur > 0, na.rm=T)+ sum(PRES_M_19$gazedur > 0, na.rm=T)+sum(PRES_O_19$gazedur > 0, na.rm=T) postvalues_fix <- sum(PAST_O_19$fixdur > 0, na.rm=T)+sum(PAST_M_19$fixdur > 0, na.rm=T)+ sum(PRES_M_19$fixdur > 0, na.rm=T)+sum(PRES_O_19$fixdur > 0, na.rm=T) dataloss_fix <- prevalues_fix-postvalues_fix dataloss_fix_percentage <- (1-(postvalues_fix/prevalues_fix))*100 dataloss_gaze <- prevalues_gaze-postvalues_gaze dataloss_gaze_percentage <- (1-(postvalues_gaze/prevalues_gaze))*100
File: syntax_SDMWS&SBPS.R

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

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

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

Comment: Network based on correlations
Category: Statistical Modeling
Code:
n1a<-estimateNetwork(DataAll, default= "cor") plot(n1a, groups = gr, legend.cex=.35)

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

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

Comment: Cohen's d First create the equivalent arrangement for the stimation of differences if the father is biologicla and present
Category: Statistical Test
Code:
muB<-rep(mean(diffb,na.rm=T),15) sdB<-rep(sd(diffb,na.rm=T),15) nB<-rep(length(diffb[!is.na(diffb)]),15)
File: draw.2.w.int.bw.1.cov.and.1.fac.r

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

Comment: remove rows where wkl_uuid is NA:
Category: Data Variable
Code:
VS <- VS[!is.na(VS$wkl_uuid), ]
File: Data.VAR.Fixed.R

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

Comment:  remove layers with gtype_class "MF" (only three distinct MF layers in data set!) 
Category: Data Variable
Code:
toDiscard <- which(CM$gtype_class == "MF") if (length(toDiscard) > 0) CM <- CM[-toDiscard, ]
File: 01_TreeBUGS_with_csv_files.R

Comment: Testing participant heterogeneity  chisquare test:
Category: Statistical Test
Code:
testHetChi(freq = "data/data_retrieval.csv", tree = c("E","E","E", "U","U","U", "N","N","N") ) testHetChi(freq = "data/data_encoding.csv", tree = c("E","E","E", "U","U","U", "N","N","N") )

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

Comment:   Withinsubject tests  Example: twohigh threshold model (2HTM, included in TreeBUGS) 
Category: Statistical Modeling
Code:
htm <- system.file("MPTmodels/2htm.eqn", package="TreeBUGS")
File: Graphs.R

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

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

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

Comment: save position of attribute j
Category: Data Variable
Code:
wide.data[[paste0("pos",att.names[k])]][row.id]=j

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

Comment: 1. recode RT for trials with slow (missed) response as NA
Category: Data Variable
Code:
data$rt[data$trialError == " Slow"] <- NA
File: 03_posterior_visualization_country_contrast.R

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

Comment: plot contrasts estimates
Category: Visualization
Code:
plot(NULL,ylim=c(max(dec$y)+const1+const2,min(dec$y)-const1),type="n",xaxs="i",yaxs="i",xaxt="n",yaxt="n",xlim=xlims[[block]],bty="n") abline(h=dec$y,col=col.grid,lty=1,lwd=lwd.grid) segments(axes[[block]],max(dec$y)+const1,axes[[block]],max(dec$y)+tic+const1,lwd=lwd.ax,col=col.ax) text(axes[[block]],max(dec$y)+tic+const1+ofs,labels=axes[[block]],col=col.ax,cex=0.9,font=2) lines(range(axes[[block]]),rep(max(dec$y)+const1,2),lwd=lwd.ax,col=col.ax) segments(axes[[block]],min(dec$y)-const1,axes[[block]],max(dec$y)+const1,lwd=lwd.v,col=col.ax,lty=3) segments(0,min(dec$y)-const1,0,max(dec$y)+const1,lwd=lwd.v,col=col.ax,lty=1)

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

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

Comment: correlations between variability and wellbeing measures:
Category: Statistical Modeling
Code:
names_var <- c("csd_mean_n","csd_mean_e","csd_mean_o","csd_mean_a","csd_mean_c", "sccs","csd_nob","simpson_csd","rses","swls","pa","na") psych::corr.test( df2[,names_var] )
File: tabulate_cases.R

Comment: catch situation where Sx is missing  so we cannot assess response to treatment
Category: Data Variable
Code:
if ( nrow( thisSx ) < 1 ) { thisRow$status.sx <- NA noFurtherFlag <- 1    ## tell rest of loop to not bother thisRow$missing.Sx <- 1 }
File: Analysis.R

Comment: Descriptive analysis: counting occurrence of bodybased  units and coded themes.   Step 1. Analyse frequencies of bodybased units of measure  Ensure data is in character format
Category: Data Variable
Code:
df$`Body dimension` <- as.character(df$`Body dimension`)
File: Analyses_Exploratory.R

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

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

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

Comment: Exclude participants who revealed 0 tiles
Category: Data Variable
Code:
d.conf_1_2.complete_no0 <- d.conf_1_2.complete[d.conf_1_2.complete$TilesRevealed > 0,] d.conf_3_math.complete_no0 <- d.conf_3_math.complete[d.conf_3_math.complete$TilesRevealed > 0,]

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

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

Comment: Bayes Factors  load additional libraries subset data into separate objects for frequentist analyses
Category: Data Variable
Code:
d.math.agg.f <- d.math.agg d.math.agg.f$Competition <- as.factor(d.math.agg.f$Competition) d.math.agg.f$ID_Player <- as.factor(d.math.agg.f$ID_Player) d.math.agg.f$Sex <- as.factor(d.math.agg.f$Sex) d.conf.agg.f <- d.conf.agg d.conf.agg.f$Competition <- as.factor(d.conf.agg.f$Competition) d.conf.agg.f$Effort <- as.factor(d.conf.agg.f$Effort) d.conf.agg.f$ID_Player <- as.factor(d.conf.agg.f$ID_Player) d.conf.agg.f$Sex <- as.factor(d.conf.agg.f$Sex)
File: 01_ML_bmr_resultsSummary.R

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

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