drndr/statcodesearch huggingface dataset:
File: RAQ-R_Analyses.R

Comment:  calculating r for each iteration, r as the mean of those five r  RAQ_R and QoL 
Category: Data Variable
Code:
r_QoL <- (with(subsample_PG, cor(RAQ_Totalscore[.imp==1 & Sample==1], QoL[.imp==1 & Sample==1]))+ with(subsample_PG, cor(RAQ_Totalscore[.imp==2 & Sample==1], QoL[.imp==2 & Sample==1]))+ with(subsample_PG, cor(RAQ_Totalscore[.imp==3 & Sample==1], QoL[.imp==3 & Sample==1]))+ with(subsample_PG, cor(RAQ_Totalscore[.imp==4 & Sample==1], QoL[.imp==4 & Sample==1]))+ with(subsample_PG, cor(RAQ_Totalscore[.imp==5 & Sample==1], QoL[.imp==5 & Sample==1])))/5 p_QoL <- pt((r_QoL*sqrt(nrow(subsample_PG)/6-2)/sqrt(1-r_QoL)), nrow(subsample_PG)/6-2)

Comment: scaling RAQR Score
Category: Data Variable
Code:
reg_with_PG_CG_scaled <- with(data=as.mids(reg_PG_CG), exp=lm(scale(RAQ_Totalscore)~Sample+Gender+Age_groups+Level_of_education)) str(summary(pool(reg_with_PG_CG_scaled))) pooled_reg_PG_CG_scaled <- summary(pool(reg_with_PG_CG_scaled)) pooled_reg_PG_CG_scaled$p.value pooled_reg_PG_CG_scaled$estimate

Comment: regression for each iteration in order to check diagnostic plots  look for differences between the adjusted Rsquared of the five iterations
Category: Statistical Modeling
Code:
reg_PG_CG_1 <- reg_PG_CG[reg_PG_CG$.imp == 1, ] summary(lm(data=reg_PG_CG_1, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_1 <- with(data=reg_PG_CG_1, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_1) reg_PG_CG_2 <- reg_PG_CG[reg_PG_CG$.imp == 2, ] summary(lm(data=reg_PG_CG_2, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_2 <- with(data=reg_PG_CG_2, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_2) reg_PG_CG_3 <- reg_PG_CG[reg_PG_CG$.imp == 3, ] summary(lm(data=reg_PG_CG_3, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_3 <- with(data=reg_PG_CG_3, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_3) reg_PG_CG_4 <- reg_PG_CG[reg_PG_CG$.imp == 4, ] summary(lm(data=reg_PG_CG_4, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_4 <- with(data=reg_PG_CG_4, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_4) reg_PG_CG_5 <- reg_PG_CG[reg_PG_CG$.imp == 5, ] summary(lm(data=reg_PG_CG_5, RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) reg_with_PG_CG_5 <- with(data=reg_PG_CG_5, exp=lm(RAQ_Totalscore~Sample+Gender+Age_groups+Level_of_education)) plot(reg_with_PG_CG_5)

Comment:  calculating the mean of the five residual standard errors, R squared, adjusted Rsquared and F statistic 
Category: Statistical Test
Code:
Residual_standard_error_reg_PG <- (10.35+10.45+10.16+10.29+10.28)/5 R_squared_reg_PG <- (0.639+0.630+0.652+0.642+0.642)/5 R_squared_adjusted_reg_PG <-(0.6267+0.6175+0.6403+0.6301+0.6298)/5 F_statistic_reg_PG <- (53.04+51.05+56.18+53.81+53.73)/5
File: Criticism-Attachment-RCode_v2.R

Comment: Graph the correlation between secure attachment and visual cortex response
Category: Visualization
Code:
ggplot(mydata, aes(SECURE.ATTACHMENT, LINGUAL.GYRUS..VISUAL.CORTEX.), scale="globalminmax") + geom_smooth(method = "lm", fill = "green", alpha = 0.6)+ geom_point(size =5 ) + theme_minimal()+ theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))+ labs(title = "Visual Cortex & Secure Attachment", x = "Secure Attachment", y = "Lingual Gyrus Activation") scale_x_continuous(limits = c(1,5), breaks = c(1,2,3,4,5))

Comment: Graph the correlation between avoidant attachment and visual cortex response
Category: Visualization
Code:
ggplot(mydata, aes(AVOIDANT.ATTACHMENT, LINGUAL.GYRUS..VISUAL.CORTEX.), scale="globalminmax") + geom_smooth(method = "lm", fill = "red")+ geom_point(size = 5) + theme_minimal()+ theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black"))+ labs(title = "Visual Cortex & Avoidant Attachment", x = "Avoidant Attachment", y = "Lingual Gyrus Activation")+ scale_x_continuous(limits = c(1,5), breaks = c(1,2,3,4,5))

Comment:  Graph the interaction plot of amygdala and visual cortex activation, with AVOIDANT attachment as the moderator. 
Category: Visualization
Code:
p1 = interact_plot(fiti, pred = AMYGDALA, modx = AVOIDANT.ATTACHMENT,robust = FALSE, x.label = "Amygdala", y.label = "LG Visual Cortex", main.title = "Avoidant Attachment",  legend.main = "Avoidant Levels", colors = "red",interval = TRUE, int.width = 0.8)+ theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black")) p1

Comment:  Graph the interaction plot of amygdala and visual cortex activation, with SECURE attachment as the moderator. 
Category: Visualization
Code:
p2 = interact_plot(fiti2, pred = AMYGDALA, modx = SECURE.ATTACHMENT,robust = FALSE, x.label = "Amygdala", y.label = "LG Visual Cortex", main.title = "Secure Attachment",  legend.main = "Secure Levels", colors = "green",interval = TRUE, int.width = 0.8)+ theme_bw() + theme(panel.border = element_blank(), panel.grid.major = element_blank(),panel.grid.minor = element_blank(), axis.line = element_line(colour = "black")) p2
File: CI.helpers.R

Comment: Returns the ratio between the geometric means of two independent samples and its  95% BCa bootstrap CI.
Category: Statistical Test
Code:
ratioGeomMeanCI.bootstrap <- function(group1, group2) { group1 <- log(group1) group2 <- log(group2) samplemean <- function(x, d) {return(mean(x[d]))} pointEstimate <- samplemean(group1) - samplemean(group2) set.seed(0) # make deterministic bootstrap_samples <- two.boot(sample1 = group1, sample2 = group2, FUN = samplemean, R = 5000) bootci <- boot.ci(bootstrap_samples, type = "bca", conf = conf.level) exp(c(pointEstimate,  bootci$bca[4], bootci$bca[5])) }

Comment: Returns the 95% confidence interval of a single proportion using the Wilson score interval.
Category: Statistical Modeling
Code:
propCI <- function(numberOfSuccesses, sampleSize) { CI <- scoreci(x = numberOfSuccesses, n = sampleSize, conf.level = conf.level) c(numberOfSuccesses/sampleSize, CI$conf.int[1], CI$conf.int[2]) }

Comment: Returns the difference between two linear regression slopes and its 95% BCa bootstrap CI.
Category: Statistical Modeling
Code:
diff.slopes.bootstrap <- function(x1, y1, x2, y2) { groups <- c(rep(1, length(x1)), rep(2, length(y1)), rep(3, length(x2)), rep(4, length(y2))) data <- data.frame(obs = c(x1, y1, x2, y2), group = groups) diffslope <- function(d, i) { db <- d[i,] x1 <- db[db$group==1,]$obs y1 <- db[db$group==2,]$obs x2 <- db[db$group==3,]$obs y2 <- db[db$group==4,]$obs fit1 <- lm(y1 ~ x1) a1 <- fit1$coefficients[[2]] fit2 <- lm(y2 ~ x2) a2 <- fit2$coefficients[[2]] a2 - a1 } a1 <- lm(y1 ~ x1)$coefficients[[2]] a2 <- lm(y2 ~ x2)$coefficients[[2]] pointEstimate <- a2 - a1 set.seed(0) # make deterministic bootstrap_samples <- boot(data = data, statistic = diffslope, stype = "i", strata = data$group, R = 5000) bootci <- boot.ci(bootstrap_samples, type = "bca") c(pointEstimate, bootci$bca[4], bootci$bca[5]) }
File: DivNorm_R_EyeTrack.R

Comment: replace current subjects "fixdata" by fixation_info 
Category: Data Variable
Code:
if (any(S==replace_eye)){ fixdata[[S]] <- data.frame(fixation_info) colnames(fixdata[[S]]) <- c("Event.Start.Raw.Time..ms.","Event.End.Raw.Time..ms.","Event.Duration.Trial.Time..ms.", "Fixation.Position.X..px.","Fixation.Position.Y..px.","AOI.Name","intrialonset","trialnr") } }
File: MsReviewsAnalysisScript.R

Comment: Mean Differences Comparing signed and unsigned reviews on four aspects For each, first ttest then violin plot Paneled plot created at end of series Testing word count 
Category: Statistical Test
Code:
t.test(revdat$wc ~ revdat$signed) wc_sign <- ggplot(revdat, aes(signed, wc, fill=signed)) + geom_violin( trim = FALSE, draw_quantiles = c(0.25, 0.5, 0.75), alpha = 0.5) + geom_jitter( width = 0.20, height = 0, alpha = 0.5, size = 1) + xlab("Signed Reviews") + ylab("Word Count")

Comment: Correlations Examining correlations between time and aspects of reviews For each, first compute r and then scatter plot Plots also mark whether or not review was signed Paneled plot created at end of series 
Category: Visualization
Code:
cor.test(revdat$order, revdat$wc) wc_time <- ggplot(revdat, aes(order, wc, color=signed)) + geom_point(size=1)+ xlab("Time") + ylab("Word Count") cor.test(revdat$order, revdat$posemo) pos_time <- ggplot(revdat, aes(order, posemo, color=signed)) + geom_point(size=1) + xlab("Time") + ylab("Positive Emotion Words") cor.test(revdat$order, revdat$negemo) neg_time <- ggplot(revdat, aes(order, negemo, color=signed)) + geom_point(size=1) + xlab("Time") + ylab("Negative Emotion Words") cor.test(revdat$order, revdat$cogmech) cog_time <- ggplot(revdat, aes(order, cogmech, color=signed)) + geom_point(size=1) + xlab("Time") + ylab("Cognitive Mechanism Words")
File: lewis-acid-base-researchers.R

Comment: removes nonalphanumeric characters
Category: Data Variable
Code:
full.data <- multigsub("[^[:alnum]]", " ", full.data, fixed = TRUE) train.data <- multigsub("[^[:alnum]]", " ", train.data, fixed = TRUE) valid.data <- multigsub("[^[:alnum]]", " ", valid.data, fixed = TRUE)

Comment: removes leading & trailing whitespaces
Category: Data Variable
Code:
full.data <- trimws(full.data) train.data <- trimws(train.data) valid.data <- trimws(valid.data)
File: 01_data-preparation-variable-setup.R

Comment:  As this may be problematic for later analyses, we transform urbanity into its log: 
Category: Data Variable
Code:
dslong %<>% mutate(urbanity_log = log(urbanity))
File: multiplicationFactor_ttest.R

Comment: calculate Bayes factors for difference using logspline fit
Category: Statistical Modeling
Code:
prior <- dnorm(0,1) fit.posterior <- logspline(samples$BUGSoutput$sims.list$mu_alpha) posterior <- dlogspline(0, fit.posterior) # this gives the pdf at point delta = 0 prior/posterior
File: BeerGogglesorLiquidCouragePPARatingAnalyses.R

Comment: use normal distribution to approximate pvalue
Category: Statistical Test
Code:
FullAim1aPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim1aPNcoefs$t.value))) FullAim1aPNcoefs effectsize::standardize_parameters(FullAim1aPN) FullAim1bPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim1bPNcoefs$t.value))) FullAim1bPNcoefs effectsize::standardize_parameters(FullAim1bPN) FullAim1cPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim1cPNcoefs$t.value))) FullAim1cPNcoefs effectsize::standardize_parameters(FullAim1cPN) FullAim2aPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim2aPNcoefs$t.value))) FullAim2aPNcoefs effectsize::standardize_parameters(FullAim2aPN) FullAim2bPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim2bPNcoefs$t.value))) FullAim2bPNcoefs effectsize::standardize_parameters(FullAim2bPN) FullAim3PNPPcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim3PNPPcoefs$t.value))) FullAim3PNPPcoefs effectsize::standardize_parameters(FullAim3PNPP) FullAim4aPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim4aPNcoefs$t.value))) FullAim4aPNcoefs effectsize::standardize_parameters(FullAim4aPN) FullAim4bPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim4bPNcoefs$t.value))) FullAim4bPNcoefs effectsize::standardize_parameters(FullAim4bPN) FullAim5bPosPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim5bPosPNcoefs$t.value))) FullAim5bPosPNcoefs effectsize::standardize_parameters(FullAim5bPosPN) FullAim5bNegPNcoefs$p.z <- 2 * (1 - pnorm(abs(FullAim5bNegPNcoefs$t.value))) FullAim5bNegPNcoefs effectsize::standardize_parameters(FullAim5bNegPN)
File: utils_surv.R

Comment: this function give the integral of the survival curve given by S.hat ont the time.grid: Y.grid
Category: Statistical Modeling
Code:
expected_survival <- function(S.hat, Y.grid) { grid.diff <- diff(c(0, Y.grid, max(Y.grid))) c(base::cbind(1, S.hat) %*% grid.diff) } threshol_list <- function(l,threshold){ l_threshold = c() for (x in (l)){ if (is.na(x)){ return(NA) } else{ if (x < - threshold){ l_threshold <- c(l_threshold,- threshold) } else{ if(x > threshold){ l_threshold <- c(l_threshold,threshold) } else{ l_threshold <- c(l_threshold, x) } } } } return(l_threshold) }
File: 8RememberingAdvocacy_Spanish.R

Comment: stacked graph regarding how participants came to see each advocacy type
Category: Visualization
Code:
ggplot(detected_advocacy, aes(x = Advocacy, y = Percentage, fill = Response, label = Percentage)) + geom_bar(position ="stack", stat="identity") + coord_flip(ylim=c(0,100)) + scale_y_continuous(labels = scales::percent_format(scale = 1)) + geom_text(aes(label = Percentage), size = 3, position = position_stack(vjust = 0.5) ) + labs(y= "Porcentaje de Participantes", x = "Tipo de Defensa") + theme(text = element_text(family = "Arial", size = 14), panel.background = element_rect("white"), panel.border = element_rect(fill = NA), panel.grid.major.x = element_line(colour = "grey"), axis.title.x = element_text(color = "#39363D", size = 14, hjust=0.5), axis.title.y = element_text(color = "#39363D", size = 14), legend.position="bottom", legend.text = element_text(size = 12), legend.title = element_blank())
File: Reproducible_Simulations_line_plots.R

Comment: Define adjustment to calculate Hedge's g. To calculate Cohen's d set J < 1. Remember to change the true.ratio value of J as well.
Category: Statistical Test
Code:
J <-   j <- 1 - 3/(4*(n + m - 2) - 1) G <- J*SMD sds <- sqrt((n + m)/(n*m) + SMD^2/2/(n + m)) V <- (J^2)*(sds^2) w <- 1/V if(method == "REML"){r.model <- rma(yi = G, vi = V,method = method, control=list(stepadj=0.5, maxiter=10000000000000000000000000))} else{ r.model <- rma(yi = G, vi = V,method = method) } fit.model <- rma(yi = G, vi = V, method = "FE") ratio <- abs(r.model$ci.ub - r.model$ci.lb)/abs(fit.model$ci.ub - fit.model$ci.lb) log.ratio <- log(ratio) w.star <- 1/(V + r.model$tau2) log.var <- ((r.model$se.tau2)^2)/4*1/(sum(w.star))^2*(sum(w.star^2))^2 log.sd <- sqrt(log.var) bias <- 1/2*(r.model$se.tau2)^2*(1/2/sum(w.star)^2 - 1/sum(w.star)*sum(w.star^3))
File: CFA script.R

Comment: Generate parcellated data and do CFA   generate parcellated datasets  must specify data and the number of allocations (nAlloc)
Category: Data Variable
Code:
list1=parcelAllocation(mod.par, data=usm, par.names, mod.items, nAlloc=2, do.fit=F, std.lv=T)

Comment:  Multifit() conducts a CFA for each data.frame in a list (saved from parcelAllocation) and returns all of the results of interest on one row per data.frame  The results consist of 21 columns with fit measures ("npar", "chisq", "df", "pvalue", "cfi", "tli", "rmsea", "rmsea.pvalue", "srmr") followed by the latent r between scales ("IA_NFC", "IA_URS", etc.)  WARNING: running each CFA takes roughly 20 seconds (Intel i58350U CPU), so running it for 200 data.frames should take 11.5 hours. 
Category: Statistical Modeling
Code:
multifit=function(data) { rows=c(131:136) # rows indexing the parameter estimates of interest (correlations among general factors) names=c("npar", "chisq", "df", "pvalue", "cfi", "tli", "rmsea", "rmsea.pvalue", "srmr", "IA_NFC", "IA_IU", "IA_URS", "NFC_IU", "NFC_URS", "IU_URS", "IA_NFC_se", "IA_IU_se", "IA_URS_se", "NFC_IU_se", "NFC_URS_se", "IU_URS_se") results=sapply(data, function(x){ output=cfa(data=x, model=mod.par, std.lv=T) # save CFA output est=as.matrix(out@ParTable[["est"]][rows]) # save the parameter estimates of interest se=as.matrix(out@ParTable[["se"]][rows]) fit=as.matrix(fitMeasures(output)[c(1,3,4,5,9,10,23,26,29)]) # save fit measures of interest bind=round(do.call("rbind", (list(fit,est,se))),3) # bind the data }) results.t=t(results) # transpose the matrix colnames(results.t)=names # name columns results.t }
File: BaIn_ANOVAinR.R

Comment: Display raincloud plot
Category: Visualization
Code:
ggplot(dataset_anova, aes(session, score, fill = group)) + geom_rain(alpha = .5, cov = "group", rain.side = 'f2x2') + theme(text=element_text(size=20))

Comment: Create a covariance matrix of the means in the placebo group
Category: Statistical Modeling
Code:
cov_group1 = matrix(c(vcov(cov_fit)[1,1],vcov(cov_fit)[1,3],vcov(cov_fit)[3,1], vcov(cov_fit)[3,3]),2,2)

Comment: Create a covariance matrix of the means in the treatment group
Category: Statistical Modeling
Code:
cov_group2 = matrix(c(vcov(cov_fit)[2,2],vcov(cov_fit)[2,4],vcov(cov_fit)[4,2], vcov(cov_fit)[4,4]),2,2)
File: Model figures.R

Comment: Contrasting Two vs Fourstakes paradigms Decision generates table of beta coefficients and associated statistics
Category: Statistical Modeling
Code:
coef.stakes_decision <- data.frame(cbind(summary(m.stakes_decision)$coefficients, m.stakes_decision.CI)) %>% tibble::rownames_to_column('Variable') %>% rename(SE = Std..Error) %>% rename(Z = z.value) %>% rename(P = Pr...z..) %>% rename(CI_L = X2.5..) %>% rename(CI_U = X97.5..) %>% mutate(Variable = factor(Variable, levels = c('fairnessunfair:recodedDecisionreject:stakes4', 'recodedDecisionreject:stakes4', 'fairnessunfair:stakes4', 'fairnessunfair:recodedDecisionreject', 'stakes4', 'recodedDecisionreject', 'fairnessunfair', 'genderfemale', 'centredAge', '(Intercept)' )))
File: P3_analysis.R

Comment: Calculating the conditional entropy of denomination given designs by authorities separately for each df HIGHER/LOWER Higher denominations
Category: Statistical Modeling
Code:
authority <- sort(unique(higher$AUTHORITY)) CEDenomination.Designs <- c() HDenominations <- c() NormCEDenomination.Designs <- c() Ncoins <- c() AUTHORITY <- c() for(i in authority){ high_sub <- subset(higher, higher$AUTHORITY == i) denom_high <- as.data.frame(high_sub[,256:309]) motifs_high <- as.data.frame(high_sub[,318:681]) AUTHORITY[i] <- i CEDenomination.Designs[i] <- condentropy(denom_high, motifs_high) HDenominations[i] <- entropy(denom_high) NormCEDenomination.Designs[i] <- condentropy(denom_high, motifs_high) / entropy(denom_high) Ncoins[i] <- nrow(high_sub) } results_higher <- data.frame("AUTHORITY" = AUTHORITY, "CEDenomination.Designs" = CEDenomination.Designs, "Entropy.Denominations" = HDenominations, "NormCEDenomination.Designs" = NormCEDenomination.Designs, "Ncoins" = Ncoins) write.csv2(results_higher,"P3test_byauth_higher.csv")
File: PrefLook_functions.r

Comment: destructure string into an array using "_" as the delimiter
Category: Data Variable
Code:
stringArr <- unlist(strsplit(as.character(string), split = "_", fixed = T))
File: ScenePrimingCFS_Analysis.R

Comment: log transform RTs for statistical analysis
Category: Data Variable
Code:
RTdata$logRT <- log10(RTdata$rt) hist(RTdata$logRT)

Comment: fit a lienar mixed effects model with all theoretically relevant fixed effects and random intercepts for participant and target context
Category: Statistical Modeling
Code:
modelRT <- mixed(logRT ~ congruency*soa*mask_contrast + (1| participant) + (1|target_context), data = RTdata, method = "S", type=3) modelRT

Comment: pearon correlations within each of these four conditions
Category: Statistical Test
Code:
ca_subset <- CA %>% filter(soa == "200 ms" & mc == "100% contrast") cor.test(ca_subset$PC, ca_subset$CE) ca_subset <- CA %>% filter(soa == "400 ms" & mc == "100% contrast") cor.test(ca_subset$PC, ca_subset$CE) ca_subset <- CA %>% filter(soa == "200 ms" & mc == "20% contrast") cor.test(ca_subset$PC, ca_subset$CE) ca_subset <- CA %>% filter(soa == "400 ms" & mc == "20% contrast") cor.test(ca_subset$PC, ca_subset$CE)

Comment: descriptive statistics of accuracy / errors
Category: Data Variable
Code:
er_desc <- data_er %>% group_by(participant) %>% summarize(n_correct = sum(acc), n_trials = length(participant))

Comment: fit a GLMM model with all theoretically relevant fixed effects
Category: Statistical Modeling
Code:
modelER <- mixed(acc ~ congruency*soa*mask_contrast + (1| participant) + (1|target_context), family = binomial("logit"), data = data_er, method = "LRT", type =3) summary(modelER) anova(modelER)

Comment: fit a GLMM model with all theoretically relevant effects
Category: Statistical Modeling
Code:
modelER <- mixed(acc ~ soa*mask_contrast + (1| participant) + (1|prime_context), family = binomial("logit"), data = acc_data, method = "LRT", type=3) modelER
File: analysis_fullset.R

Comment: calculate overall proportion
Category: Data Variable
Code:
prop_overall := N / sum(N)]
File: risk_factors_monthly.R

Comment: creating variables for lagged values and moving averages
Category: Data Variable
Code:
delay_rf <- function(v,lag) c(rep(NA,lag),v[1:(length(v)-lag)]) moving_avg <- function(x,n) c(stats::filter(x,rep(1/n,n),sides=1)) res <- lapply(res,transform,cd4Rcd8=cd4/cd8) res <- lapply(res,transform,cd4_ma12=moving_avg(cd4,12),cd8_ma12=moving_avg(cd8,12),cd4Rcd8_ma12=moving_avg(cd4Rcd8,12),cd4_ma24=moving_avg(cd4,24),cd8_ma24=moving_avg(cd8,24),cd4Rcd8_ma24=moving_avg(cd4Rcd8,24), rna_ma12=moving_avg(rna,12),rna_ma24=moving_avg(rna,24)) res <- lapply(res,transform,cd4_lag12=delay_rf(cd4,12),cd4_lag24=delay_rf(cd4,24),cd4_lag36=delay_rf(cd4,36), cd8_lag12=delay_rf(cd8,12),cd8_lag24=delay_rf(cd8,24),cd8_lag36=delay_rf(cd8,36), cd4Rcd8_lag12=delay_rf(cd4Rcd8,12),cd4Rcd8_lag24=delay_rf(cd4Rcd8,24),cd4Rcd8_lag36=delay_rf(cd4Rcd8,36), rna_lag12=delay_rf(rna,12),rna_lag24=delay_rf(rna,24),rna_lag36=delay_rf(rna,36), cd4_ma12_lag12=delay_rf(cd4_ma12,12),cd4_ma24_lag12=delay_rf(cd4_ma24,12),cd4_ma12_lag24=delay_rf(cd4_ma12,24), cd8_ma12_lag12=delay_rf(cd8_ma12,12),cd8_ma24_lag12=delay_rf(cd8_ma24,12),cd8_ma12_lag24=delay_rf(cd8_ma12,24), cd4Rcd8_ma12_lag12=delay_rf(cd4Rcd8_ma12,12),cd4Rcd8_ma24_lag12=delay_rf(cd4Rcd8_ma24,12),cd4Rcd8_ma12_lag24=delay_rf(cd4Rcd8_ma12,24), rna_ma12_lag12=delay_rf(rna_ma12,12),rna_ma24_lag12=delay_rf(rna_ma24,12),rna_ma12_lag24=delay_rf(rna_ma12,24)) res <- lapply(res,transform,haart_lag6=delay_rf(haart,6),haart_lag12=delay_rf(haart,12),hepC_aHCVpos_lag12=delay_rf(hepC_aHCVpos,12),hepC_RNApos_lag12=delay_rf(hepC_RNApos,12), hepC_RNAdet_lag12=delay_rf(hepC_RNAdet,12),hepB_pos_lag12=delay_rf(hepB_pos,12),CDC_lag12_cat=delay_rf(CDC_cat,12),bpn_lag12=delay_rf(bpn,12)) res_df <- rbind.fill(res) res_df$CDC_lag12_cat[res_df$CDC_lag12_cat==1] <- "A" res_df$CDC_lag12_cat[res_df$CDC_lag12_cat==2] <- "B" res_df$CDC_lag12_cat[res_df$CDC_lag12_cat==3] <- "C" res_df$CDC_lag12_cat <- factor(res_df$CDC_lag12_cat,levels=c("A","B","C")) res_df$hepC_aHCVpos_lag12[is.na(res_df$hepC_aHCVpos_lag12)] <- FALSE res_df$hepC_RNApos_lag12[is.na(res_df$hepC_RNApos_lag12)] <- FALSE res_df$hepC_RNAdet_lag12[is.na(res_df$hepC_RNAdet_lag12)] <- FALSE res_df <- transform(res_df,hepC_RNA=(hepC_RNApos | hepC_RNAdet),hepC_RNA_lag12=(hepC_RNApos_lag12 | hepC_RNAdet_lag12)) res_df$bpn_lag12[is.na(res_df$bpn_lag12)] <- FALSE rownames(res_df) <- NULL if(write_df) save(res_df,file=paste(filepath_read_R,"\\monthly_rf_df_",max_dist,".RData",sep='')) print(proc.time()-ptm)