drndr/statcodesearch huggingface dataset:
File: ESS_openness_2016.R

Comment: scaling all the variables of interest (between 01) for a composite score
Category: Data Variable
Code:
data8$gincdif_s = rescale(data8$gincdif) data8$smdfslv_s = rescale(data8$smdfslv) data8$sbstrec_r = 6 - data8$sbstrec # reverse scores first data8$sbstrec_r_s = rescale(data8$sbstrec_r)

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

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

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

Comment: use lmList to fit individual GLM models in one go
Category: Statistical Modeling
Code:
mo <- lmList(Response ~ cond1 * JumpSize * Velocity +bdur:cond1 | Subject, d, family=binomial(probit))

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

Comment: sanity check to ensure that we get same estimates from frequentist or Bayesian analysis
Category: Statistical Test
Code:
plot(slope_bdur, slope_bayes, ylab="slope (Bayesian)",xlab="slope (frequentist)", pch=19) abline(a=0,b=1,lty=2) cor.test(slope_bdur, slope_bayes)
File: [2]R-AnswerstoRound3Reviews-Powertoacceptflatwhentrueeffectiszeroacross24studies.R

Comment: n: sample size of each study simtot: number of simulations seed 1 Compute d33, ncp33 and df for the original sample
Category: Data Variable
Code:
d33=pwr.t.test(n=n,sig.level=0.05,power=1/3,type="two.sample")$d ncp33=sqrt(n/2)*d33 df=2*n-2
File: metaBigFive.R

Comment: point estimate p hat (just mean average of coefficients)
Category: Data Variable
Code:
pe <-mean(cors)
File: bayes.ema.tutorial.analysis.R

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

Comment: figure out which columns contain NAs
Category: Data Variable
Code:
missing_cols <- colSums(is.na(data.conseq)) > 0 print(names(data.conseq)[missing_cols])
File: Study1_manipulationeffectiveness.R

Comment: age recored as 1 18, to correct we added 17 to all age variables
Category: Data Variable
Code:
data$age <- data$age + 17

Comment: User language variable into a factor
Category: Data Variable
Code:
data$UserLanguage <- ifelse(data$UserLanguage == "EN", "EN", "NL") data$UserLanguage <- as.factor(data$UserLanguage) contrasts(data$UserLanguage) <- c(0, 1)
File: 7_manova_fda_breach.R

Comment: Test assumptions MANOVA Test whether residuals are normally distributed
Category: Statistical Test
Code:
df$pc1.residuals = lm(pc1~condition.breach, data=df)$residuals df$pc2.residuals = lm(pc2~condition.breach, data=df)$residuals df$pc3.residuals = lm(pc3~condition.breach, data=df)$residuals df$pc4.residuals = lm(pc4~condition.breach, data=df)$residuals shapiro.test(df$pc1.residuals) shapiro.test(df$pc2.residuals) shapiro.test(df$pc3.residuals) shapiro.test(df$pc4.residuals)

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

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

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

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

Comment: fit the data using the lm function
Category: Statistical Modeling
Code:
bcafit <- lm(Abs562 ~ BSA, data = bca)

Comment: rename the columns for display
Category: Data Variable
Code:
colnames(samptab) <- c("Absorbance", "Concentration (mg/mL)")
File: R_script_tables_and_figures.R

Comment: departure time (12 hours so we can calculate easy the mean)
Category: Data Variable
Code:
d1[, time_ := strftime(datetime_ - 60*60*12, format="%H:%M:%S")] d1[, time_ := as.POSIXct(time_, format="%H:%M:%S")]
File: Rcode.R

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

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

Comment: Calculating effect sizes library(DSUR.noof) We got effect sizes of meaningful predictors by executing: rcontrast(t,df) periodsecond
Category: Statistical Test
Code:
rcontrast(-2.685100, 97) rcontrast(-5.280908, 1201)
File: Sim.Dyad.Model.16.R

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

Comment: left_join remaining_uncertain_matched to author_data, subset to remove non
Category: Data Variable
Code:
author_data <- left_join(author_data, remaining_uncertain_matched, by = c("index" = "index")) author_data$match <- as.integer(author_data$match)

Comment: remerge (left_join) author_names with author_data
Category: Data Variable
Code:
author_data <- left_join(test, author_data, by = c("Contact.apsa", "NameSort.apsa")) %>% subset(duplicated(Contact.apsa) == FALSE)
File: F8_plot_efficiency_goodness_of_fit.R

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

Comment: Source functions that allow to easily draw nice visualizations
Category: Visualization
Code:
source("visual_functions_all.R") source("visualize_niceplot.R")
File: Bayesian_analyses_H1d.R

Comment: Test H1d. "Compliance with behavioural guidelines" by Countries random intercept (country) + the fixed effect of country for all coefficients, priors ~ Cauchy (0, 1)
Category: Statistical Modeling
Code:
prior.coef <- brms::prior(cauchy(0,1),class='b')
File: 3 Prepare Data.R

Comment: Mutate targets to uppercase
Category: Data Variable
Code:
SPD_all <- SPD_all %>% mutate(target = toupper(target)) dat <- dat %>% mutate(target = toupper(target))

Comment: Compute Zscores separately for each participant and each session
Category: Statistical Test
Code:
group_by(Subject, Session) %>% mutate(Ztarget.RT = scale(target.RT)) %>% ungroup() %>%
File: Simulations Evidence level.R

Comment: look up pchange in table based on reward (yes/no) and confidence unselected advisor
Category: Data Variable
Code:
sel.row <- subset(p_switch, Reward == reward & Conf.unsel.adv == unselect.adv.conf) sel.row pswitch <- sel.row$Changed pswitch
File: BICBRaschModelsandPlots.R

Comment: exploratory bifactor analysis
Category: Statistical Modeling
Code:
fa(resp, fm="ml", cor="tet", nfactors = 5, rotate = "bifactor", correct = 0)

Comment: estimating Rasch Tree models for gender & age
Category: Statistical Modeling
Code:
gender.dif<-raschtree(dat~gender, data=bdat, deriv="numeric", alpha=.01, bonferroni=TRUE) age.dif<-raschtree(dat~age, data=bdat, deriv="numeric", minsize=400, alpha=.01, bonferroni=TRUE) summary(gender.dif) summary(age.dif) plot(gender.dif) plot(age.dif)
File: Data_preparation_Sample_E.r

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

Comment: compute and save descriptives statistics of variables before aggregation and standardization
Category: Data Variable
Code:
descriptives <- round(select(psych::describe(mSI_descr), n, min, max, mean, sd),2) write.table(descriptives, file="Descriptives/descriptives_Sample_E_mSI.dat", sep="\t")
File: experiment1d_analyses.R

Comment: mean ratings of targets and decoys by condition
Category: Data Variable
Code:
tapply(dat.long$rating, list(dat.long$condition, dat.long$target), mean) tapply(dat.long$rating, list(dat.long$condition, dat.long$target), function(x) sd(x)/sqrt(length(x)))

Comment: paired contrasts on estimated marginal means to unpack interaction
Category: Statistical Test
Code:
emm_options(lmer.df = "satterthwaite") fitlmer2.em <- emmeans::emmeans(fitlmer2, specs = ~ target*condition | target) fitlmer2.em # estimated marginal means contrast(fitlmer2.em, method = "trt.vs.ctrl", adjust = "none") # paired contrasts with no correction confint(contrast(fitlmer2.em, method = "trt.vs.ctrl", adjust = "none")) # 95% confidence intervals contrast(fitlmer2.em, method = "trt.vs.ctrl", adjust = "holm") # paired contrasts with holm correction s <- as.data.frame(summary(fitlmer2.em))
File: Stats_figures_ECT.R

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

Comment: Make figures and tables check for correlaitons between individuals
Category: Visualization
Code:
chart.Correlation(ind_res[[14]][,1:6] , histogram=TRUE, pch=19)
File: figure_pp_check.R

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

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

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

Comment: total_distance of roads surveyed
Category: Data Variable
Code:
sum(unique(site_data_cleaned$Site_Length_m))

Comment: Bring in census data for each site.
Category: Data Variable
Code:
census_data <- fread("StudyAreas/Demographic_Site_Data/PDB_2015_Tract.csv")

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

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

Comment: Check if Trial column exists, if not create it
Category: Data Variable
Code:
if (!"Trial" %in% colnames(df)) { df <- cbind(Trial = NA, df) } trial_counter <- 1 for (i in seq_along(index_pairs$start)) { start_pos <- index_pairs$start[i] end_pos <- index_pairs$end[i]
File: PairsBindingRSS_MPT.R

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

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

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

Comment: Selecting and recoding items that were measured in all waves
Category: Data Variable
Code:
d <- df %>% select(id, wave, lsat = sat6, fsat = sat1i3, per1i2, per1i7, per1i13) %>% mutate(per1i2 = invert(per1i2, 5))