drndr/statcodesearch huggingface dataset:
File: R_Code_Fang_Wu.R

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

Comment: check the correlation between even and oddnumbered sets  Pearson
Category: Statistical Test
Code:
print(corr.test(person$ConditionOr_even, person$ConditionOr_odd), short = FALSE) KH_Correct(-.09) #.16 print(corr.test(person$ConditionOr_even, person$ConditionOr_odd), short = FALSE) KH_Correct(-.11) #.20

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

Comment: Add new ParentIndex column in trialSummary and fill with NA
Category: Data Variable
Code:
trialSummary[,"ParentIndex"] <- NA

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

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

Comment: 3) CALCULATION OF ESTIMATED MARGINAL MEANS   Tests for differences in response to jargon and get data for plots
Category: Statistical Test
Code:
at_jarg <- list(Jargon = c("Less", "More"), TrvlAdv_Atten = "Cons", BackgrYrsOfExp = "6-10 yrs", BackgrDaysPerYr = "11-20 days", BullUseType = "D", cut = "3|4") grid_jarg <- ref_grid(clmm_underjar, mode = "exc.prob", at = at_jarg) (emm_jarg <- emmeans(grid_jarg, specs = pairwise ~ Jargon, by = "BackgrAvTraining")) plot_jarg <- summary(emm_jarg$emmeans) cont_jarg <- summary(emm_jarg$contrasts)
File: Reproduce_figures_prosocial_ageing.R

Comment:  create data frame for mean acceptrate (%) per participant, per effortlevel in 'young' group 
Category: Data Variable
Code:
d.young.effort.1 <- filter(d, Group == 'Young') %>% group_by(ID, Agent, Effort) %>% summarise(m = mean(Choice)*100)

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

Comment: create data frame reflecting overall mean accept rate (%) and SE at each rewardlevel in 'old' group
Category: Data Variable
Code:
d.reward.old.2 <- d.reward.old.1 %>% group_by(Agent, Reward) %>% summarise(SE = std.error(m), M = mean(m, na.rm = T))
File: Table1_analysis.R

Comment: Welch's oneway ANOVA
Category: Statistical Test
Code:
anova_dehyd = df_dehyd %>% welch_anova_test(dehyd ~ cond) anova_dist_ran = df_dist_ran %>% welch_anova_test(dist ~ cond) anova_run_time = df_run_time %>% welch_anova_test(time ~ cond) anova_heat_time = df_heat_time %>% welch_anova_test(time ~ cond) anova_tcmax = df_tcmax %>% welch_anova_test(tcmax ~ cond) anova_tcmin = df_tcmin %>% welch_anova_test(tcmin ~ cond) anova_duration = df_duration %>% welch_anova_test(duration ~ cond) anova_thermal_load = df_thermal_load %>% welch_anova_test(thermal_load ~ cond) anova_heat_time = df_heat_time %>% welch_anova_test(heat_time ~ cond)
File: Simulations_line_plots.R

Comment: Function to generate the true value for the Diamond Ratio
Category: Statistical Modeling
Code:
true.ratio <- function(n1, n2, tau, delta){ v <- (n1 + n2)/(n1*n2) + delta^2/2/(n1 + n2) j <- 1 - 3/(4*(n1 + n2 - 2) - 1) v.g <- (j^2)*v w <- 1/v.g w.star <- 1/(v.g + tau^2) var.fixed <- 1/sum(w) var.random <- 1/sum(w.star) sqrt(var.random/var.fixed) }
File: 3.Ginteger_CrossSex_Tables&Figures.R

Comment: lmer model for dimorphism
Category: Statistical Modeling
Code:
Lat.ML<-lmer(Latency.cen~Sex+scale(Mass, scale = F)+ Generation+Pop+Stage+Injured+scale(Temp, scale = F)+ scale(Time, scale = F)+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(Lat.ML) drop1(Lat.ML) OF.ML<-lmer(sqrt(OF.Dist)~Sex+scale(Mass, scale = F)+ Generation+Pop+Stage+Injured+scale(Temp, scale = F)+ scale(Time, scale = F)+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(OF.ML) drop1(OF.ML) AP.ML<-lmer(sqrt(AP.Dist)~Sex+scale(Mass, scale = F)+ Generation+Pop+Stage+Injured+scale(Temp, scale = F)+ scale(Time, scale = F)+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(AP.ML) drop1(AP.ML) Lat.ML<-lmer(Latency.Cens~Sex+Mass+Generation+Pop+Stage+Injured+Temp+ Time+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(Lat.ML) drop1(Lat.ML) OF.ML<-lmer(OF.Dist~Sex+Mass+Generation+Pop+Stage+Injured+Temp+ Time+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(OF.ML) drop1(OF.ML) AP.ML<-lmer(AP.Dist~Sex+Mass+Generation+Pop+Stage+Injured+Temp+ Time+JDate_dev+(1|Sire)+(1|Dam),data=Data) summary(AP.ML) drop1(AP.ML)
File: generic.r

Comment: return the lastN characters of a string
Category: Data Variable
Code:
fn$lastN<-function(string, n){ l<-nchar(string) result<-substr(string,l-n+1,l) result }
File: Exp2_tapping.R

Comment: Linear mixed effects model for reproduction bias
Category: Statistical Modeling
Code:
mod_full <- lmer(Prct_Bias ~ ContextC*(GMSI_Gen_Z + OrderC*Distort) + (1|Subject), data=dat2)
File: All_Figures.R

Comment: Extra function   MM to inchconversion for plot
Category: Visualization
Code:
MMtoInch <- function(MM) { z <- MM / 25.4 return(z) }
File: Reproduce_figures_prosocial_ageing.R

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

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

Comment: bootstrap modindices of item residual covariances
Category: Statistical Modeling
Code:
cfa.csurf.bl.full.1.boot <- bootstrapLavaan(cfa.csurf.bl.full.1, R = 5000, FUN = function(x) {modindices(x)$mi}, verbose = TRUE) cfa.csurf.bl.full.1.boot <- data.frame(cfa.csurf.bl.full.1.boot) cfa.csurf.fu1.full.1.boot <- bootstrapLavaan(cfa.csurf.fu1.full.1, R = 5000, FUN = function(x) {modindices(x)$mi}, verbose = TRUE) cfa.csurf.fu1.full.1.boot <- data.frame(cfa.csurf.fu1.full.1.boot) cfa.csurf.bl.deponly.1.boot <- bootstrapLavaan(cfa.csurf.bl.deponly.1, R = 5000, FUN = function(x) {modindices(x)$mi}, verbose = TRUE) cfa.csurf.bl.deponly.1.boot <- data.frame(cfa.csurf.bl.deponly.1.boot) cfa.csurf.fu1.deponly.1.boot <- bootstrapLavaan(cfa.csurf.fu1.deponly.1, R = 5000, FUN = function(x) {modindices(x)$mi}, verbose = TRUE) cfa.csurf.fu1.deponly.1.boot <- data.frame(cfa.csurf.fu1.deponly.1.boot)
File: GamingStudy_PreProcessing.R

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

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

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

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

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

Comment: Display and rank country of birth by frequency
Category: Data Variable
Code:
tBirth <- as.data.frame(table(data_main$Birthplace)) View(tBirth[order(tBirth$Freq, decreasing = TRUE), ])
File: os_homing_dataproc.R

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

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

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

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

Comment:  2 Factor Model, correlated factors 
Category: Statistical Modeling
Code:
model_2f <- 'f_a =~ parcel_a_1+parcel_a_2+parcel_a_3 # Agency f_c =~ parcel_c_1+parcel_c_2+parcel_c_3 # Communion ' fit.model_2f <- cfa(model_2f, data=data, std.lv=T) summary(fit.model_2f, fit.measures=TRUE, standardized = TRUE) # Robust model: CFI = .99, RMSEA = .02
File: Script_Predicting_Social_Skill_Expression.R

Comment: Factor Anaylsis with 3 factors
Category: Statistical Modeling
Code:
factors <- fa(items, nfactors = 3)
File: analysis code.R

Comment: binomial logistic regression testing for effect of condition
Category: Statistical Modeling
Code:
model1 <- glm(cbind(PredictTotal, PredictTrials-PredictTotal) ~ Condition, data = study1, family=binomial) summary(model1) Anova(model1, type="III", test="Wald")

Comment: binomial logistic regression testing for effects of behavior and context
Category: Statistical Modeling
Code:
model3 <- glm(cbind(PredictMatch, NumQs-PredictMatch) ~ Behavior + Context + Behavior*Context, data = study2, family=binomial) Anova(model3, type="III", test="Wald")
File: functions1.R

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

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

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

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

Comment: Functions coonducting logit and inverse logit transformation (p to logodds and back)
Category: Statistical Modeling
Code:
logit<-function(x){log(x/(1-x))} inv_logit<-function(x){exp(x)/(1+exp(x))}
File: example_analysis.R

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

Comment:  look at rt data range and distribution, potential outliers 
Category: Data Variable
Code:
peek_neat( data_final, values = c( 'rt_green_negative', 'rt_red_negative', 'rt_green_positive', 'rt_red_positive' ), group_by = 'condition', f_plot = plot_neat )

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

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

Comment: write the number of observed variables to the top
Category: Data Variable
Code:
header[1] <- paste(ifelse(Flow==FALSE , length(unique(df$Point)), length(unique(df$Point)) + 1), "     : number of observed variables") write(header[1:(grep("subbasin number",header) - 2)], file = outfile) header[1] <- paste(n + n1,"     : number of observed variables") write(header[1:(grep("subbasin number",header) - 2)], file = outfile)
File: subject21.R

Comment:  "Remove" first word of each page, except on the first page where the title was the first word (but the title has already been removed)  
Category: Data Variable
Code:
PAST_M_21$gazedur[!duplicated(PAST_M_21$page) & PAST_M_21$page > 1] <- NaN PAST_M_21$fixdur[!duplicated(PAST_M_21$page) & PAST_M_21$page > 1] <- NaN PRES_O_21$gazedur[!duplicated(PRES_O_21$page) & PRES_O_21$page > 1] <- NaN PRES_O_21$fixdur[!duplicated(PRES_O_21$page) & PRES_O_21$page > 1] <- NaN PRES_M_21$gazedur[!duplicated(PRES_M_21$page) & PRES_M_21$page > 1] <- NaN PRES_M_21$fixdur[!duplicated(PRES_M_21$page) & PRES_M_21$page > 1] <- NaN PAST_O_21$gazedur[!duplicated(PAST_O_21$page) & PAST_O_21$page > 1] <- NaN PAST_O_21$fixdur[!duplicated(PAST_O_21$page) & PAST_O_21$page > 1] <- NaN
File: Analysisscript.R

Comment: create a vector with the rounded values (names(valM)  adj_dimension)
Category: Data Variable
Code:
valM <- round(colMeans(d, na.rm = T), 2)
File: Main Tables.R

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

Comment:  Heart rate  median considered as mean when mean not "available" 
Category: Data Variable
Code:
DATA$HR <-  ifelse(is.na(DATA$"all_mean_HR")==T, DATA$all_median_HR, DATA$"all_mean_HR")
File: regression analysis.R

Comment: Keep the removed people to plot separately
Category: Visualization
Code:
nograph_removed <- nograph[nograph$belief_in_medicine >= 7,] graph_removed <- graph[graph$belief_in_medicine >= 7,]
File: Exp2_OnlineExp_POST.R

Comment: Means and Standard Deviations of Conditions  Experiencer
Category: Data Variable
Code:
exp <- data.all[ which(data.all$condition == 'experiencer'),] round(mean(exp$rating), 2) round(sd(exp$rating), 2)
File: Ex1_ Data Wrangling_answers.R

Comment: Q3 create a new data set that contains the first 300 cases from the subset you have just created above
Category: Data Variable
Code:
working_data_2 <- slice(working_data_1, 1:300)

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