drndr/statcodesearch huggingface dataset:
File: visualize_niceplot.R

Comment: function serves to plot all important information what is plotted can be modified by whatplot argument first  predict value line second  confidence interval third  points fourth  axis fifth  summary of the end point sixth  corresponding line
Category: Visualization
Code:
nice.plot<-function(X=describe$generation,Y,maxY,minY=0,col,whatplot=c(T,T,T,T,T,T),ofset=0,name="",labs=c(minY,ifelse(explarge==T,signif(maxY,nsignif),maxY)),span=0.18,end=length(X),roundrep=0,nsignif=3,percentual=F,explarge=F,labrep=ifelse(explarge==T,signif((ci[,1][newend]*(maxY-minY)+minY),nsignif),ifelse(percentual==T,paste(round((ci[,1][newend]*(maxY-minY)+minY)*100,roundrep),"%",sep=""),round((ci[,1][newend]*(maxY-minY)+minY),roundrep))),cextext=1,lwdmain=2,mtextcex=1,firstax=-0.3,smooth=F){ col.li<-col col.ci<-paste(col,"20",sep="") col.po<-paste(col,"33",sep="") Y<-(Y-minY)/(maxY-minY) if(whatplot[3]==T){ points(X[1:end],Y[1:end],col=col.po,pch=16) } tryCatch({ lo <- loess(Y~X,degree=1,span=span) newX <- seq(min(X),max(X), length.out=1000) ci = cbind( predict(lo, data.frame(X=newX)), predict(lo, data.frame(X=newX))+ predict(lo, data.frame(X=newX), se=TRUE)$se.fit*qnorm(1-.05/2), predict(lo, data.frame(X=newX))- predict(lo, data.frame(X=newX), se=TRUE)$se.fit*qnorm(1-.05/2) ) }, error = function(e){ print("warning: loess returned error, original values instead of loess smoothed curved are visualized") newX <- X ci = cbind(Y,Y,Y) }) newend<-which.min(abs(newX-end)) if(smooth==F){ newY <- approx(Y,n=1000)$y ci <- cbind(newY,newY,newY) } if(whatplot[1]==T){ lines(newX[1:newend], ci[,1][1:newend], lwd=lwdmain,col=col.li) } if(whatplot[2]==T){ if(smooth==T){ polygon(c(newX[1:newend],rev(newX[1:newend])), c(ci[,2][1:newend],rev(ci[,3][1:newend])), col=col.ci,border=NA) } } if(whatplot[4]==T){ par(mgp=c(3,ofset+firstax,ofset+firstax-0.2)) axis(2,at=c(0,1),lab=c("",""),col=col.li,col.axis=col.li,tck=-0.008) mtext(name,2,line=ofset+firstax,col=col.li,cex=mtextcex) mtext(labs,at=c(0,1),2,line=ofset+firstax,col=col.li,cex=mtextcex) } xtext<-par("usr")[2]-(par("usr")[2]-par("usr")[1])/50 if(whatplot[5]==T){ text(xtext,ci[,1][newend],labrep,col=col.li,xpd=T,pos=4,cex=cextext) } if(whatplot[6]==T){ lines(c(0,xtext),rep(ci[,1][newend],2),col=col.li,lty=3,xpd=T) } }
File: 03_analysis_color.R

Comment: We draw a lollipop diagram to illustrate color distribution
Category: Visualization
Code:
par(ps = PS, mar = c(5, 5, 4, 2) + 0.1) plot(x = graphData$colour, y = graphData$Beach, type = "p", col = col_beach, ylim = c(0, 65), xlab = "Colour", ylab = "Proportion [%]", pch = PCH, xaxt = "n", cex = SS) axis(1, at = seq(1, 6, by = 1), labels = c("White", "Beige", "Grey", "Yellow", "Red", "Black")) par(ps = PS, new = TRUE, mar = c(5, 5, 4, 2) + 0.1) plot(x = graphData$colour, y = graphData$Wreck, type = "p", col = col_wreck, ylim = c(0, 65), axes = FALSE, xlab = "", ylab = "", pch = PCH, cex = SS) arrows(x0 = graphData$colour, x1 = graphData$colour, y0 = graphData$Beach, y1 = graphData$Wreck, angle = 90, length = 0, ) legend("topright", legend = c("Beach", "Wreck"), fill = c(col_beach, col_wreck), bty = "n")
File: 03_glmm_analysis.R

Comment: Extract model statistics   Extract coefficients and std errors
Category: Statistical Modeling
Code:
model_coefs <- glmm_list %>% plyr::ldply(.fun = tidy) %>% subset(group == 'fixed') %>% droplevels
File: analysis.R

Comment: Regression test for funnel plot asymmetry
Category: Visualization
Code:
res <- rma(Z_value,Z_var, data=data1, measure = "ZCOR", method = "ML") regtest(res, predictor = "vi")
File: custom_functions.R

Comment: build a new matrix that includes the formatted correlations and their significance stars
Category: Data Variable
Code:
Rnew <- matrix(Rformatted, ncol = ncol(x)) rownames(Rnew) <- colnames(x) colnames(Rnew) <- paste(colnames(x), "", sep =" ")

Comment: CLEAR ENVIRONMENT   function to clear the environment after running a script while keeping important objects  use clear_environment: add store_to_keep variable with list variables;;  tip: include a variable with curr_env
Category: Data Variable
Code:
clear_environment <- function(keep, # vector with variable-names to be excluded from cleaning all=ls(envir=pos.to.env(1))){ rm(list = all[! all %in% keep], envir = pos.to.env(1)) }
File: RCode_Final_24Feb20.R

Comment: boxplot visualizing the differences between the three languages
Category: Visualization
Code:
par(mfrow = c(1,1)) boxplot(ReadRate ~ Language, data = joint.read_rate, main = "Reading rate, words/minute")
File: 20180513Study3Analysis.R

Comment: zscore RSES T1 and T2
Category: Statistical Test
Code:
df2$RSES1Z <- (df2$RSES1 - mean(df2$RSES1))/sd(df2$RSES1) df2$RSES2Z <- (df2$RSES2 - mean(df2$RSES2, na.rm = TRUE))/sd(df2$RSES2, na.rm = TRUE)
File: code_analyses.R

Comment:  ANALYSES  Does Att Valence differ across Sections, OA Practice, and Level? 
Category: Data Variable
Code:
mod_attvalence <- lmer(Att~Level*Section*OAPractice+(1|Responder_ID), df_attvalence) summary(mod_attvalence) anova(mod_attvalence) eta_sq(mod_attvalence, partial = TRUE)

Comment: Create variable Past_Future from Item.
Category: Data Variable
Code:
df_use$Past_Future <- recode(df_use$Item, P1Use01 = "In the past 12 months",P1Use02 = "In the following 12 months", P2Use01 = "In the past 12 months",P2Use02 = "In the following 12 months", P3Use01 = "In the past 12 months",P3Use02 = "In the following 12 months", P4Use01 = "In the past 12 months",P4Use02 = "In the following 12 months", P5Use01 = "In the past 12 months",P5Use02 = "In the following 12 months")

Comment: Calculate average level of Att across Perspectives.
Category: Data Variable
Code:
df_use_attvalence$Att <- rowMeans(df_use_attvalence[,c('Att_DailyLife', 'Att_ResearchField', 'Att_PublicSociety')], na.rm=TRUE)
File: comparison_smooth.R

Comment:  Formula and family specification   In our case, setting `k  4` and `bs  'cr'` in the mgcv::s() smooth term is  not overly restrictive (checked by running the frequentist mgcv::gam()  function for each existing activity index in turn, thereby varying arguments  `k` and `bs`, and then checking the summary() of the resulting fits), but in a  future (prospective) study, the mgcv::s() settings need to be checked again: 
Category: Statistical Modeling
Code:
C_formula <- as.formula(paste(voutc, "~", paste0("s(", vactidx_i, ", k = 4, bs = 'cr')"))) C_family <- cumulative(link = "logit", link_disc = "log", threshold = "flexible")
File: 20180714Study1analysisscript.R

Comment: display relationships between WVSES and associated variables
Category: Visualization
Code:
ggplot(df11, aes(WVSES, SE)) + geom_jitter() ggplot(df11, aes(WVSES, SISE)) + geom_jitter() ggplot(df11, aes(WVSES, ANX)) + geom_jitter() ggplot(df11, aes(WVSES, AVO)) + geom_jitter() ggplot(df11, aes(WVSES, LIFE)) + geom_jitter() ggplot(df11, aes(WVSES, EXTRA)) + geom_jitter() ggplot(df11, aes(WVSES, AGREE)) + geom_jitter() ggplot(df11, aes(WVSES, CON)) + geom_jitter() ggplot(df11, aes(WVSES, NEUR)) + geom_jitter() ggplot(df11, aes(WVSES, OPEN)) + geom_jitter() ggplot(df11, aes(WVSES, SSTA)) + geom_jitter() ggplot(df11, aes(WVSES, SINC)) + geom_jitter() ggplot(df11, aes(WVSES, MDS)) + geom_jitter()

Comment: take RSES and run confirmatory factor analysis
Category: Statistical Modeling
Code:
RSESdata <- data.frame(df11$SE1, df11$SE2, df11$SE3, df11$SE4, df11$SE5, df11$SE6, df11$SE7, df11$SE8, df11$SE9, df11$SE10) singleF.model <- 'SE =~ df11.SE1 + df11.SE2 + df11.SE3 + df11.SE4 + df11.SE5 + df11.SE6 + df11.SE7 + df11.SE8 + df11.SE9 + df11.SE10'
File: mmcpsr_author_data.R

Comment:  pivot authorlevel data to "longer" authorarticlelevel dataframe 
Category: Data Variable
Code:
article_author_level <- author_level %>% dplyr::select(FirstName_MI_LastName_str, full_name.kap, Article.1.Code.kap, Article.2.Code.kap, Article.3.Code.kap, Article.4.Code.kap, Article.5.Code.kap, Article.6.Code.kap, Article.7.Code.kap, Article.8.Code.kap, Article.9.Code.kap, Article.10.Code.kap, Gender.apsa, R_E.apsa, PhD.Year, PhD.Institution) %>% pivot_longer(cols = -c(FirstName_MI_LastName_str, full_name.kap, Gender.apsa, R_E.apsa, PhD.Year, PhD.Institution), values_to = "article_title", names_to = "names") %>% subset(article_title != "NA") %>% relocate(article_title)

Comment: authorlevel count and proportion for all race / ethnic identity categories
Category: Data Variable
Code:
summary_race_ethnicity_author <- article_author_level %>% dplyr::select(-c(article_title, names)) %>% distinct() %>% summarize(count = c(sum(white, na.rm = TRUE), sum(black, na.rm = TRUE), sum(east_asian, na.rm = TRUE), sum(south_asian, na.rm = TRUE), sum(latino, na.rm = TRUE), sum(mena, na.rm = TRUE), sum(native, na.rm = TRUE), sum(pacific, na.rm = TRUE), sum(other, na.rm = TRUE))) summary_race_ethnicity_author <- summary_race_ethnicity_author %>% mutate(race_ethnicity = c("White", "Black", "East Asian", "South Asian", "Hispanic or Latino", "Middle Eastern / Arab", "Native", "Pacific Islander", "Other")) %>% mutate(proportion = round(count / sum(count), 2)) %>% dplyr::select(race_ethnicity, count, proportion)
File: facebook_pages.R

Comment: Convert `candidate_page` to a factor. (Facilitates data visualizations and exploration).
Category: Visualization
Code:
elxn2015$candidate_page <- factor(elxn2015$candidate_page, levels = c("Harper", "Trudeau", "Mulcair"))

Comment:  Timestamps are initially encoded as factors. Convert them to POSIXct format to avoid errors. Dates and times are separated and saved as two new variables;; namely, `date_published` and `time_published`. `date_published` must be converted back to POSIXct format. `Time_published` is left as a character string as this format proves easier to work with when plotting timerelated data. 
Category: Data Variable
Code:
elxn2015$created_time <- anytime(elxn2015$created_time, tz = "America/Los_Angeles") elxn2015$date_published <- as.POSIXct(format(elxn2015$created_time, "%Y-%m-%d")) elxn2015$time_published <- format(elxn2015$created_time, "%H:%M:%S")

Comment: Create a new variable from `date_published` to indicate the month each post was published.
Category: Data Variable
Code:
elxn2015$month_published <- as.POSIXct(elxn2015$date_published, format="%H:%M:%S") elxn2015$month_published <- format(elxn2015$month_published, "%B")

Comment: `month_published` is converted to a factor with three levels such that values are chronologically ordered.
Category: Data Variable
Code:
elxn2015$month_published <- factor(elxn2015$month_published, levels = c("August", "September","October"))

Comment: Ensure consistent data types across data sets. IDs are appropriately treated as characters rather than numeric.
Category: Data Variable
Code:
Facebook_Pages$id <- as.character(Facebook_Pages$id) Facebook_Pages$likes_count <- as.double(Facebook_Pages$likes_count) Facebook_Pages$comments_count <- as.double(Facebook_Pages$comments_count) Facebook_Pages$shares_count <- as.double(Facebook_Pages$shares_count)
File: ESCI_forest_plot.R

Comment: run random and fixed effects analyses on the data and calculate confidence intervals for the variables corresponding to heterogeneity (I2, H2 and T2). slab contains a vector of study names to display on the plot. 
Category: Statistical Test
Code:
res <- rma(measure = "MD", m1i = m2,m2i = m1, sd1i = sd2, sd2i = sd1, n1i = n2, n2i = n1, weights = as.numeric(weights.r), slab = c("Mc1", "Mc2", "Mi1", "Mi2", "Mi3", "Mi4", "Mi5", "Mi6", "Mi7", "Mi8" ), method = "DL") res.f <- rma(measure = "MD", m1i = m2,m2i = m1, sd1i = sd2, sd2i = sd1, n1i = n2, n2i = n1, weights = weights.f, method = "FE") con <- confint(res)
File: AuxiliaryFunctions.R

Comment: 2. Transform precision into partial correlations for interpretation
Category: Data Variable
Code:
pr2pc <- function(K) { D.Prec = diag(diag(K)^(-.5)) R <- diag(2,dim(K)[1])-D.Prec%*%K%*%D.Prec colnames(R) <- colnames(K) rownames(R) <- rownames(K) return(R) }

Comment: 4. BDgraph extract posterior distribution for estimates
Category: Statistical Modeling
Code:
extractposterior <- function(fit, data, method = c("ggm", "gcgm"), not.cont){ m <- length(fit$all_graphs) k <- 30000 n <- nrow(data) p <- ncol(data) j <- 1 densities <- rep(0, k)

Comment: objects to store graph centrality measures
Category: Data Variable
Code:
degree <- matrix(0, nrow = len, ncol = p) betweenness <- matrix(0, nrow = len, ncol = p) closeness <- matrix(0, nrow = len, ncol = p)
File: get_tweets.R

Comment:  create token named "twitter_token" 
Category: Data Variable
Code:
twitter_token <- create_token( app = appname, consumer_key = key, consumer_secret = secret, access_token = access_token, access_secret = access_secret)
File: experiment1b_analyses.R

Comment: mean/sd 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: mean difference between candidates in each condition
Category: Statistical Modeling
Code:
round(s[s$target == 'envy.target' & s$condition == 'Baseline', "emmean"] - s[s$target == 'pity.target' & s$condition == 'Baseline', "emmean"],3) round(s[s$target == 'envy.target' & s$condition == 'PityAD', "emmean"] - s[s$target == 'pity.target' & s$condition == 'PityAD', "emmean"],3) round(s[s$target == 'envy.target' & s$condition == 'PityC', "emmean"] - s[s$target == 'pity.target' & s$condition == 'PityC', "emmean"],3) round(s[s$target == 'envy.target' & s$condition == 'EnvyAD', "emmean"] - s[s$target == 'pity.target' & s$condition == 'EnvyAD', "emmean"],3) round(s[s$target == 'envy.target' & s$condition == 'EnvyC', "emmean"] - s[s$target == 'pity.target' & s$condition == 'EnvyC', "emmean"],3)
File: figure2.R

Comment: regression for difference between social/nonsocial
Category: Statistical Modeling
Code:
b = glmer(choice ~ pchoice1*social +  opchoice2*social + opchoice1 + pchoice2 + (1 + pchoice1 +  opchoice2 + opchoice1 + pchoice2  |code),family = 'binomial',data[data$opponent == 1,] ,control = glmerControl(optimizer="bobyqa", tolPwrss = 1e-10, optCtrl = list(maxfun = 60000))) b = glmer(choice ~ pchoice1*social +  opchoice2*social + opchoice1 + pchoice2 + (1 + pchoice1 +  opchoice2 + opchoice1 + pchoice2  |code),family = 'binomial',data[data$opponent == 0,] ,control = glmerControl(optimizer="bobyqa", tolPwrss = 1e-10, optCtrl = list(maxfun = 60000)))
File: 2_Conditioning_Recode.R

Comment: Principal component analysis with correlation matrix
Category: Statistical Modeling
Code:
pca <- prcomp(d[, -whi], scale. = T)
File: hadza_combine_data.R

Comment: Make stacked figure of costs by age
Category: Visualization
Code:
stack <- lapply(pe.list.hadza_male, colMeans, na.rm=T) stacks <- as.data.frame(do.call(rbind, stack)) names(stacks) <- c(male.acts, "climbing") stacks$age <- age_seq stacks$Processing <- stacks$light_processing + stacks$other_out_of_camp + stacks$pounding_baobab stack_plot_male <- stacks %>% select(-nonsubsistence, -resting, -light_processing, -other_out_of_camp, -pounding_baobab) %>% gather(key="act", value="cost", carry_firewood_water:climbing, Processing) male_stack_hadza <- ggplot(stack_plot_male, aes(x=age, y=cost, fill=act)) + geom_area() + scale_fill_manual(name="Activity", labels=c("Firewood and water collection", "Chopping", "Climbing", "Eating", "Manufacture", "Food processing", "Walking (during foraging)"), values = brewer.pal(7, "Set1")) + labs(x="Age (years)", y="Energy cost (kcal/day)") + theme_classic(base_size=16) + ggtitle("Hadza: Men") + lims(y=c(0, 750)) stack <- lapply(pe.list.hadza_female, colMeans, na.rm=T) stacks <- as.data.frame(do.call(rbind, stack)) names(stacks) <- female.acts stacks$age <- age_seq stacks$Processing <- stacks$light_processing + stacks$other_out_of_camp + stacks$pounding_baobab stack_plot_female <- stacks %>% select(-nonsubsistence, -resting, -light_processing, -other_out_of_camp, -pounding_baobab) %>% gather(key="act", value="cost", carry_firewood_water:digging, Processing) fhcols <- brewer.pal(8, "Set1")[c(1,2,4,5,6,7)] fhcols[2] <- "#33CCFF" female_stack_hadza <- ggplot(stack_plot_female, aes(x=age, y=cost, fill=act)) + geom_area() + scale_fill_manual(name="Activity", labels=c("Firewood and water collection", "Digging", "Eating", "Manufacture", "Food processing", "Walking (during foraging)"), values = fhcols) + labs(x="Age (years)", y="Energy cost (kcal/day)") + theme_classic(base_size=16) + ggtitle("Hadza: Women") + lims(y=c(0, 750))
File: preprocessing_hrs.R

Comment: create centered age^2 variable for quadratic LGCM
Category: Statistical Modeling
Code:
qscale <- 100 rndhrs_subset <- rndhrs_subset %>% mutate(CAGE2_T4 = CAGE_T4^2 / qscale, CAGE2_T5 = CAGE_T5^2 / qscale, CAGE2_T6 = CAGE_T6^2 / qscale, CAGE2_T7 = CAGE_T7^2 / qscale, CAGE2_T8 = CAGE_T8^2 / qscale, CAGE2_T9 = CAGE_T9^2 / qscale, CAGE2_T10 = CAGE_T10^2 / qscale, CAGE2_T11 = CAGE_T11^2 / qscale )
File: RCS_plot_LogisticCox.R

Comment: put.pvalue   Function to put the pvalues accoridng to the journals guidelines
Category: Data Variable
Code:
put.pvalue=function(p){ sapply(p, function(x){ if (is.na(x)){pc="NA"} else if (x<0.0001){pc="<0.0001"} else if (0.0001<=x & x<0.001){pc <- sprintf("%.4f", x)} else if (0.049<=x & x<0.05) {pc <- sprintf("%.3f", floor(x*1000)/1000)} else if (0.001<=x & x<0.1){pc <- sprintf("%.3f", x)} else if (0.1<=x){pc <- sprintf("%.2f", x)} return(pc) }) }

Comment: wald.test   Function to perform Wald test in logistic or Cox model
Category: Statistical Test
Code:
wald.test <- function(model, ntest){ d <- length(ntest) a <- t(coefficients(model)[ntest]) mat <- vcov(model)[ntest,ntest] value <- as.numeric(a%*%solve(mat)%*%t(a)) pvalue <- pchisq(value, df=d, lower.tail=F) return(list(value=value, df=d, pvalue=pvalue)) }
File: Stats_figures_JBTxECT.R

Comment: Function to change pvalues in the stat table with the ones from the model
Category: Statistical Modeling
Code:
update_table <- function(mymod) { modsum <- summary(mymod) p <- modsum$coefficients[, "Pr(>|t|)"] p <- as.vector(p) p <- pvalr(p, sig.limit = .001, digits = 3) p }
File: R_KMCurveCode.R

Comment: Plot KM Curve
Category: Visualization
Code:
tiff("PRAD_KM Curve.tiff", units = "in", width=8, height=6, res=300) ggsurvplot(fit1, D2, risk.table=TRUE, palette = "jco", pval=TRUE, conf.int=FALSE, surv.median.line="hv", ylab= "Survival Probability (%)", xlab= "Time (months)", legend.title = "TX GROUP", pval.coord=c(10,0.25)) dev.off()
File: dataAnalysisRewardAppsExperiment.R

Comment:   now iterate through each participant, take that PP's data frame and add z scores for RT  afterwards, add that PP's data frame to the empty data frame to recreate the main df including z scores 
Category: Data Variable
Code:
for (aPP in unique(excl2Exp$PP)){ dat <- excl2Exp[excl2Exp$PP == aPP,] dat$zScore <- scale(dat$RespRT, scale = TRUE) excl2Exp2 <- rbind(excl2Exp2, dat) }
File: SubgroupStatsSimulationV5.R

Comment: ttest on subset 1 (n6/sex/group)
Category: Statistical Test
Code:
p_6m6f = t.test(measure ~ group, data=simdata6each_sub1)$p.value #using 6 each sex, t-tests
File: Figures.R

Comment: box and whisker plot for refined factor scores convert dataframe of factor scores and cluster membership to long form
Category: Visualization
Code:
KClusterScores.long <- KClusterScores %>% pivot_longer(c(Sensory, CognitiveDemand, ThreatToSelf, CrossSettings, Safety, States), names_to = c("Factor")) KClusterScores.long$Factor <- factor(KClusterScores.long$Factor, levels = c("Sensory", "CognitiveDemand", "ThreatToSelf", "CrossSettings", "Safety", "States"))

Comment: box and whisker plot for nonrefined factor (scale) scores convert dataframe of factor scores and cluster membership to long form
Category: Visualization
Code:
scale.KClusterScores.long <- scale.KClusterScores %>% pivot_longer(c(Sensory, CognitiveDemand, ThreatToSelf, CrossSettings, Safety, States), names_to = c("Factor")) scale.KClusterScores.long$Factor <- factor(scale.KClusterScores.long$Factor, levels = c("Sensory", "CognitiveDemand", "ThreatToSelf", "CrossSettings", "Safety", "States"))
File: Ter Schure (2021) R code ALL-IN meta-analysis paper.R

Comment:  calculate logrank Zstatistics assuming balanced risk set (in OE, E is always 0.5) 
Category: Statistical Test
Code:
zs <- sapply(1:(CureVobs1 + CureVobs0), function(n) (sum(CureVobs1s[1:n]) - n/2)/sqrt(n/4))
File: QPsyAnalyse.R

Comment: Statistics  check distributions  check normal distribution of PSE's
Category: Statistical Test
Code:
qqnorm(AllPSEs$Tennis.thre) shapiro.test(AllPSEs$Tennis.thre) # p < .01, qqnorm(AllPSEs$SoccerD.thre) shapiro.test(AllPSEs$SoccerD.thre) # p = .14, qqnorm(AllPSEs$SoccerI.thre) shapiro.test(AllPSEs$SoccerI.thre) # p < .01 qqnorm(AllPSEs$Coin.thre) shapiro.test(AllPSEs$Coin.thre) # p = .04

Comment: TEST 1: wilcoxon's signed rank test for direct/ indirect trials
Category: Statistical Test
Code:
(TestID <- wilcox.test(EffectDirect, EffectIndirect, paired = TRUE))
File: ESM-RUM_R_code.R

Comment:  add a column with "time_interval" : either 9:00;;13:00;;17:00;;21:00     for this, check the $created column and depending on which interval it is in, create a new column with mutate 
Category: Data Variable
Code:
df_ESM_data_analysis = df_ESM_data_analysis %>% mutate( time_interval = case_when( format(created,"%H:%M") >= param_timepoints[1] & format(created,"%H:%M") < param_timepoints[2]  ~ param_timepoints[1], format(created,"%H:%M") >= param_timepoints[2] & format(created,"%H:%M") < param_timepoints[3]  ~ param_timepoints[2], format(created,"%H:%M") >= param_timepoints[3] & format(created,"%H:%M") < param_timepoints[4]  ~ param_timepoints[3], format(created,"%H:%M") >= param_timepoints[4] & format(created,"%H:%M") < param_t_end          ~ param_timepoints[4], ) )

Comment: first find the duplicates according to n_obs and time_interval
Category: Data Variable
Code:
df_ESM_data_analysis = df_ESM_data_analysis %>% arrange(session, created) %>% group_by(session, n_obs, time_interval) %>% mutate(num_dups = n(), dup_id = row_number()) %>% ungroup() %>%

Comment: plot perseverance as a function of n_obs for each subject
Category: Visualization
Code:
gdat <- groupedData(perseverance ~ n_obs | session, data=df_ESM_data_analysis_noNAnoOutliers) plot(gdat)

Comment: put alpha together with descriptive statistics
Category: Data Variable
Code:
questionnaire_stats <- bind_cols(questionnaires_stats, scores_alpha) %>% dplyr::select(-name, -vars)

Comment:  Correlation plot (colors on top, numbers on bottom)  JUST MEANS (aggregated within person) 
Category: Visualization
Code:
corrplot(means, p.mat = res2$p, insig = "label_sig", sig.level = c(.001, .01, .05), pch.cex = .9, pch.col = "gray", method = "color", tl.col = "black", tl.cex = 1, cl.offset = 0.25, cl.cex = 0.75) corrplot(means, method="number", col = "black", add = TRUE, cl.pos = "n", tl.pos = "n", type = "lower", number.cex = .60, number.digits = 2, tl.col = "black", cl.offset = 4)
File: nGFS.R

Comment: Independence test: two ways (HSIC or Nonlinear corr)  HSIC
Category: Statistical Test
Code:
if (independence == "hsic") { hsic.p <- dhsic.test(ry, rx, method = "gamma", kernel = "gaussian")$p.value pval[i] <- hsic.p }
File: ESM-RUM_R_code.R

Comment: Correlation table (only with complete cases  so takes out data from single parent)
Category: Data Variable
Code:
means <- cor(mean_data_mat[,c(2:12)], use = "complete.obs") # Correlation matrix res2 <- cor.mtest(mean_data_mat[,c(2:12)], conf.level = .95, use = "complete.obs") # p-values
File: Analysis_Imitation_and_Token.R

Comment: EXCLUDE PPN WITH RT < or > 3 SD
Category: Data Variable
Code:
max_sd_rt <- print(mean(data.rt.check$rt)+3*sd(data.rt.check$rt)) ppn.exclude.rt <- print(filter(data.rt.check, rt >= max_sd_rt)$ppn)
File: US attitude code.R

Comment: Calculate and plot difference between the distributions
Category: Visualization
Code:
postDiff <- forModel2plotA$b_cfaInequality_nat - forModel2plotB$b_cfaSocial_control_nat %>% as.data.frame() ggplot(postDiff, aes(.)) + geom_histogram(bins = 100, color = "black", fill = "lightgray") quantile(postDiff, c(0.025, 0.975)) #So 95% confidence interval of the difference lies above 0