drndr/statcodesearch huggingface dataset:
File: 4_sem_models.R

Comment:  SEM Analysis Section   The following section sets up a series of path models. Note that this is a highly revised version of the SEM section, which  originally tried to incorporate a complex latent variable model to simultaneously test all hypotheses. I decided to break it down into  smaller, simpler models, and to focused on observedvariableonly models using the composite meausres instead. I'm not sure if that's  the "best" approach or not, but I think it at least makes for a simpler approach. The code below is thus a mixture of what I originally  wrote and the revised models.  Let's check differences between the two groups: 
Category: Statistical Modeling
Code:
t.test(Measures$Age~Measures$Normative) t.test(Measures$Adj_Income~Measures$Normative) t.test(Measures$Parent_Edu~Measures$Normative) t.test(Measures$Political~Measures$Normative) t.test(Measures$Crit_Reflection_Mean~Measures$Normative) t.test(Measures$Efficacy_Mean~Measures$Normative) t.test(Measures$Crit_Action_Mean~Measures$Normative) t.test(Measures$BLM_Activism~Measures$Normative) t.test(Measures$Militarism_Mean~Measures$Normative) t.test(Measures$EDNhComp~Measures$Normative) t.test(Measures$ACEs_Sum~Measures$Normative) t.test(Measures$MEQ_Total~Measures$Normative) t.test(Measures$Discrim_Major_Sum~Measures$Normative) t.test(Measures$Discrim_Everyday_Mean~Measures$Normative) t.test(Measures$BNSS_Mean~Measures$Normative) t.test(Measures$BNSSh_Mean~Measures$Normative) t.test(Measures$Zero_Sum_Mean~Measures$Normative) sjmisc::frq(Measures$Race, out = "v") Measures %>% group_by(Race) %>% summarise(BLM_Mean = mean(BLM_Activism)) data <- Measures %>% filter(Race %in% c("Black or African-American","White or Caucasian") & !is.na(BLM_Activism)) %>% mutate(Black = ifelse(Race == "Black or African-American", 1,0))

Comment:  To assess BLM Activism by race, keep in mind that the BLM measure is count data (with a lot of zeros)  A ttest therefore is not appropriate. We will use "zeroinflated Poisson regression" 
Category: Statistical Modeling
Code:
ggplot(Measures, aes(BLM_Activism)) + geom_histogram() model.zi = zeroinfl(BLM_Activism ~ Black, data = data, dist = "poisson") summary(model.zi) Descriptives3 <- Measures %>% select(Normative,Age,Adj_Income,Parent_Edu,Political,ACEs_Sum,EDNhComp,Discrim_Major_Sum,Discrim_Everyday_Mean,MEXQ_Exp, Crit_Reflection_Mean,Efficacy_Mean,Crit_Action_Mean,BLM_Activism, Militarism_Mean) %>% psych::describeBy(group="Normative") %>% as.data.frame() %>% rownames_to_column(var="Measure") %>% select(-vars) DescrNonNorm<- as.data.frame(Descriptives3[1]) %>% rownames_to_column(var="Measure") DescrNorm<- as.data.frame(Descriptives3[2]) %>% rownames_to_column(var="Measure")
File: 3-Cleancovariatesforgroupdesigns.R

Comment: Write cleaned covariate files to xlsx
Category: Data Variable
Code:
cleaned_group_covariates_data <- list( "cleaned_group_participant" = cleaned_group_participant_dat, "cleaned_group_instructional" = cleaned_group_instructional_dat, "cleaned_group_DV" = cleaned_group_DV_dat, "cleaned_group_race_ethnicity" = race_eth ) write_xlsx(cleaned_group_covariates_data, path = "Cleaned data/Group covariates data tables.xlsx")
File: 5chisquare_Spanish.R

Comment: chisquare to compare vegan in experienced vs. not experienced for each advocacy type graphic video
Category: Statistical Test
Code:
data %>% xtabs(~ graphic_exp_buc + vegn_bin, .) %>% print() %>% proportions("graphic_exp_buc") graphic_tmp <- chisq.test(xtabs(~ graphic_exp_buc + vegn_bin, data))
File: DMS-NRSA-CA-QC-Figures.R

Comment: Boosted Regression Trees                          CUS BRT plot
Category: Visualization
Code:
CUS.BRT.plot <- ggplot(data = CUS.BRT, aes(x = predictors, y = influence, fill = predictor.type)) + geom_bar(stat = "identity") + geom_hline(yintercept = 5, linetype = 3, size = 1, colour = "gray60") + scale_fill_manual(values = viridis.3) + coord_flip() + labs(x = "Predictor", y = "Relative Influence") + scale_y_continuous(breaks = c(0, 10, 20, 30, 40), limits = c(0, 40)) + scale_x_discrete(limits = BRT.plot.label.limits, labels = BRT.plot.labels) + theme_pubr() + theme(legend.position = c(0.85, 0.825), legend.title = element_blank())
File: U-PbGeochronologyScripts.R

Comment: Sets limits of the plot based on user choice
Category: Visualization
Code:
limits <- matrix(0,2,2) limits <- if (lim == 1){ limits <-u.plot.limit(min.age,max.age,lim,min.ylim,max.ylim) } else if (lim == 2){ limits <-u.plot.limit(min.age,max.age,lim,min.ylim,max.ylim) } else { limits <-u.plot.limit(min.xlim,max.xlim,lim,min.ylim,max.ylim) } limconc <-uconcplot(limits[1,1],limits[1,2],int) #sets the concordia line based on plot limts plot_limconc <- limconc[2:(nrow(limconc)-1),]

Comment: BELOW CALCULATES THE ELLIPSES               calculate x/y coords that define ellipse based in input data including rho
Category: Visualization
Code:
ell.coords=list() #sets up list to write results to for(n in 1:n){ covmat <-cor2cov2((Pb7Ue[n]/2),(Pb6Ue[n]/2),rho[n]) nn <- 75 cutoff <- stats::qchisq(1-0.05,2) e <- eigen(covmat) a <- sqrt(cutoff*abs(e$values[1])) # major axis b <- sqrt(cutoff*abs(e$values[2])) # minor axis v <- e$vectors[,1] beta <- atan(v[2]/v[1]) theta <- seq(0, 2 * pi, length=nn) out <- matrix(0,nrow=nn,ncol=3) out[,1] <- Pb7U[n] + a * cos(theta) * cos(beta) - b * sin(theta) * sin(beta) out[,2] <- Pb6U[n] + a * cos(theta) * sin(beta) + b * sin(theta) * cos(beta) out[,3] <- n
File: Fig05To08.R

Comment: Functions for plotting models Extracts significance from models for chart legend
Category: Visualization
Code:
extractSign <- function (model, modeltype, MtnRanges, InclMIA = TRUE) { coef <- summary(model)$coefficients$cond SignDF <- data.frame(mtnrng = MtnRanges, main = NA, int_ao = NA, int_po = NA) if (InclMIA) { if (modeltype == "int") { if (coef[row.names(coef) == "AO:MtnRange1", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Coast - North"] <- "I"} if (coef[row.names(coef) == "AO:MtnRange2", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Coast - South"] <- "I"} if (coef[row.names(coef) == "AO:MtnRange3", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Columbia - North"] <- "I"} if (coef[row.names(coef) == "AO:MtnRange4", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Columbia - South"] <- "I"} if (coef[row.names(coef) == "AO:MtnRange5", 4] < 0.05) {SignDF$int_ao[SignDF$mtnrng == "Rockies - North"] <- "I"} if (coef[row.names(coef) == "MtnRange1:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Coast - North"] <- "I"} if (coef[row.names(coef) == "MtnRange2:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Coast - South"] <- "I"} if (coef[row.names(coef) == "MtnRange3:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Columbia - North"] <- "I"} if (coef[row.names(coef) == "MtnRange4:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Columbia - South"] <- "I"} if (coef[row.names(coef) == "MtnRange5:PO", 4] < 0.05) {SignDF$int_po[SignDF$mtnrng == "Rockies - North"] <- "I"} } } SignAOMain <- paste("AO: ", format(round(coef[row.names(coef) == "AO", 1], 3), nsmall=3), " (", format(round(coef[row.names(coef) == "AO", 4], 3), nsmall=3),")") SignPOMain <- paste("PO: ", format(round(coef[row.names(coef) == "PO", 1], 3), nsmall=3), " (", format(round(coef[row.names(coef) == "PO", 4], 3), nsmall=3),")") return(list(SignAOMain = SignAOMain, SignPOMain = SignPOMain, SignDF = SignDF)) }
File: exp01_prep.R

Comment: outlier coding M and SD per subject and item depending on distractor condition and soa (independent variables)
Category: Data Variable
Code:
subj.M.SD = ddply(rawdat,.(subj,cond,soa), summarize, subj.M=mean(RT, na.rm=T), subj.SD=sd(RT, na.rm=T)) tar.M.SD = ddply(rawdat,.(targ_ID,cond,soa), summarize, tar.M=mean(RT, na.rm=T), tar.SD=sd(RT, na.rm=T)) rawdat = merge(rawdat, subj.M.SD, by=c("subj", "cond", "soa")) rawdat = merge(rawdat, tar.M.SD, by=c("targ_ID", "cond", "soa")) rawdat$subj.min = (rawdat$subj.M - 2*(rawdat$subj.SD)) rawdat$subj.max = (rawdat$subj.M + 2*(rawdat$subj.SD)) rawdat$tar.min = (rawdat$tar.M - 2*(rawdat$tar.SD)) rawdat$tar.max = (rawdat$tar.M + 2*(rawdat$tar.SD))
File: Fig.

Comment: calculate the value of the closest peer estimate and store in 'closest'
Category: Data Variable
Code:
closest<-min(abs(si-firstEstimate))

Comment: define Gaussians for updating  prior self (firstEstimate)
Category: Statistical Modeling
Code:
density_self <- log(dnorm(x, firstEstimate, own_sd ))
File: 04-revisions.R

Comment: 1.1. Sample 1  PTSD Symptoms (PSSI)   Run linear mixed effect model
Category: Statistical Modeling
Code:
a1_model_01_sg_pssi_outcome <- lme(pssi_end ~ pssi_s0 + sg, random = ~ 1 | id, method = "ML", na.action = na.omit, data = data_a1_pssi)

Comment: Check asssumption of normality of the residuals
Category: Statistical Modeling
Code:
qqnorm(resid(a1_model_01_sg_pssi_outcome)) qqnorm(resid(a2_model_01_sg_pssi_outcome))

Comment:  Calculate contrasts specified in in the contrast matrix "contrast_outcome" 
Category: Statistical Modeling
Code:
a1_model_01_sg_pssi_outcome_contrasts <- glht(a1_model_01_sg_pssi_outcome, contrast_outcome) a2_model_01_sg_pssi_outcome_contrasts <- glht(a2_model_01_sg_pssi_outcome, contrast_outcome)

Comment: Show contrasts without adjusting pvalues for multiple comparisons
Category: Statistical Test
Code:
summary(a1_model_01_sg_pssi_outcome_contrasts, test = adjusted("none")) summary(a2_model_01_sg_pssi_outcome_contrasts, test = adjusted("none"))

Comment:  Select estimates, standard error and pvalue 
Category: Data Variable
Code:
table_a1_model_01_sg_pssi_outcome_full <- table_a1_model_01_sg_pssi_outcome_raw %>% dplyr::select(beta = estimate, se = std.error, p = p.value) table_a2_model_01_sg_pssi_outcome_full <- table_a2_model_01_sg_pssi_outcome_raw %>% dplyr::select(beta = estimate, se = std.error, p = p.value)

Comment: Calculate pooled standard deviation at baseline
Category: Statistical Modeling
Code:
sd_a1_pssi_s0 <- sd(data_a1_pssi$pssi_s0, na.rm = TRUE) sd_a2_pssi_s0 <- sd(data_a2_pssi$pssi_s0, na.rm = TRUE)

Comment: Calculate Cohen's d using the absolute value of the baseline adjusted difference from the linear mixed effect model
Category: Statistical Test
Code:
cohens_d_a1_pssi_end <- a1_pssi_end_diff / sd_a1_pssi_s0 cohens_d_a2_pssi_end <- a2_pssi_end_diff / sd_a2_pssi_s0
File: Exp4_buddhist_post.R

Comment: Peer Rank Means and Standard Deviations of Conditions   Unspecified Peer Rank
Category: Data Variable
Code:
round(mean(unspecified$peer.rank), 2) round(sd(unspecified$peer.rank), 2)
File: helpers.r

Comment: determines and rounds (to digits as specified in digits) mean and sd of x, and then collapses them in a single entry 
Category: Data Variable
Code:
xx=as.character(round(c(mean(x, na.rm=T), sd(x, na.rm=T)), digits=digits)) if(any(grepl(x=xx, pattern=".", fixed=T))>0){ xx[!grepl(x=xx, pattern=".", fixed=T)]=paste(xx[!grepl(x=xx, pattern=".", fixed=T)], "0", sep=".") xx=matrix(unlist(strsplit(as.character(xx), split=".", fixed=T)), ncol=2, byrow=T) xx[, 2]=unlist(lapply(xx[, 2], function(x){ paste(c(x, paste(c(rep("0", times=digits-nchar(x))), collapse="")), collapse="") })) xx=apply(xx, 1, paste, collapse=".") } paste(xx, collapse=sep) } c.tab<-function(x, digits=NA, n.spaces=1, add.hash=T, incl.fst=F, incl.rownames=T){

Comment: wrapper for savePlot with file  "clipboard" and type  "wmf" (default;; others are possible) 
Category: Visualization
Code:
savePlot(file="clipboard", type=type) } overdisp.correction<-function(coeffs, disp.param){ coeffs[, "Std. Error"]=coeffs[, "Std. Error"]*sqrt(disp.param) coeffs[, "z value"]=coeffs[, "Estimate"]/coeffs[, "Std. Error"] coeffs[, "Pr(>|z|)"]=2*pnorm(q=-abs(coeffs[, "z value"]), mean=0, sd=1) return(coeffs) } merge.ests.ci.stab<-function(coeffs, ci=NULL, tests=NULL, stab=NULL){ ires=coeffs if(!is.null(ci)){ coeffs=cbind(coeffs, ci[rownames(coeffs), ]) } if(!is.null(tests)){ xx=outer(rownames(tests), rownames(coeffs), Vectorize(function(tt, e){ if(nchar(tt)>nchar(e)){ return(0) }else{
File: get_looks.R

Comment: Add the starttime (intra_scope_window[1]) to every start position (scope$start) ...  ... of the recording timestamp to get the actual start window in milliseconds
Category: Data Variable
Code:
starting_times <- df$RecordingTimestamp[scope$start] + as.numeric(intra_scope_window[1]) } if (intra_scope_window[2] != "end") {

Comment: set to current trial duration to 0
Category: Data Variable
Code:
current_trial_total_duration[[hn]] <- 0 } current_trial_total_looks[[hn]] <- 0 } current_first_look_duration[[hn]] <- 0 current_first_look_ending_reason[[hn]] <- "" first_looks_collection[[hn]]$found_first <- FALSE first_looks_collection[[hn]]$forced_stop <- FALSE }
File: exp1bDead-MNL-SAT-A.r

Comment: Return sum log likelihood. Include protection against log(0) problems
Category: Statistical Modeling
Code:
return(sum(log(pmax(like, 1e-10)))) } else {
File: stan_CON_adriana_pools5i.r

Comment: Plot posterior fit and forward simulation prediction
Category: Visualization
Code:
plot_fits <- function(stan_fit_ex, N_t, N_p, obs_times, pred_times, data_vector, S_0, D_0, M_0, filename) { sigma_hat <- median(stan_fit_ex$sigma) CO2_flux_ratios_hat_median <- rep(NA, N_t) #Pre-allocate vector for median model fit CO2_flux_ratios_pred_median <- rep(NA, N_p) sigma_hat <- median(stan_fit_ex$sigma) for (t in 1:N_t) { CO2_flux_ratios_hat_median[t] <- median(stan_fit_ex$CO2_flux_ratios_hat_vector[,t]) } for (t in 1:N_p) { CO2_flux_ratios_pred_median[t] <- median(stan_fit_ex$CO2_flux_ratios_new_vector[,t]) }
File: experiment1c_analyses.R

Comment: fit linear mixed effects models  null model
Category: Statistical Modeling
Code:
fitlmer0 <- lmer(rating ~ 1 + (1|subject), data = dat.long1, REML = FALSE) summary(fitlmer0)
File: pmwg-DIC.r

Comment: the mean of each parameter across iterations. Keep dimensions for parameters and subjects
Category: Statistical Modeling
Code:
mean.params <- t(apply(sampled$samples$alpha[,,keep],1:2,mean))
File: BCA_activity_answers.R

Comment: plot the calibration curve (Abs vs. [BSA]) with an appropriate trendline and figure caption
Category: Visualization
Code:
ggplot(bca, aes(x = BSA, y = Abs562)) +
File: 04_simulation_continuous_predictor.R

Comment: generate MPT data:
Category: Data Variable
Code:
gendat <- genMPT(theta = pnorm(theta), restrictions = "model/restrictions.txt", numItems = numItems, eqnfile="model/2htsm.eqn")
File: BRMS + Figure4.R

Comment: Recode confirm(oppose/confirm) and won(win/lost) to factors
Category: Data Variable
Code:
DF$confirm <- recode(DF$confirm, `0` = "Confirmed", `1` = "Opposed") DF$won <- recode(DF$won, `0` = "Lost", `1` = "Won") DF <- DF %>% mutate(confirm = as_factor(confirm)) %>% mutate(treatment = as_factor(treatment)) %>% mutate(won = as_factor(won)) %>% mutate(majmin = as_factor(majmin)) %>% mutate(experiment = as_factor(experiment)) %>% mutate(evidence = as_factor(evidence)) summary(DF)

Comment: create unique id number for each unique individual
Category: Data Variable
Code:
mutate(uniq.id = group_indices(., id, experiment)) %>% mutate(uniq.id = as_factor(uniq.id)) summary(Ind_E1) M_Ind_E1 <- brm(changed ~ won*confirm + trial + (1|uniq.id), data = Ind_E1, family = "bernoulli", iter = 6000, chains = 3, cores = 3, save_all_pars = TRUE, file = "Ind_E1") summary(M_Ind_E1) plot(M_Ind_E1, ask = FALSE) pp_check(M_Ind_E1, check = "distributions") pp_check(M_Ind_E1, check = "residuals") pp_check(M_Ind_E1, "error_scatter_avg") pp_check(M_Ind_E1, check = "scatter")
File: Within-paradigm.R

Comment: generates 95% confidence intervals for each beta coefficient
Category: Statistical Test
Code:
m.p1_decision.CI <- round(confint(m.p1_decision, parm = "beta_"), 3)
File: Dataprep-ParticipantResponses.R

Comment: exclude people who don't meet the inclusion criteria of having data for at least 3 days in each week
Category: Data Variable
Code:
person_weekly_entries <- dat2019 %>% group_by(identity_id, woy)  %>% summarise(n_days = length(identity_id)) person_weekly_entries <- as.data.frame(person_weekly_entries) person_weekly_entries <- subset(person_weekly_entries, n_days >= 3)
File: P2_analysis_newbins.R

Comment: Creating subsets of coins by time period and obtaining measures for each of the time periods
Category: Data Variable
Code:
for (i in dates) { dsub <- (subset(df, df$DATE == i)) motifs <- cbind(dsub[318:681]) denom <- cbind(dsub[256:309]) DATE[i] <- i HDenomination[i] <- entropy(denom) HMotifs[i] <- entropy(motifs) CEDenominationsMotifs[i] <- condentropy(denom, motifs) NormCEDenominationsMotifs[i] <- condentropy(denom, motifs) / entropy(denom) CEMotifsDenominations[i] <- condentropy(motifs, denom) NormCEMotifsDenominations[i] <- condentropy(motifs, denom) / entropy(motifs) MI[i] <- mutinformation(denom, motifs) NDenominations[i] <- length(unique(dsub$DENOMINATION)) NCoins[i] <- length(unique(dsub$ID)) }

Comment: STATISTICAL TESTING: nonparametric Spearman's correlation nonnormalized conditional entropy
Category: Statistical Test
Code:
cor.test(results$DATE, results$CEDenominationsMotifs, method = "spearman") rdates <- rev(dates) #dates = years BCE plot(results$DATE, results$CEDenominationsMotifs, xlim = c(600,330), xaxt='n', xlab = "YEAR BCE", ylab = "H(D|d)", main = "P2: Conditional entropy of denomination given designs") axis(1, at = rdates, labels = rdates)

Comment: Plots with H(D|d)  nonnormalized conditional entropy Getting mean, median and standard deviation across different authorities per period for nonnormalized conditional entropy of denomination given designs 
Category: Visualization
Code:
N <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = length) MEAN <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = mean) MEDIAN <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = median) SD <- aggregate(CEDenominationsMotifs ~ DATE, data = resultspoleis, FUN = sd) resultspoleis_summary <- cbind.data.frame(N, MEAN$CEDenominationsMotifs, MEDIAN$CEDenominationsMotifs, SD$CEDenominationsMotifs) colnames(resultspoleis_summary) <- c("DATE","N","MEAN","MEDIAN","SD") resultspoleis_summary$SE <- resultspoleis_summary$SD / sqrt(resultspoleis_summary$N)

Comment: Plot mean and median H(D|d) across authorities per period
Category: Visualization
Code:
require(ggplot2) ggmean <- ggplot(resultspoleis_summary,aes(x=DATE,y=MEAN)) + labs(title =  "P2: Mean conditional entropy of denominations given designs across authorities", x = "Year BCE", y = "mean H(D|d) across authorities") + scale_x_reverse() + geom_errorbar(aes(ymin=resultspoleis_summary$MEAN-resultspoleis_summary$SE, ymax=resultspoleis_summary$MEAN+resultspoleis_summary$SE),width=.1) + geom_line() + geom_point() ggmean ggmedian <- ggplot(resultspoleis_summary,aes(x=DATE,y=MEDIAN)) + labs(title =  "P2: Median conditional entropy of denominations given designs across authorities", x = "Year BCE", y = "median H(D|d) across authorities") + scale_x_reverse() + geom_line() + geom_point() ggmedian

Comment: REGRESSION ANALYSIS: GROUPING BY AUTHORITIES  nonnormalized CE
Category: Statistical Modeling
Code:
resultspoleis$AUTHORITIES <- rownames(resultspoleis) resultspoleis$DATE <- as.numeric(as.character(resultspoleis$DATE))
File: mse_values_for_density_smoother.R

Comment:  Meanimputes missing values for a vector x   NOTE: see http://www.mailarchive.com/rhelp@rproject.org/msg58289.html   Args:    x: numeric vector   Returns:    x, with missing values replaced by mean(x) 
Category: Data Variable
Code:
return(replace(x, is.na(x), mean(x, na.rm = T))) } makeConstructMatrix <- function(net, a) {
File: 20180714Study2analysisscriptextradata.R

Comment: how many missing data for WVSES questions?
Category: Data Variable
Code:
sum(is.na(df21$WVSE1)) sum(is.na(df21$WVSE2))
File: custom_functions.R

Comment: To log transform Years
Category: Data Variable
Code:
TEST_data <- TEST_data %>% mutate(Yearslog = log(Years))

Comment: Making factors for reasons based on factor analysis. This is making a new data frames that also has plans
Category: Data Variable
Code:
TEST_data_withplans <- dplyr::select( TEST_data, c( 'Hierarchy':'Cooperate', 'plan_materials', 'plan_MS', 'self_MS_prestige', 'self_MS_cooper', 'self_materials_prestige', 'self_materials_cooper' ) )

Comment: Word Cloud GG plot
Category: Visualization
Code:
ggwordcloudc <- function(x,y){ freqt<-count(x,y) set.seed(42) ggplot(freqt, aes( label = y, size = n, color=factor(sample.int(10,nrow(x),replace=TRUE)))) + geom_text_wordcloud(area_corr = TRUE) + scale_size_area(max_size = 24) + theme_minimal() }

Comment: Calculate quantiles for eigenvalues, but only store those from simulated CF model in percentile1 
Category: Data Variable
Code:
percentile <- apply(parallel$values, 2, function(x) quantile(x, .95)) min <- as.numeric(nrow(obs)) min <- (4 * min) - (min - 1) max <- as.numeric(nrow(obs)) max <- 4 * max percentile1 <- percentile[min:max] percentile <- apply(parallel$values, 2, function(x) quantile(x, .95)) min <- as.numeric(nrow(obs)) min <- (4 * min) - (min - 1) max <- as.numeric(nrow(obs)) max <- 4 * max percentile1 = percentile[min:max]

Comment: Label the yaxis 'Eigenvalue'
Category: Visualization
Code:
scale_y_continuous(name = 'Eigenvalue') +

Comment: Label the xaxis 'Factor Number', and ensure that it ranges from 1max  of factors, increasing by one with each 'tick' mark. 
Category: Visualization
Code:
scale_x_continuous(name = 'Factor Number', breaks = min(eigendat$num):max(eigendat$num)) +
File: bivariate_model_summer_revision.R

Comment: drop row without fid data and without distance burrow data
Category: Data Variable
Code:
fid <- fid[!is.na(fid$FID),] fid <- fid[!is.na(fid$dist_burrow),]

Comment: get probability contours for plot
Category: Visualization
Code:
kd <- ks::kde(plot_data, compute.cont=TRUE) contour_90 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["10%"])[[1]]) contour_90 <- data.frame(contour_90) contour_80 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["20%"])[[1]]) contour_80 <- data.frame(contour_80) contour_70 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["30%"])[[1]]) contour_70 <- data.frame(contour_70) contour_60 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["40%"])[[1]]) contour_60 <- data.frame(contour_60) contour_50 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["50%"])[[1]]) contour_50 <- data.frame(contour_50) contour_40 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["60%"])[[1]]) contour_40 <- data.frame(contour_40) contour_30 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["70%"])[[1]]) contour_30 <- data.frame(contour_30) contour_20 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["80%"])[[1]]) contour_20 <- data.frame(contour_20) contour_10 <- with(kd, contourLines(x=eval.points[[1]], y=eval.points[[2]], z=estimate, levels=cont["90%"])[[1]]) contour_10 <- data.frame(contour_10)
File: Goal

Comment: pcurve pcurve(m.cor) Funnel plot, symmetry test (Egger's regression), failsafe n 
Category: Visualization
Code:
pdf("Self_control_Funnel.pdf",width=5,height=5) funnel(m.cor,xlab = "Correlation") dev.off() eggers.test(x = m.cor) fsn(yi=m.cor$TE, sei=m.cor$seTE, type="Rosenthal") plot(copas(m.cor)) copas(m.cor)
File: Posthoc_H3b.R

Comment:  H3a: stress ~ trust  set Cauchy prior (0, 1) as stated in the preregistration 
Category: Statistical Modeling
Code:
prior.coef <- brms::prior(cauchy(0,1),class='b')
File: Exp2_judgment.R

Comment: Fit logistic model to each individual's data to estimate PSEs
Category: Statistical Modeling
Code:
jdat$PSE <- 500 for(i in as.numeric(levels(jdat$Subject))){ dat <- subset(jdat, Subject==i) if(dat$cannot_fit[1]==0){ fit.glm <- glm(faster ~ Distort, family=binomial, data=dat) jdat$PSE[jdat$Subject==i] <- -coef(fit.glm)[1]/coef(fit.glm)[2]  #PSE is -b0/b1 } }

Comment: Linear mixed effects model for graded judgments
Category: Statistical Modeling
Code:
mod_full <- lmer(GradedJudge ~ Context*(GMSI_Gen_Z + Order*Distort) + (1|Subject), data=jdat2) summary(mod_full) Anova(mod_full, type=3, test='Chisq')