drndr/statcodesearch huggingface dataset:
File: pupillometry_tutorial_calignano.R

Comment: exclude NAs from data
Category: Data Variable
Code:
data <- data[complete.cases(data$average), ] summary(data) nrow(data)
File: Social Factors COVID-19_Konrad.R

Comment:  2. compare model indices (ICC, conditional and margina RÂ²) 
Category: Statistical Modeling
Code:
tab_model(model0.1, model1, model1_full) tab_model(model0.1, model2, model2_full) tab_model(model0.2, model3, model3_full)

Comment: Plot robust model 1  get predicted Values for different levels of rsa_socialresources
Category: Visualization
Code:
gg_model1 <- ggpredict(model1_robust, c("daycount[0, 25, 50, 75]", "rsa_socialresources[meansd]", "diagnosis"))
File: AnalysisPost-PAP.R

Comment: count of articles that generated data using experimental techniques (includes articles that use both, percentage calculated using total empirical articles) 
Category: Data Variable
Code:
GenerateData[2,2] <- sum(MMCPSR_emp$EHPdata) GenerateData[2,3] <- sum(MMCPSR_emp$EHPdata)/nrow(MMCPSR_emp)
File: hadza_returns_model.R

Comment:  Load data: data file "hfp" contains individuallevel foraging return data (kcal) at the daily level along with the date, unique camp id, age, sex, and unique person id. 
Category: Data Variable
Code:
hfp <- read.csv("food_pro_data.csv", as.is=T) h <- hfp[hfp$age > 5,] h$age_z <- (h$age-mean(h$age, na.rm=T))/sd(h$age, na.rm=T) h$month <- month(ymd(h$date))

Comment: Plot the marginal/conditional effects for predicted values and probability of zerodays
Category: Visualization
Code:
p <- conditional_effects(hadza_lognormal_returns_model, effects=c("age_z:sex"))  # includes the hurdle component p2 <- conditional_effects(hadza_lognormal_returns_model, effects=c("age_z:sex"), dpar="hu") # to see the hurdle component (Pr zero-days) plot(p)[[1]] + scale_x_continuous(breaks = c(-1, 0, 1, 2), labels= round(c(-1, 0, 1, 2)*sd(h$age, na.rm=T) + mean(h$age, na.rm=T))) + ggplot2::labs(x="Age", y="kcal/day") +ggplot2::lims(y=c(0,6500)) + theme_classic() plot(p2)[[1]] + ggplot2::lims(y=c(0,1)) + labs(x="Age", y="Probability of zero day\n(hurdle component of model)") + theme_classic() + scale_x_continuous(breaks = c(-1, 0, 1, 2), labels= round(c(-1, 0, 1, 2)*sd(h$age, na.rm=T) + mean(h$age, na.rm=T)))
File: stuart.R

Comment: Calculate overall mean standard length (Ls)
Category: Data Variable
Code:
Ls <- mean(standard.length, na.rm = TRUE)
File: Psi.PS.AR.Matrix.R

Comment: Generate Psi of an AR(1) model
Category: Statistical Modeling
Code:
Psi = diag(p) diag(Psi) = runif(p,b.ar.min,b.ar.max) return(Psi) }
File: Rcode_Figure2.R

Comment: We use the R package qgraph to visualize our matrix
Category: Visualization
Code:
if (!require(qgraph)) install.packages("qgraph");; require(qgraph)

Comment: VISUALIZE YOUR NETWORKS  Make sure you have the right package: qgraph
Category: Visualization
Code:
if (!require(qgraph)) install.packages("qgraph");; require(qgraph)
File: Exp1-LBA-null.r

Comment:  load source functions and data  generates four data sets: FF, FS, SF, SS 
Category: Data Variable
Code:
source("prep-Exp1-data.r") source("pmwg-DIC.r")

Comment: estimate model independently for each condition in the experiment
Category: Statistical Modeling
Code:
for(condition in names(all.data)) { cat("\n\n\n\nEstimating model for: ", condition, "\n\n") fnam <- paste0("Exp1-LBA-", model.par, "-", condition, ".RData")
File: Collaboration boosts career progression_part

Comment:  Then write loop to go through all Scopus IDs, adding the output to the first dataframe  NOTE: create 'output' folder in your working directory before running the following code 
Category: Data Variable
Code:
for (i in 1:length(authors)){ tryCatch({ #using tryCatch () to go around error https://stackoverflow.com/questions/14748557/skipping-error-in-for-loop. So here it skips the authorIDs with an error and keeps going res = retrievalByAuthorID(authors[i], apik) M2 = res$M output <- rbind(M,M2) write.csv(output, paste0(output$AU_ID[1],".csv"), row.names=F) #creates seperate csv's for each Scopus ID }, error=function(e){}) }

Comment: Select first letter of first name + surname
Category: Data Variable
Code:
for(i in names(x)){ firstname = word(x[[i]],-1) initial = substring(firstname, 1, 1) surname = word(x[[i]],-2) surname[is.na(surname)] <- "" tot = as.data.frame(paste(initial, surname,sep = ".")) tot[tot=="."]="" x[[i]] <- tot  #join first and last name with a full stop }

Comment:  Add a column per author, indicating which papers belong to them (0 or 1) 
Category: Data Variable
Code:
authors = as.character(unique(authorswithAPInotworking$author.name)) x[is.na(x)]="" for(i in (authors)){ x$i = rowSums(x == i) colnames(x)[colnames(x) == 'i'] <- i } ncol.new = ncol(x)

Comment: Have a look at distribution first and last years, to look at outliers 
Category: Visualization
Code:
hist(as.numeric(new$first.year)) hist(as.numeric(new$last.year))
File: combinealldata.R

Comment: Add position of word in sentence (prefabricated list made in Python)
Category: Data Variable
Code:
positionlist <- read.delim("U:/surfdriveRU/Thesis analyse/LMM analyse/positionlist.txt", header = FALSE) eyetrackingdata$position <- positionlist$V1
File: Functions_IRT.R

Comment: density plotting function
Category: Visualization
Code:
denschart3 <- function (x, labels = NULL, groups = NULL, gdata = NULL, cex = par("cex"), pt.cex = cex, bg = par("bg"), color = "grey20", colorHPDI ="grey60", HPDI=0.9, vline = NULL, gcolor = par("fg"), lcolor = "gray", xlim = range(unlist(x)), yvals = 1:length(x), yextra=0.7, main = NULL, xlab = NULL, ylab = NULL, height=0.7 , border=NA, adjust=1, ...) { opar <- par("mai", "mar", "cex", "yaxs") on.exit(par(opar)) par(cex = cex, yaxs = "i") if (!is.list(x)) stop("'x' must be a list of vectors or matrices") n <- length(x) glabels <- NULL if (is.list(x)) { if (is.null(labels)) labels <- names(x) if (is.null(labels)) labels <- as.character(1L:n) labels <- rep_len(labels, n)
File: stadyl_analyses.R

Comment:    Data wrangling    recode values for missing data (9, 999) in whole dataset as NA 
Category: Data Variable
Code:
data <- data %>% mutate_all(~na_if(., -999)) data <- data %>% mutate_all(~na_if(., -9))

Comment: Moderated regression    center variables
Category: Statistical Modeling
Code:
data$ls.1c <- data$ls.1 - 3.57 data$sc.c  <- scale(data$sc,   center = T, scale = F) data$mob.c <- scale(data$mob,  center = T, scale = F) data$age.c <- scale(data$age,  center = T, scale = F)

Comment: get standardised regression coefficients
Category: Statistical Modeling
Code:
lm.beta(fit1) lm.beta(fit2)

Comment: Plots Moderated regression
Category: Visualization
Code:
psych::describe(data[c("sc", "mob")]) interact_plot(fit1, pred = mob.c, modx =sc.c, #partial.residuals = TRUE, interval = TRUE, int.width = 0.95, modx.values = c(-1.48, 0, 1.48), colors = c("#D9ED92", "#52B69A", "#1E6091"), modx.labels = c("Low (- 1SD)", "Middle (Mean)", "High (+ 1SD)"), legend.main = "Perceived status loss") + labs(y = "Predicted life satisfaction", x = "Upward mobility beliefs") + guides(fill = guide_legend(title = "Perceived status loss")) + coord_cartesian(ylim = c(1,7)) + scale_y_continuous(expand = c(0, 0), breaks = c(1,2,3,4,5,6,7)) + scale_x_continuous(expand = c(0.05, 0.05), breaks = c(-2.94,-1.94, -0.94, 0.06, 1.06, 2.06, 3.06), labels = c(0,1,2,3,4,5,6)) + theme_classic(base_size = 15) + theme( axis.title = element_text(colour = "black", size = 19, margin = margin(t = 0, r = 15, b = 0, l = 0)), axis.text.x  = element_text(colour = "black", size = 19, margin = margin(t = 15, r = 0, b = 0, l = 0)), axis.text.y  = element_text(colour = "black", size = 19), legend.position = c(0.7,0.85), legend.title = element_text(size = 17), legend.text = element_text(size = 17), legend.key.width = unit(1,"cm") ) + theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(), panel.background = element_blank())
File: get_gazeshift_latency.R

Comment: get diffs  get rownumbers in order to get the corresponding RecordingTime
Category: Data Variable
Code:
rownums_parent <- fi_pairs$fiend[latencies[[curr_colname]][[curr_hitname]]$fi_pairs[[1]]] rownums_successor <- fi_pairs$fistart[latencies[[curr_colname]][[curr_hitname]]$fi_pairs[[2]]]
File: Script.R

Comment: Funnel plot  carry out trimandfill analysis
Category: Visualization
Code:
taf<-trimfill(m.random,main="", ma.fixed = FALSE, fixed = FALSE, random = TRUE, label=F)

Comment: draw funnel plot with missing studies filled in
Category: Visualization
Code:
funnel(taf, legend=TRUE) summary(trimfill(m.random))
File: analyse_final_Exp5_OSF.R

Comment: create container variable to store results
Category: Data Variable
Code:
if(exists("data.full") == 0){ subject <- c(1:50) mean.3SD <- NA sd.3SD <- NA min.3SD <- NA max.3SD <- NA container.3SD <- data.frame(subject, mean.3SD, sd.3SD, min.3SD, max.3SD) } container.3SD$mean.3SD[i] <- mean(data.3SD$rt) container.3SD$sd.3SD[i] <- sd(data.3SD$rt) container.3SD$min.3SD[i] <- container.3SD$mean.3SD[i] - 3*container.3SD$sd.3SD[i] container.3SD$max.3SD[i] <- container.3SD$mean.3SD[i] + 3*container.3SD$sd.3SD[i]
File: analysis.R

Comment: setting up colors and line types for plots
Category: Visualization
Code:
ns=unique(qms$name) nl=length(ns) disp=data.frame(name=ns,lty=rep(1:9,nl)[1:nl]) disp$col=ifelse(grepl('Hit|Rod',disp$name),'#880101','#aaaaaa') disp$lty[grepl('Hit|Rod',disp$name)]=1:2
File: Malawi_ordination.R

Comment: plot the results of the vector fits  color ages > 85 in red
Category: Visualization
Code:
col <- c("gray", "red")[1 + (age >= 85)] main <- "PCoA of Pollen: pollen and independent vectors fitted onto ordination" plot(poln.ord$points, pch = 21, type = "p", xlab = paste0("PCoA I (", round(var.expl[1] * 100, 1), "%)"), ylab = paste0("PCoA II (", round(var.expl[2] * 100, 1), "%)"), main = main, col = "black", bg = col, cex = 1.5, xaxt = "n", yaxt = "n", bty = "n") axis(1, at = seq(-0.5, 1, by = 0.25)) axis(2, at = seq(-1, 0.25, by = 0.25)) legend(0.5, -0.85, pch = c(21, 21, NA), lty = c(NA, NA, 1), lwd = c(NA, NA, 2), col = c("black", "black", "light blue"), pt.bg =  c("gray","red", NA), cex = 1.25, legend = c("Post 85k", "Pre 85k", "Lake Level"))
File: 01_tables_1_2.r

Comment: create categorical variables
Category: Data Variable
Code:
share <- to_factor( share, select = c("health_past3months", "wave", "gender", "covid_affected", "partnerinhh", "covid_regime_si3", "covid_regime_ch3") ) share$stringency_index <- share$global_covid_regime_si3

Comment: Overall mean of Social factors
Category: Data Variable
Code:
share_all <- data_filter(share, !is.na(health_past3months))
File: modelComparison.R

Comment:  Model comparison   apply hierarchical versions of CC, EWA, LMM, and motivational EWA models 
Category: Statistical Modeling
Code:
setwd("SET TO MODEL FILE DIRECTORY") data <- list("groupSize", "ngroups", "ntrials", "ntokens", "pi", "vals","c","Gc","c_choice_index","Ga") #data inputted into jags params <- c("mu_c") #parameters we'll track in jags samplesCC <- jags(data, inits=NULL, params, model.file ="CC_group.txt", n.chains=3, n.iter=5000, n.burnin=1000, n.thin=1) params <- c("mu_c") #parameters we'll track in jags samplesEWA <- jags(data, inits=NULL, params, model.file ="EWA_group.txt", n.chains=3, n.iter=5000, n.burnin=1000, n.thin=1) params <- c("nu_c") #parameters we'll track in jags samplesLMM <- jags(data, inits=NULL, params, model.file ="LMM_group.txt", n.chains=3, n.iter=5000, n.burnin=1000, n.thin=1)
File: Data.Cluster.VAR.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)) }}}

Comment: Create variable subjno  Scramble data so people appear unordered in the final dataset
Category: Data Variable
Code:
ID = expand.grid(1:T,1:N)[,2] data = cbind(data,ID) p = ncol(Psi[[1]]) Y = matrix(0,nrow(data),p) colnames(Y) = sprintf("Y%d",seq(1:p))
File: redraw_figures.R

Comment: Frequency plot
Category: Visualization
Code:
top.freqs = sort(colSums(data.table), decreasing = T)[1:40] cex.val = 1.6 cairo_pdf('pdfs/top_freq_segments.pdf', width = 16, height = 10) par(family = "Doulos SIL") plot(top.freqs ~ seq_along(top.freqs), xlab = 'Frequency rank', ylab = 'Frequency', xlim = c(1, 40), type = 'n', xaxt = 'n', cex.lab = cex.val, cex.axis = cex.val) axis(1, at = seq_along(top.freqs), labels = seq_along(top.freqs), cex.axis = 1.1) lines(seq_along(top.freqs), top.freqs, lty = 2, col = 'grey') text(seq_along(top.freqs), top.freqs, labels = names(top.freqs), cex = 2) dev.off()
File: 01_data_prepare.R

Comment: Contrast between countries as a new variable
Category: Data Variable
Code:
d$CountC<-as.numeric(as.integer(as.factor(d$Country))-1.5) table(d$Country,d$CountC)
File: 04_figures_estimates_marginal_means.R

Comment: Estimated Marginal Means Model 3
Category: Statistical Modeling
Code:
m1 <- ggemmeans(model3, c("welle [1:4 by=.2]", "isced")) m2 <- ggemmeans(model3, c("welle [1:4 by=.2]", "aee_oecd_between_z2")) m3 <- ggemmeans(model3, c("welle [1:4 by=.2]", "lone6_between_z2")) m1$Model = "ISCED" levels(m1$group) <- c("low", "middle", "high") m2$Model = "Income" levels(m2$group) <- c("-1 SD", "Mean", "+1 SD") m3$Model = "Loneliness" levels(m3$group) <- c("-1 SD", "Mean", "+1 SD") create_plot(m1, title = "(a) PF and Education") create_plot(m2, title = "(b) PF and Income") create_plot(m3, title = "(c) PF and Loneliness")
File: Simulation-Random-Significance.r

Comment: Matrix with correlations and pvalues
Category: Data Variable
Code:
Cormatrix1 <- data.frame(matrix(NA,nrow = 15, ncol = 15)) for(i in 1:14){ for(j in (i+1):15){ Cormatrix1[i,j] <- round(cor(Cordata[,i], Cordata[,j]), digits=2) Cormatrix1[j,i] <- round(cor.test(Cordata[,i], Cordata[,j])$p.value, digits=2) } } Cormatrix1

Comment: Matrix with correlations and significance stars
Category: Visualization
Code:
Cormatrix2 <- data.frame(matrix(NA,nrow = 15, ncol = 15)) for(i in 1:14){ for(j in (i+1):15){ Cormatrix2[i,j] <- round(cor(Cordata[,i], Cordata[,j]), digits=2) Cormatrix2[j,i] <- ifelse(cor.test(Cordata[,i], Cordata[,j])$p.value<=0.05, "*", "no") } } Cormatrix2
File: Code_Simulation_Part_III_MVAR_RE.R

Comment: Generate Psi matrix for each cluster
Category: Data Variable
Code:
for (n in 1:length(N)){ for (t in 1:length(T)){ for (p in 1:length(P)){ for (k in 1:length(K)){ for (d in 1:length(diff)){ for (r in 1:R){ Psi.list = lapply(1:K[k], function(kl) Psi.Matrix.Diff(P[p],b.ar.min,b.ar.max,b.cr.min,b.cr.max,d))

Comment: Load training and testing set
Category: Data Variable
Code:
load(file = paste("Data_Block_Cluster_MVAR_RE_N_",N[n],"_T_",T[t],"_P_",P[p],"_K_",K[k], "_Diff_",diff[d],"_size_",size[s],"_R_",r,".RData",sep = "")) MSE.MVAR.PS.Sys = MSE.Sys(data.list,P[p]) save(MSE.MVAR.PS.Sys, file = paste("MSE_MVAR_Cluster_MVAR_RE_N_",N[n],"_T_",T[t],"_P_",P[p],"_K_",K[k], "_Diff_",diff[d],"_size_",size[s],"_R_",r,".RData",sep = ""))
File: VADIS_particles_InnerC-only.R

Comment:  standardize the model inputs, excluding the response and random effects 
Category: Statistical Modeling
Code:
d_std <- stand(d, cols = f2) # use the fitting function for convenience
File: Model_Correctness.R

Comment:  > Left panel: QQplot (uniform distribution)  > Right panel: Residuals against predicted values;; shaded (due to sample size) with extreme residuals colored red, and   3) MAIN EFFECTS OF KEY VARIABLES   FormatInfo 
Category: Visualization
Code:
emmip(CorResult, ~FormatInfo, type = "response", CIs = TRUE) (emm <- emmeans(CorResult, specs = ~FormatInfo, type = "response")) pairs(emm) EffPlotData_CorrFormat <- summary(emm)  ## Data for Fig. 3
File: DMS-NRSA-CA-QC-Figures.R

Comment: Rescale order of variables on yaxis (for BRT figures)
Category: Visualization
Code:
BRT.plot.label.limits <- c("site.centrality", "mean.annual.flow", "basin.area", "site.long", "site.lat", "pct.ISC", "pct.urb", "pct.ag", "pct.for", "ALG.cover", "NAT.cover", "LWD.reach", "DOC", "cond", "pH.lab", "total.P", "NH4", "NO3")

Comment: Rename variables names on yaxis (for BRT figures)
Category: Visualization
Code:
BRT.plot.labels <- c("site.centrality" = "Cent", "mean.annual.flow" = "Flow", "basin.area" = "Area", "site.long" = "Long", "site.lat" = "Lat", "pct.ISC" = "ISC", "pct.urb" = "Urb", "pct.ag" = "Ag", "pct.for" = "For", "ALG.cover" = "Alg", "NAT.cover" = "Nat", "LWD.reach" = "LWD", "DOC" = "DOC", "cond" = "Cond", "pH.lab" = "pH", "total.P" = "TP", "NH4" = expression(NH[4]), "NO3" = expression(NO[3]))
File: 02_analysis_single_estimate.R

Comment: Sample posetrior and prior for graphical comparison
Category: Visualization
Code:
post1<-extract.samples(m1) set.seed(42) prio1<-extract.prior(m1,n=10000) save.image(file="posterior_samples_single.RData")
File: Experiment4a-Analyses.R

Comment: correlation matrix for the DVs
Category: Statistical Modeling
Code:
judcorMat2 <- lowerCor(judgmentRatings2) corr.test(judgmentRatings2) corrplot(judcorMat2, method="color", type = 'lower',tl.col="black", addCoef.col = "black", tl.srt = 45)
File: PositivityratingsRscript.R

Comment: converting PPId and Statement to factors
Category: Data Variable
Code:
Data$PPID <- as.factor(Data$PPID) Data$Statement <-as.factor(Data$Statement)
File: Fisher_Z_3PERIODS_std.R

Comment: find Q1, Q3, and interquartile range for values in column A 
Category: Data Variable
Code:
Q1 <- quantile(DV2, .25) Q3 <- quantile(DV2, .75) IQR2 <- IQR(DV2)

Comment: only keep rows in dataframe that have values within 1.5*IQR of Q1 and Q3
Category: Data Variable
Code:
no_outliers2 <- subset(df, DV2> (Q1 - 1.5*IQR2) & DV2< (Q3 + 1.5*IQR2)) no_outliers3 <- subset(df, DV3> (Q1 - 1.5*IQR3) & DV3< (Q3 + 1.5*IQR3))
File: ESS_openess_2018_perCountry.R

Comment: Plot beta weights for interaction
Category: Visualization
Code:
betalms #  called "beta" but represents "b" betalms <- betalms[,1:2] names(betalms) <- c("b", "SE")

Comment: Plot beta weights for engagement
Category: Visualization
Code:
betalms_eng betalms_eng <- betalms_eng[,1:2] names(betalms_eng) <- c("b", "SE")

Comment: Arrange b coeff plots
Category: Visualization
Code:
grid.arrange(betalms_ope_p, betalms_eng_p, betalms_p, ncol = 3, nrow = 1)

Comment: Plot slopes
Category: Visualization
Code:
listofcharts = list() # create empty list for charts index = 0 # zero the index for (df in listofdfs) { index = index + 1 xlab_str = paste0("Economic beliefs in ", names(listofdfs)[index]) listofcharts[[index]] <- ggpredict(listoflms[[index]], terms = c("conservation2_s_c", "polit_eng_c[-0.14,0.14]"), type = "fe") %>% plot(colors = "bw") + ggtitle(names(listoflms[index])) + xlab("NSC") + ylab("Economic beliefs") + labs(linetype = "Political \nengagement") + scale_linetype_manual(values=c("solid", "dashed"), labels = c("Low", "High")) + theme_classic() + theme(legend.position = "none") +
File: Statistical_models_no_T3_criticals.R

Comment: Does the start model fit the data significantly better as compared to a model without random intercepts over items?
Category: Statistical Modeling
Code:
tic();; start_min_item_intercepts <- glmer(bin_score ~ input*testmoment*learningtype + (1|participant), family = 'binomial', data = data, control = glmerControl(optimizer = "bobyqa", optCtrl=list(maxfun=1e5)));; toc() anova(start_min_item_intercepts, start) # Start model is significantly better (p < .001);; AIC difference of +- 240

Comment: Random slope of input over item
Category: Data Variable
Code:
tic();; input_item <- glmer(bin_score ~ input*testmoment*learningtype + (1+input|item) + (1|participant), family = 'binomial', data = data, control = glmerControl(optimizer = "bobyqa", optCtrl=list(maxfun=1e5)));; toc() anova(start, input_item) # Significant improvement (p = .03);; small AIC difference (3). summary(rePCA(input_item)) # All dimensions are supported by the data. >> KEEP

Comment: Investigate model fit  Inspect residuals with a binned residual plot
Category: Visualization
Code:
residualsplot <- binnedplot(fitted(final), resid(final, type = "response"), cex.pts=1, col.int="black", xlab = "Estimated score (as probability)")
File: RScript_motives.R

Comment: comparisons to average for each trait
Category: Data Variable
Code:
summary(lmer(RATINGc ~ TSELFc* EX + SMEANc* EX + SDMEAN* EX +PSELFc* EX + (TSELFc + SMEANc + SDMEANc +PSELFc    | PID),data= subset(fmimlm, fmimlm$motive == 0 ) )) summary(lmer(RATINGc ~ TSELFc* OP + SMEANc* OP + SDMEAN* OP +PSELFc*OP+ (TSELFc + SMEANc + SDMEANc  +PSELFc   | PID),data= subset(fmimlm, fmimlm$motive == 0   ) )) summary(lmer(RATINGc ~ TSELFc* AG + SMEANc* AG + SDMEAN* AG +PSELFc*AG + (TSELFc + SMEANc + SDMEANc   +PSELFc  | PID),data= subset(fmimlm, fmimlm$motive == 0 ) )) summary(lmer(RATINGc ~ TSELFc* NE + SMEANc* NE + SDMEAN* NE +PSELFc*NE+ (TSELFc + SMEANc + SDMEANc  +PSELFc   | PID),data= subset(fmimlm, fmimlm$motive == 0  ) )) summary(lmer(RATINGc ~ TSELFc* CO + SMEANc* CO + SDMEAN* CO+PSELFc*CO+ (TSELFc + SMEANc + SDMEANc  +PSELFc   | PID), data= subset(fmimlm,fmimlm$motive == 0  ) ))
File: example_Rcode_mlrsa_osf_oneL1pred.R

Comment: Conduct RSA  We want to estimate the RSA model in which the intercept is allowed to vary across states.  The equation for individual i living in state j (z  selfesteem, x  IV, y  SV) is:  zij  b0 + b1*xij + b2*yj + b3*xij^2 + b4*xij*yj + b5*yj^2 + uj + eij  specify and estimate this model: 
Category: Statistical Modeling
Code:
m.c <- lmer(selfesteem ~ IV.c + SV.c + IV2.c + IVSV.c + SV2.c + (1 | state), data = df) summary(m.c)

Comment: Plot the average surface using MLRSA_AverageSurfacePlot:
Category: Visualization
Code:
MLRSA_AverageSurfacePlot(m.c, name_vars=c("IV.c","SV.c","IV2.c","IVSV.c","SV2.c"), outcome="selfesteem", data=df, xlab="Individual-level values", ylab="State-level values", zlab="Self-esteem")
File: preprocess_SHCS.R

Comment: only keeping latest reported dates for each patient
Category: Data Variable
Code:
data_lab_res_dcr <- data_lab[!duplicated(data_lab$shcsid,fromLast=TRUE),] data_drug_res_dcr <- data_drug[!duplicated(data_drug$shcsid,fromLast=TRUE),] data_dis_res_dcr <- data_dis[order(data_dis$shcsid,data_dis$newdate),] data_dis_res_dcr <- data_dis_res_dcr[!duplicated(data_dis_res_dcr$shcsid,fromLast=TRUE),]