drndr/statcodesearch huggingface dataset:
File: 02_prevalence-of-scipop.R

Comment: Custom function for weighted Likert plot
Category: Visualization
Code:
panel <- function(...){ HH::panel.likert(...) vals <- list(...) df <- data.frame(x = vals$x, y = vals$y, groups = vals$groups) grps <- as.character(df$groups) for(i in 1:length(colnames(likertscipop.df))){ grps <- sub(paste0('^', colnames(likertscipop.df)[i]), i, grps) } df <- df[order(df$y,grps),] df$correctX <- ave(df$x, df$y, FUN = function(x){ x[x < 0] <- rev(cumsum(rev(x[x < 0]))) - x[x < 0]/2 x[x > 0] <- cumsum(x[x > 0]) - x[x > 0]/2 return(x) }) subs <- sub(' Positive$', '', df$groups) collapse <- subs[-1] == subs[-length(subs)] & df$y[-1] == df$y[-length(df$y)] df$abs <- abs(df$x) df$abs[c(collapse, F)] <- df$abs[c(collapse, F)] + df$abs[c(F, collapse)] df$correctX[c(collapse, F)] <- 0 df <- df[c(T, !collapse),] df$perc <- round(ave(df$abs, df$y, FUN = function(x){x/sum(x) * 100}), 1) df$perc <- paste0(df$perc,'%') df$perc[df$perc == "0%"] <- "" lattice::panel.text(x = df$correctX, y = df$y, label = df$perc, cex = 1.2, font = 1, col = "white") }
File: 02b_Descriptives_Study2.R

Comment: calculate mean and sd in deduplicated data set
Category: Data Variable
Code:
means <- c(means, paste0(Round(mean(desc[!duplicated(desc$id), i])), " (", Round(sd(desc[!duplicated(desc$id), i])), ")")) } }
File: Data.PC.VAR.Fixed.R

Comment:  For each person combine component scores F, with loading matrix B and error values E to obtain latent structure  For each person standardized the data using the withinperson mean and standard deviation 
Category: Statistical Modeling
Code:
Y = matrix(0,nrow(data),P) colnames(Y) = sprintf("Y%d",seq(1:P)) Error.var = matrix(0,nrow(data),P) colnames(Error.var) = sprintf("E%d",seq(1:P)) FB.var = matrix(0,nrow(data),P) colnames(FB.var) = sprintf("FB%d",seq(1:P)) for (i in 1:N){ n.i = which(data$ID==i) E = sqrt(var.E)*mvrnorm(length(n.i), rep(0,P), diag(P)) Y[n.i,] = F[n.i,] %*% t(B) + E Error.var[n.i,] = E FB.var[n.i,] = F[n.i,] %*% t(B) } data = cbind(data,Y) return(list(Sigma.Psi=NULL,Psi=Psi,Psi.i=NULL,lambda.max.list=NULL,Components=F,data=data, Error.var=Error.var,FB.var=FB.var)) }
File: study1-rscript.R

Comment:  Statistical analysis  Make GramGender a factor with two levels (feminine, masculine) 
Category: Data Variable
Code:
subset.for.plot$GramGender <- as.factor(subset.for.plot$GramGender)
File: Keuken_etal_UHF_MRI_review_analysis_script.r

Comment: Summary statistics on the reported frequence of the structures
Category: Data Variable
Code:
data_struc_names <- as.data.frame(sort(table(data$structures_names))) data_struc_names range(table(data$structures_names)) mean(table(data$structures_names)) sd(table(data$structures_names)) median(table(data$structures_names)) sort(table(data$structures_names))
File: Data_preparation_Sample_A.R

Comment: Exclude subjects who have missing values on the ability test or on selfviewed ability
Category: Data Variable
Code:
mst2 <- subset(mst2, (Raven_self != "NA") & (Raven_obj != "NA") )

Comment:   DESCRIPTIVE STATISTICS   compute and save sample statistics (age distribution, number of females) 
Category: Data Variable
Code:
age <- round(select(psych::describe(mst2_descr$age), n, min, max, mean, sd),2) age$n <- nrow(mst2_descr) sampstats <- mutate(age, female=plyr::count(mst2_descr$sex)[plyr::count(mst2_descr$sex)[,1]=="1",]["freq"] ) write.table(sampstats, file="Descriptives/age_sex_Sample_A_mst2.dat", sep="\t", row.names=FALSE)
File: metaBigFiveextraversion.R

Comment: get estimated variance of tanh1 (p hat)
Category: Statistical Modeling
Code:
dvartanh <- (1-(pe^2))^2 vartanh <- v/dvartanh vartanh
File: Text_Level.R

Comment: We have weak evidence between precohort and coronacohort groups  test for strong invariance  fit model as multigroup model
Category: Statistical Test
Code:
est_s <- cfa(mod_s,quop_use, estimator = "MLR", missing = "FIML", group = "corona", group.equal = c("loadings","intercepts"), cluster = "class")
File: SantaLuciaStationsToPCPFile.R

Comment: find the stations that have 90% of data after 2001
Category: Data Variable
Code:
Pdata_2000 <- Pdata[Dates >= "2000-01-01",] result <- rep(0,(ncol(Pdata_2000)-3)) for (i in 4:ncol(Pdata_2000)) { result[i-3] <- sum(ifelse(is.na(Pdata_2000[,i]),1,0))/nrow(Pdata_2000) }

Comment: result indicates the fraction of NA data for the stations  throw out all the columns and rows where result >0.1
Category: Data Variable
Code:
Pdata_new <- Pdata_2000[,-(which(result>0.1)+3)] Stations <- Stations[-which(result>0.1),] sub_b_sp <- SpatialPoints(cbind(Subbasins$Long_, Subbasins$Lat), proj4string=CRS("+proj=longlat +datum=WGS84 +no_defs"))
File: calc_vars.R

Comment:  create dichotomous variable coded as 0  no, 1  yes 
Category: Data Variable
Code:
dat[, pb_investigated_dich := ifelse(pb_investigated == "yes", 1, 0)]
File: utils.R

Comment:  show ttest, cohen's d, and corrected pvals + CIs for all tests 
Category: Statistical Test
Code:
idx = 1 for (i in all_groups) { cat("\n") print(sprintf('TEST: %s, %s = %d', equation, grouping, i)) t <- t.test(formula = eval(parse(text = equation)), data = filter(df, .data[[grouping]] == i), paired = TRUE, conf.level = ci_level) print(t) print(sprintf('adjusted pval: %.4f', pvals_adj[idx])) d <- effsize::cohen.d(formula = eval(parse(text = paste0(equation, '| Subject(id)'))), data = filter(df, .data[[grouping]] == i), paired = TRUE) print(d)

Comment:  show wilcox test, cliff's d, and corrected pvals for all tests 
Category: Visualization
Code:
idx = 1 for (i in all_groups) { print(sprintf('TEST: %s, %s = %d', equation, grouping, i)) w <- wilcox.test(formula = eval(parse(text = equation)), data = filter(df, .data[[grouping]] == i), paired = TRUE) print(w) print(sprintf('adjusted pval: %.4f', pvals_adj[idx])) d <- effsize::cliff.delta(formula = eval(parse(text = equation)), data = filter(df, .data[[grouping]] == i), paired = TRUE) print(d)
File: tree.R

Comment: fit tree with quadratic model
Category: Statistical Modeling
Code:
hrstree <- semtree(fitted_quadratic_lgcm, as.data.frame(rndhrs_subset), control=semtree.control(verbose=TRUE, method="naive", missing="party", min.bucket = 500, min.N = 250, exclude.heywood = FALSE
File: TRDM-functions.r

Comment: then determine which response was given  unbiased guessing probablity of 1/N
Category: Statistical Modeling
Code:
p.guess <- rep(1/n.acc, n.acc) out$R[timer.replace] <- sample(1:n.acc, size=sum(timer.replace), replace=TRUE, prob=p.guess) } out }
File: plotPostKO.R

Comment:  in case xlim is set to 0, and some value has been given to xrange, center plot symmetrically on zero, using maximal extension in case range is set to 0, and given range otherwise 
Category: Visualization
Code:
if (xlim[1]==0 & !is.null(xrange))  { if (xrange==0)  { maxext <- max(abs(min(paramSampleVec)), abs(max(paramSampleVec)))  #largest extension into positive or negative range xlim = c(-maxext, maxext)   #centers plot symmetrically on zero } else { xlim = c(-xrange, xrange) } }
File: Data_preparation_Sample_B.R

Comment:  compute and save correlation table of selfrated and objective ability measures and outcome aggregates, 
Category: Statistical Modeling
Code:
varnames <- c("Raven","reasoning_self","MWTB","vocabulary_self","global_selfevaluation","well_being","agency_self","communion_self","agency_peer","communion_peer") outcomes_pils <- dplyr::select(pils, Z_Raven_obj, Z_Raven_self, Z_MWTB_obj, Z_MWTB_self, Z_global_selfeval, Z_well_being, Z_agency_self, Z_comm_self, Z_agency_peer, Z_comm_peer) names(outcomes_pils) <- varnames cor_aggr <- corcons(outcomes_pils) write.table(cor_aggr, file="Descriptives/correlations_aggr_Sample_B_pils.dat", sep="\t")
File: pcurve_app4.052.r

Comment: Function 5 Stouffer test for a vector of ppvalues
Category: Statistical Test
Code:
stouffer=function(pp) sum(qnorm(pp),na.rm=TRUE)/sqrt(sum(!is.na(pp)))

Comment: 1.4 Create family to turn t>F and z>chi2
Category: Statistical Test
Code:
family=test family=ifelse(test=="t","f",family) family=ifelse(test=="z","c",family)

Comment: 1.9 Take value after equal sign, the value of the teststatistic, and put it in vector "equal" 
Category: Data Variable
Code:
equal=abs(as.numeric(substring(raw,eq+1)))

Comment: Compute ppvalues for the half
Category: Statistical Modeling
Code:
pp33.half=ifelse(family=="f" & p<.025, (1/prop25)*(    pf(value,df1=df1,df2=df2,ncp=ncp33)-(1-prop25)),NA) pp33.half=ifelse(family=="c" & p<.025, (1/prop25)*(pchisq(value,df=df1,         ncp=ncp33)-(1-prop25)),pp33.half) pp33.half=pbound(pp33.half)
File: corstars.R

Comment: remove lower triangle of correlation matrix
Category: Data Variable
Code:
else if(removeTriangle[1]=="lower"){ Rnew <- as.matrix(Rnew) Rnew[lower.tri(Rnew, diag = TRUE)] <- "" Rnew <- as.data.frame(Rnew) }
File: exp3_analysis.R

Comment: mean RTs by condition
Category: Data Variable
Code:
pretrain_study_rt <- pretrain_study %>% filter(block == 3) %>% group_by(id, condition) %>% summarise(mean_rt = mean(rt)) %>% ungroup()

Comment: show get descriptive stats (how many/what proportion of participants reach each accuracy level)
Category: Visualization
Code:
pretrain_test_acc %>% group_by(test_rep) %>% summarise(n_80 = sum(mean_acc > 0.8), n_100 = sum(mean_acc == 1), prop_100 = sum(mean_acc == 1) / length(mean_acc), prop_80 = sum(mean_acc > 0.8) / length(mean_acc)) pretrain_test_acc %>% filter(test_rep == max(pretrain_test_acc$test_rep)) %>% summarise(group_mean_acc = mean(mean_acc), group_sd_acc = sd(mean_acc))
File: Fisher_Z_3PERIODS_median.R

Comment: P1 COUNTED as 6 seconds until sound event to normalize across trials P2 COUNTED AS FROM SOUND ONSENT (6SECONDS) plus 9 SECONDS  15 SECONDS P3 COUNTED AS 20 SECONDS FROM P2 TO ALMOST END OF THE TRIAL  ORDER PAPAMETER  'OPA', FISHER Z TRANSFORMED ORDER PARAMETER  'FOPA' P2 processing 
Category: Data Variable
Code:
OPAmedianP2<-read.csv(file="OPAmedianP2.csv", sep = "", header=FALSE) colnames(OPAmedianP2)<-c(colheaderChronos) DW_OPAmedianP2=add_column(OPAmedianP2, GR, .before = 1) FOPAmedianP2=FisherZ(OPAmedianP2) DW_FOPAmedianP2=add_column(FOPAmedianP2, GR, .before = 1) DL_OPAmedianP2=melt(DW_OPAmedianP2, id=c("GR"), measured=c("colheaderChronos")) DL_FOPAmedianP2=melt(DW_FOPAmedianP2, id=c("GR"), measured=c("colheaderChronos")) colnames(DL_OPAmedianP2)<-c("GrNr", "TrialNr","OPAmedianP2") colnames(DL_FOPAmedianP2)<-c("GrNr", "TrialNr","FOPAmedianP2")
File: workshop_example.R

Comment: plotting correlations with qgraph
Category: Visualization
Code:
cor_graph <- qgraph(correlations)

Comment: estimate regularized logistic nodewise regression network define where to binarize variables eLASSO (LASSO with EBIC model selection) listwise deletion of missing values (pairwise not possible for regressions)
Category: Statistical Modeling
Code:
Ising_net <- estimateNetwork(data, default = "IsingFit", split = split, missing = "listwise", rule = "OR")
File: ComF_SOM_Rcode.R

Comment: standardize the variables (to obtain standardized coefficients)
Category: Statistical Modeling
Code:
dfAD[,c("S","R","H")] <- data.frame(apply(dfAD[,c("S","R","H")], 2, scale)) dfBE[,c("S","R","H")] <- data.frame(apply(dfBE[,c("S","R","H")], 2, scale)) dfCF[,c("S","R","H")] <- data.frame(apply(dfCF[,c("S","R","H")], 2, scale))
File: 06-Trends.R

Comment:  run logistic regression on each subset, and predict the probability of  outcome for each country at each wave. these data points are used for the  metaanalysis 
Category: Statistical Modeling
Code:
response <- deparse(form[[2]]) data_list <- lapply(1:nrow(sub_data), function(i) { dat <- sub_data$data[[i]] if (!all_na(dat$migrant) && !all_na(dat[[response]]) && nlevels(droplevels(dat$migrant)) > 1) { m <- glm(form, family = binomial(), data = dat) pr <- ggemmeans(m, "migrant") pr$wave <- sub_data$wave[i] pr$country <- sub_data$country[i] pr } else { NA } })
File: 02_random_forest_analysis.R

Comment: Binomial test for significant improvement in accuracy.
Category: Statistical Test
Code:
ifelse(rf_probs > .5, 0, 1) %>% sum %>% # count number of continuous responses binom.test(., nrow(pv), p = baseline)
File: 1_Get_Item-Params_TR.R

Comment: Multiple item parameters and thresholds were in one cell. Split them into separate  columns
Category: Data Variable
Code:
item.dif <- cbind(item.dif, str_split_fixed(item.dif$orig.parameter, " ", 3)) item.dif <- cbind(item.dif, str_split_fixed(item.dif$orig.threshold, " ", 2)) item.dif2 <- cbind(item.dif2, str_split_fixed(item.dif2$orig.parameter, " ", 3)) item.dif2$Tau3 <- ifelse(item.dif2$item == "CR021Q08", 0.74200, NA) item.dif2 <- cbind(item.dif2, str_split_fixed(item.dif2$orig.threshold, " ", 3))
File: Reliability.R

Comment: interrater reliability create dataframe of reliability statistic for each of the 10 pairs of data
Category: Data Variable
Code:
interraterReliability <- data.frame(row.names = row.names(interraterData)) for (i in c(1:10)) { interraterReliability[i,1] <- cohen.kappa(cbind(t(interraterData[i ,c(1:55)]), t(interraterData[i ,c(56:110)])))$weighted.kappa }
File: R_Script_Idiographic_network_analyses.R

Comment: fill empty matrix with the counts significant (p < .05) per lag (rows) and per individual (column)
Category: Statistical Test
Code:
for (j in unique(dataset_imp$Participant)){ tempacf <- acf(dataset_imp[dataset_imp$Participant == j , -c(1,8:13)], lag.max = 60) acfmatrix[,paste0("participant", j)] <- 0 for(i in as.numeric(rownames(acfmatrix))){ tempmatrix <- tempacf$acf[i,,] tempvector <- tempmatrix[upper.tri(tempmatrix, diag = T)] acfmatrix[i,paste0("participant", j)] <- length(which(tempvector > 0.25 | tempvector < -0.25)) } }

Comment: Create list with partial correlation matrices per window
Category: Data Variable
Code:
pcorlist <- list() for (d in seq_len(30)) { pcorlist[[d]] <-  pcor(temp_data[temp_data$Time %in% d:(d+Window),c("Happy", "Worrying","Nervous","Act_later_regret","Act_without_thinking","Restless")])$estimate } pcorlist <- rapply(pcorlist,function(x) ifelse(x==0.00000000,0.00000001,x), how = "replace") # will be pruned
File: Prob_between.R

Comment: Smooth with (bayesian) logistic regression
Category: Statistical Modeling
Code:
(mym<-mean(nus)) d<-list(nus=nus-mym,fur=prob.fur*10000) m<-quap(alist( fur~dbinom(10000,p), logit(p)<-a+b*nus, a~dnorm(0,1), b~dnorm(0,1) ),data=d)
File: 1_create_composite_measures.R

Comment:  For home (emotional) climate items, recode values of "99" to missing. 
Category: Data Variable
Code:
mutate_at(vars(contains("EDNh_Emotion")), ~ifelse(. == 99, NA, .)) %>%  # (Not sure exactly how this code works, but it does)
File: ordinal_plot_functions.R

Comment: figure < annotate_figure(figure, top  text_grob(str_c(Q_text[1]), size  8, color"black")) figure 
Category: Visualization
Code:
ggsave(str_c(ordinal_y[QN],"_random.pdf"),plot=figure,width=12,height=14) return(figure) }

Comment: ordered_logistic stacked plot
Category: Visualization
Code:
N_cat <- max(d[,var_y],na.rm=T) grn <- 250 zLogM <- seq(-5,4,length.out=grn) P <- matrix(NA, nrow=grn, ncol=N_cat) for(i in 1:grn){ P[i,] <- ordered_logistic(fixef['b_X']*zLogM[i],cutpoints) } if(QN==1 | QN==4 | QN==5 | QN==8){ axis_labels <- c('fraction of responses','M-ratio') }else{ axis_labels <- c(' ',' ') } data.frame(P) -> P colnames(P) <- x_lab #str_c("p_",1:N_cat) P$zlogM <- zLogM P$logM <- P$zlogM * 2*sd(log(d$M_cov)) + mean(log(d$M_cov)) P$M <- exp(P$logM) P %>% pivot_longer(cols=x_lab, #starts_with("p_"), values_to="p", names_to="k") %>% mutate(k = as_factor(k), k = fct_rev(k)) %>% ggplot(aes(x=M, y=p, fill=k)) + scale_fill_viridis_d(name="",labels = wrap_format(20), option="rocket") + geom_area(alpha=0.8 , size=0.4, colour="black")+ themeXstack + labs(y=axis_labels[1],x=axis_labels[2])+ scale_y_continuous(breaks=seq(0,1,0.1))+ coord_cartesian(xlim=c(0.5,1.3),ylim=c(0+0.045,1-0.045))+ ggtitle(label=str_wrap(sel_Q_text,22)) -> pl_stack
File: analysis_MASTER.R

Comment: calculate threshold for lowest quartile
Category: Data Variable
Code:
quantile(tau_squared_self)[2]] tau2_thres_publ <- dat[as_factor(primary_data) == "yes" & k_publ > k_thres, quantile(tau_squared_self_publ)[2]]
File: DECEPTION-ProbitSDT-v1.R

Comment: now we add up all corresponding answers to create one row per participant, as in a typical ANOVA design analysis 
Category: Statistical Modeling
Code:
sdt.agg <- sdt.agg %>% group_by(Participant, type) %>% summarise(count = n()) %>% spread(type, count) sdt.agg #this is a new dataframe for the aggregate data, you can delete after.
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 }
File: AnalyzeDummyData.R

Comment: extract posterior samples of omega
Category: Statistical Modeling
Code:
posterior.omega <- c(posterior.omega.check[, 1], posterior.omega.check[, 2]) posterior.omega.description.only <- c(posterior.omega.check[, 1], posterior.omega.check[, 2]) posterior.omega.description.plus.stats <- c(posterior.omega.check[, 1], posterior.omega.check[, 2])
File: 2021-6-7_No_Man_Is_An_Island_analyses.R

Comment: MEAN & SD FOR AMOUNT OF REM SLEEP (min) BETWEEN BASELINE AND ISOLATION
Category: Data Variable
Code:
aggregate(REM~Place, data=REM_GNS, FUN=mean) aggregate(REM~Place, data=REM_GNS, FUN=sd)

Comment: calculating sociality bias ratio variable  Converting the amount of dream interactions to same scale  as the amount of wake time interactions was reported
Category: Data Variable
Code:
IN$int_cat<-ifelse(IN$Interactions == 0, 1, ifelse(IN$Interactions >= 1 & IN$Interactions <= 5, 2, ifelse(IN$Interactions >= 6 & IN$Interactions <= 15, 3, ifelse(IN$Interactions >= 16 & IN$Interactions <= 25, 4,5)))) IN$dream_per_sos<-IN$int_cat/IN$sos_int_prev_day hist(IN$dream_per_sos) qqnorm(IN$dream_per_sos) #skewed hist(log(IN$dream_per_sos)) qqnorm(log(IN$dream_per_sos)) #looks more normally distributed after log-transformed
File: boosting_xgbDART.R

Comment: join predicted to test data
Category: Data Variable
Code:
test_pred <- left_join(test,prediction,by="id") test_pred <- as.data.frame(test_pred) test_pred$class_var <- as.factor(test_pred$class_var) test_pred$class_var_pred <- as.factor(test_pred$class_var_pred)
File: Script_R.R

Comment: Computing SMD (g) and its variance
Category: Statistical Modeling
Code:
smd <- escalc(measure = "SMD", m1i = wm, m2i = mm, sd1i = wsd, sd2i = msd, n1i = wn, n2i = mn, data = smd.means, append = TRUE) smd #Two columns (yi and vi) have been added#

Comment: Computing Fisher's z and its variance
Category: Statistical Modeling
Code:
zcor <- escalc(measure = "ZCOR", ri = cor, ni = sample, data = zcor.correlations, append = TRUE) zcor

Comment: Obtaining the forest plot
Category: Visualization
Code:
forest(res)

Comment: Analog to ANOVA: If we want to know the mean ES for each 'random' level: yes/no
Category: Statistical Test
Code:
res_r <- rma(yi = g, vi = var, mods = ~ factor(random)-1, data = dat) res_r

Comment: Obtaining a funnel plot (model without moderators)
Category: Visualization
Code:
funnel(res, main = "Random-Effects Model")
File: R_code_test_congruence_effects.R

Comment:  inspect potential multicollinearity using the variance inflation factor (VIF),  for the example of the criterion variable outcome_sqd  (see Fox, 2016 for a discussion of VIFs and their cutoffs) 
Category: Statistical Modeling
Code:
lm_sqd <- lm(outcome_sqd ~ X + Y + X2 + XY + Y2, data=df) vif(lm_sqd)
File: study-2_main-analysis-code.R

Comment: Mixed effects logistic regression
Category: Statistical Modeling
Code:
logistic_model_1 <- glmer(instructions ~ distance + (1|ID) + (1|target) + (1|task), data = choices, family = binomial(link = "logit")) logistic_model_2 <- glmer(instructions ~ distance + (1 + distance|ID) + (1|target) + (1|task), data = choices, family = binomial(link = "logit")) logistic_model_3 <- glmer(instructions ~ distance + (1 + distance|ID) + (1|target) + (1 + distance|task), data = choices, family = binomial(link = "logit"), control = glmerControl(optimizer = "bobyqa", optCtrl = list(maxfun = 100000))) model_comparison <- anova(logistic_model_1, logistic_model_2, logistic_model_3)
File: Analysis_and_source_code_table_3_and_figure_3.R

Comment: GLMMs  results of models with year as continuous are in table 3 Model with year as continuous variable
Category: Statistical Modeling
Code:
mod1ADI<-lmer(ADImS~LAT+LONG+YEAR1+(1|STATE)+(1|ROUTE2)+(1|SITE)+(1|YEAR1),dat=datUS,REML=F) mod1ADI<-lmer(ADImS~LAT+LONG+YEAR1+(1|SITE)+(1|COUNTRY)+(1|YEAR1),dat=datEU,REML=F)
File: Manuscript_main analyses.R

Comment: familiarity x female x BL   check effect of Baseline on familiarity x gender (self) interaction
Category: Statistical Modeling
Code:
HR_test_BL = lmer(HR_EMA ~ SI_familiarity_cw * female * HR_BL_cb + female * SI_gender_partner + SIAS_cb + State_SI_Anxiety_cw + SI_count + SI_type_simple + SI_duration_cw + SI_caffeine + SI_nicotin + SI_alcohol + accel_EMA_cw + (1|Participant), data=df_interact) summary(HR_test_BL) Anova(HR_test_BL, type=3) anova(HR_A, HR_test_BL) # no difference RMSSD_test_BL = lmer(ln_RMSSD_EMA ~ SI_familiarity_cw * female * ln_RMSSD_BL_cb + female * SI_gender_partner + SIAS_cb + State_SI_Anxiety_cw + SI_count + SI_type_simple + SI_duration_cw + SI_caffeine + SI_nicotin + SI_alcohol + accel_EMA_cw + (1|Participant), data=df_interact) summary(RMSSD_test_BL) Anova(RMSSD_test_BL, type=3) anova(RMSSD_A, RMSSD_test_BL) # better
File: Graphics_Section_5.R

Comment: let's try to create a boxplot for mpg on the  of cylinders (cyl)
Category: Visualization
Code:
ggplot(mtcars, aes(factor(cyl), mpg)) + geom_boxplot()
File: duque_etal_2019_rcode.R

Comment: Likelihood Ratio Tests for nested model comparison
Category: Statistical Test
Code:
pair1_rand_anova <- anova(pair1_rand_full, pair1_rand2, pair1_rand3) # empty model = pair1_rand2 pair1_rand_anova_tidy <- tidy(pair1_rand_anova) pair2_rand_anova <- anova(pair2_rand_full, pair2_rand2, pair2_rand3) pair2_rand_anova_tidy <- tidy(pair2_rand_anova)  # create tidy table of model parameters pair2_fixed_anova <- anova(pair2_full, pair2_fixed, pair2_fixed2, pair2_fixed3, pair2_rand2) pair2_fixed_anova_tidy <- tidy(pair2_fixed_anova)  # create tidy table of model parameters pair2_fixed_lmer <- tidy(pair2_fixed2)  # create tidy table of model parameters group1_rand_anova <- anova(group1_rand_full, group1_rand2, group1_rand3, group1_rand4) # a random intercept for each pair is significantly better than empty, otherwise all other random effects tested were not warranted group1_rand_anova_tidy <- tidy(group1_rand_anova)  # create tidy table of model parameters group1_rand_lmer <- tidy(group1_rand3)  # create tidy table of model parameters group2_rand_anova <- anova(group2_rand_full, group2_rand2, group2_rand3, group2_rand4, group2_rand5) group2_rand_anova_tidy <- tidy(group2_rand_anova)  # create tidy table of model parameters group2_rand_lmer <- tidy(group2_rand2)  # create tidy table of model parameters
File: mse_values_latent_space_diffusion_slurm.R

Comment: Fills in missing values of x with the mean of x   Args:    x: a numeric vector   Returns:    x with missing values filled in
Category: Data Variable
Code:
return(replace(x, is.na(x), mean(x, na.rm = T))) } mseOfMatchingColumns <- function(nm, mat, dt) {
File: prep_functions.R

Comment:  **** 0.3.4) logisticPseudoR2s   calculates Logistic pseudo Rs (from Field et al., 2013)  input: glm object 
Category: Statistical Modeling
Code:
logisticPseudoR2s <- function(LogModel) { dev <- LogModel$deviance nullDev <- LogModel$null.deviance modelN <- length(LogModel$fitted.values) R.l <- 1 - dev / nullDev R.cs <- 1- exp ( -(nullDev - dev) / modelN) R.n <- R.cs / ( 1 - ( exp (-(nullDev / modelN)))) outdat <- data.table(R.l = R.l, R.cs = R.cs, R.n = R.n) outdat[, r.sq.print := paste(round(R.l, 3), "/", round(R.cs, 3), "/", round(R.n, 3), sep = "")] return(outdat) }