drndr/statcodesearch huggingface dataset:
File: Analyses_Section_4.R

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

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

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

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

Comment: min and max age, mean and sd age, percentage of men and women
Category: Data Variable
Code:
minAge = min(df_preQ$age) maxAge = max(df_preQ$age) meanAge = mean(df_preQ$age) sdAge = sd(df_preQ$age) females = length(which(df_preQ$gender == "female")) males = length(which(df_preQ$gender == "male")) other = length(which(df_preQ$gender == "other"))

Comment: Check normality with QQ plot and ShapiroWilk test Build the linear model
Category: Statistical Test
Code:
model <- lm(FW ~ condition, data = df_postQ)

Comment: Visualize correlations Insignificant correlations are leaved blank
Category: Visualization
Code:
corrplot(res_cor$r, method = 'number', type="upper", order="hclust", p.mat = res_cor$P, sig.level = 0.05, insig = "blank")

Comment: plot a correlation matrix with all the different measures Create a dataframe with all the different measures of above
Category: Visualization
Code:
df_corM <- data.frame(df_postQ$FW, df_postQ$DU, df_postQ$arousal, df_postQ$valence, df_postQ$control, df_postQ$responsibility, df_diff$Diff) colnames(df_corM) <- c('FW', 'DU', 'arousal', 'valence', 'control', 'responsibility', 'Diff')
File: figure_individual_fits.R

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

Comment: draw n_lines random regression lines
Category: Visualization
Code:
func_samples <- tidy_draws %>% group_by(trial_unique_id, replicate) %>% sample_n(n_lines) %>% ungroup() print(func_samples)

Comment: cross product decay_rates with x (time) values and calculate y (titer) values
Category: Data Variable
Code:
to_plot <- func_samples %>% crossing(plot_times) to_plot <- to_plot %>% mutate(predicted_titer = scaling * 10^(intercept - decay_rate * time)) dat <- dat[dat$material == material, ] max_titer <- scaling * max(dat$titer)
File: is_hitname_in_range.R

Comment: this function accepts a column containing hitnames, a target hitname to look for, and a ... starting and ending fixation index
Category: Data Variable
Code:
is_hitname_in_range <- function(vec, hitname, fi_start, fi_end) { if (!"fi_pairs" %in% ls(envir = .GlobalEnv)) { fi_pairs <- get_fixationindex_pairs(df$FixationIndex)
File: Enrichment_GPS_POIs_HERE_API.R

Comment: 0 get sensing/location data for the specific user
Category: Data Variable
Code:
sensing = dplyr::tbl(phonestudy, "ps_activity") %>% dplyr::filter(user_id %in% user) %>% dplyr::filter(!activityName %in% c("PHONESTUDY", "DNAPSOUND", "DNAPACCELEROMETER", "DNAPLIGHT", "DNAPPROXIMITY", "DNAPGYROSCOPE")) %>% dplyr::mutate(timestamp = as.character(timestamp), created_at = as.character(created_at), updated_at = as.character(updated_at)) %>% data.frame() sensing$user_id = as.character(sensing$user_id)
File: runHierarchicalGCM.R

Comment: Creates the variable 'distances', a 540 X 540 distance matrix between stimuli
Category: Data Variable
Code:
coordinates = read.xlsx("540_coordinates.xlsx", colNames = TRUE) coordinates = as.matrix(unname(coordinates)) coordinates = coordinates[,2:9] distances = as.matrix(dist(coordinates))
File: Data.Cluster.VAR.Fixed.R

Comment: Number of subjects in each group Create a group variable according to each cluster condition
Category: Data Variable
Code:
if (size == 1){ N.size = N/K n.group = unlist(lapply(1:K, function(k) rep(k,N.size))) } if (size == 2){ if (K == 2){ N.1 = 0.10*N N.2 = N - N.1 n.group = c(rep(1,N.1),rep(2,N.2)) } if (K == 4){ N.1 = 0.10*N N.rest = N - N.1 N.size = N.rest/(K-1) n.group = c(rep(1,N.1),rep(2,N.size),rep(3,N.size),rep(4,N.size)) }} if (size == 3){ if (K == 2){ N.1 = 0.6*N N.2 = N - N.1 n.group = c(rep(1,N.1),rep(2,N.2)) } if (K == 4){ if (N == 20){ N.1 = 0.6*N N.rest = N - N.1 N.size = floor(N.rest/(K-1)) n.group = c(rep(1,N.1),rep(2,N.size),rep(3,N.size+1),rep(4,N.size+1)) } else{ N.1 = 0.6*N N.rest = N - N.1 N.size = N.rest/(K-1) n.group = c(rep(1,N.1),rep(2,N.size),rep(3,N.size),rep(4,N.size)) }}}
File: create_output_behavioral.R

Comment: make a blank output table to hold the derive stats, and fill it up
Category: Data Variable
Code:
out.tbl <- data.frame(array(NA, c(800, 5)));; # just make it big for now colnames(out.tbl) <- c("load.type", "cat.type", "trial.type", "stat.name", "stat.value");; ctr <- 1;;
File: three countries plot.R

Comment: creating healthcare / containment variable
Category: Data Variable
Code:
measures_new <- measures_new %>% mutate(measure_category = if_else(str_starts(measure,"H"), "Healthcare", "Containment"))
File: Sim.Dyad.Model.3.R

Comment: Number of subject in Group 0
Category: Data Variable
Code:
N0.subject = 2*N0.dyad
File: Prepare_wst_data_OSF.R

Comment: Exclude data from students who changed class or school during the school year.
Category: Data Variable
Code:
quop2$exclusion[quop2$change>0] <- 1

Comment: create date variable for birthday
Category: Data Variable
Code:
quop2$s_birth_date <- as.Date(quop2$s_birth, format = "%d.%m.%Y")

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

Comment: Creat file paths for the raw data and the csv files that you get at the end
Category: Data Variable
Code:
file_path = 'data_fullstudy1.txt' file_path2 = 'behavioral.csv' file_path3 = 'questionnaires.csv' file_path4 = 'boxes.csv'

Comment: Create loop for every participant, put the relevant data into the dataframe
Category: Data Variable
Code:
con <- file(file_path, open = "r") on.exit(close(con)) lines <- readLines(con) subjects_data <- list() game_data <- list() boxes_data <- list() subj <- 0 for (line in lines) { if (grepl("Enter your Prolific ID", line, fixed = TRUE)) { subj = subj + 1 metadata_beginning <- fromJSON(str_replace(line, "\\}\\{", ",")) subj_data <- ""
File: 03_descriptive-analysis.R

Comment: Recode NAs to 0 for response frequency tables
Category: Data Variable
Code:
recodeNAto0 <- function(var) { case_when(is.na(var) ~ 0, T ~ var) }

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

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

Comment: extract the head and convert it to image
Category: Data Variable
Code:
extract_pdf_top <- function(pdf_path) { page_img <- image_read_pdf(pdf_path, page = 1, density = 72) width <- image_info(page_img)$width height <- image_info(page_img)$height left <- 0 top <- 75 height <- height / 4 image_crop(page_img, geometry = sprintf("%fx%f+%f+%f", width, height, left, top)) } dontcare <- first_page_paths %>% map(extract_pdf_top) %>% map2(png_paths, image_write)
File: politicalknowledgeestimatecentralitydefaultsatleast6.R

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

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

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

Comment: checking disctribution of the dependent variable
Category: Data Variable
Code:
hist(overall.data$LTScreenOut) hist(overall.data$LTObjectOut) hist(overall.data$FirstLookDurationObjectOut)

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

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

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

Comment: Calculate to and from percentages
Category: Data Variable
Code:
from_id <- unique(AbbyLinks$from) for (i in 1:length(from_id)) { AbbyLinks$perc_from[AbbyLinks$from == from_id[i]] <- AbbyLinks$n[AbbyLinks$from == from_id[i]]/sum(AbbyLinks$n[AbbyLinks$from == from_id[i]]) } to_id <- unique(AbbyLinks$to) for (i in 1:length(to_id)) { AbbyLinks$perc_to[AbbyLinks$to == to_id[i]] <- AbbyLinks$n[AbbyLinks$to == to_id[i]]/sum(AbbyLinks$n[AbbyLinks$to == to_id[i]]) } rm(i, from_id, to_id) head(AbbyLinks, 10)
File: med.validation.R

Comment: Generate Data Generate the outcome (y) and mediator (m) in the population with a correlation of b, variances of 1, and means of 0.
Category: Data Variable
Code:
sigma <- rbind(c(1, b), c(b, 1)) mu <- c(0, 0) df <- as.data.frame(mvrnorm(n = n, mu = mu, Sigma = sigma)) names(df) <- c("y", "m")
File: plots.R

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

Comment: round all numeric variables x: data frame digits: number of digits to round
Category: Data Variable
Code:
numeric_columns <- sapply(x, class) == 'numeric' x[numeric_columns] <- round(x[numeric_columns], digits) x }
File: 01_setup.R

Comment: M, SD, range of key sociodemographic variables (across countries)
Category: Data Variable
Code:
summstats(ds, age, country_name) %>% print(n = nrow(.)) summstats(ds, sex_rec, country_name) %>% print(n = nrow(.)) summstats(ds, edu_9cat, country_name) %>% print(n = nrow(.)) summstats(ds, income_10cat, country_name) %>% print(n = nrow(.))
File: SSK_Cleaned.R

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

Comment: Calculating Bayes Factors for effects
Category: Statistical Test
Code:
bayes_factor(xfit1,xfit2) bayes_factor(xfit1,xfit3)
File: abstract ratings analysis.r

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

Comment: plot the raw data and the 95% HPDI from m.arithmetic
Category: Visualization
Code:
d.gg.math <- d.math.agg d.gg.math$mean <- NA d.gg.math$low_ci <- NA d.gg.math$high_ci <- NA
File: Exp1_complete.R

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

Comment: Simple slopes: Model for testing effect of Context at high GMSI
Category: Statistical Modeling
Code:
mod_1 <- lmer(Prct_Bias ~ ContextC*(GMSI_Gen_hi + GroupC*OrderC*Distort) + (ContextC | Subject), data=dat2) summary(mod_1) Anova(mod_1, type=3, test='Chisq')
File: Bird AGL - Outputs and plots.R

Comment: Add informaiton on species + condition to each row of dplot
Category: Visualization
Code:
gramXspec <- as.factor(c(rep("Bird AD", 3), rep("Bird NAD", 3))) grammar <- as.factor(c(rep("AD", 3), rep("NAD", 3))) species <- as.factor(c(rep("Bird", 6))) dplot $ Condition <- as.factor(grammar) ;; dplot$Species <- as.factor(species) ;; dplot $ gramXspec <- as.factor(gramXspec) dplot
File: 04_SOURCE_ExclusionCriteria.R

Comment: exclude App Spirituality features (are accidentally still created in the data set as empty variables)
Category: Data Variable
Code:
sensing = sensing %>% dplyr::select(!matches("Spirituality"), -date)
File: 02-exclCriteria.r

Comment: Porportion of trials missed within each block, for each subj
Category: Data Variable
Code:
miss.blk <- with(data, tapply(trialError, list(subj, data$block), function(x) sum(x!="FALSE") / length(x)))
File: eda_brms.R

Comment: plot fit model marginal_effects( FIT ) compute marginal means and average marginal effects
Category: Visualization
Code:
mu_happy = rowMeans(getCAT_fitted_mean(FIT , 'emotion' , 'happy' )) mu_angry = rowMeans(getCAT_fitted_mean(FIT , 'emotion' , 'angry' )) mu_neutral = rowMeans(getCAT_fitted_mean(FIT , 'emotion' , 'neutral' )) contrast_mu_angry_neutral = mu_angry-mu_neutral contrast_mu_happy_neutral = mu_happy-mu_neutral contrast_mu_angry_happy = mu_angry - mu_happy
File: 02generateKbrevistimeseries.R

Comment: Add column for centered logtransformed time series
Category: Data Variable
Code:
habsos.ts$ctr <- habsos.ts$log10_CELLS - mean(habsos.ts$log10_CELLS) head( habsos.ts )
File: Paper_functions.R

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

Comment: 2. Stats 2.1 Calculate standard error (se_func)
Category: Statistical Test
Code:
se_func <- function(var) { sd <- sd(var) n <- length(var) se <- sd / sqrt(n) return(se) }

Comment: Calculate confidence interval (upper bound)
Category: Statistical Test
Code:
upper_ci_func <- function(var) { m <- mean(var) sd <- sd(var) n <- length(var) se <- sd / sqrt(n) lower_ci <- m + qt(1 - (0.05 / 2), n - 1) * se return(lower_ci) }

Comment: 2.6 Bayes Factor paired ttest (func_ttest_paired_bf)
Category: Statistical Test
Code:
func_ttest_paired_bf <- function(pre = df_merge1_s3$paffect_pre, post = df_merge1_s3$paffect_post, dv = "paffect") {

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

Comment: impute missing values with the median of the respective variable
Category: Data Variable
Code:
phonedata <- impute(phonedata, target = "Soci", classes = list(numeric = imputeMedian(), integer = imputeMedian()))$data
File: misc.helpers.R

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