drndr/statcodesearch huggingface dataset:
File: Witt_SDT_Simulations_OptionalStopping.R

Comment: Plot ROC curves and caculate AUC (if desired)
Category: Visualization
Code:
plotIt <- FALSE currAUC <- plotAUC(allPs,allBFs,dt,numStudies,plotIt)  #currently does not save the AUCs ai <- ai+1 aucs[ai,1] <- sampleSizes[1] aucs[ai,2] <- effectSizes[2] aucs[ai,3] <- i #runNumber aucs[ai,4] <- currAUC[1] aucs[ai,5] <- currAUC[2] plotIt <- FALSE currAUC <- plotAUC(allPs2,allBFs2,dt,numStudies,plotIt)  #currently does not save the AUCs aucs$aucPhacked[ai] <- currAUC[1] aucs$aucBFhacked[ai] <- currAUC[2] if (currAUC[1] != currAUC[2]) { print(paste(effectSizes,i)) print(currAUC) } } #end for i runTimes } #end for ssa allDt <- allDt[-1,]  #get rid of initial dummy row that was just used to init allDt

Comment:  Stacked plots by SDT outcome   Plot by whether hacked or not plot hit, FA, miss, corrRejection for each effect size/sample size combo 
Category: Visualization
Code:
ap <- aggregate(hits ~ criterion+sampleSize+effectSizes+withHack, data=allDt,mean) ap2 <- aggregate(fa ~ criterion+sampleSize+effectSizes+withHack, data=allDt,mean) hFA <- merge(ap,ap2,by=c("criterion","sampleSize","effectSizes","withHack")) ap2 <- aggregate(miss ~ criterion+sampleSize+effectSizes+withHack, data=allDt,mean) hFA <- merge(hFA,ap2,by=c("criterion","sampleSize","effectSizes","withHack")) ap2 <- aggregate(corrRej ~ criterion+sampleSize+effectSizes+withHack, data=allDt,mean) hFA <- merge(hFA,ap2,by=c("criterion","sampleSize","effectSizes","withHack")) hFA$hits <- hFA$hits / numStudies hFA$fa <- hFA$fa / numStudies hFA$corrRej <- hFA$corrRej / numStudies hFA$miss <- hFA$miss / numStudies

Comment: plot BF vs pvalues
Category: Visualization
Code:
plot(log(allPs),log(allBFs),bty="l")
File: ppfs.R

Comment: Create matrix of input variables with populationlevel effects:
Category: Data Variable
Code:
C_datMM <- model.matrix( as.formula(paste("~", paste(vpreds_noInt, collapse = " + "))), data = C_dat )
File: 4H_PV_helper.R

Comment:  Set the latent regression coefficients for booklet 1, 5, 7 and 10 for reading and  booklet 4, 6, 9 and 11 for science to 0 
Category: Data Variable
Code:
betas <- data.frame(var = c(which(names(con_dat) %in% paste0("bookid.", c(1, 5, 7, 10))), which(names(con_dat) %in% paste0("bookid.", c(4, 6, 9, 11)))), dim = rep(2:3, each = 4), value = 0) betas <- data.frame(var = c(which(names(con_dat) %in% paste0("bookid.", c(1, 5, 7, 10))), which(names(con_dat) %in% paste0("bookid.", c(4, 6, 9, 11)))), dim = rep(2:3, each = 4), value = 0)

Comment: Compute latent regression of the latent ability on the conditioning  variables (excl. the first column which is the student ID)
Category: Statistical Modeling
Code:
latreg <- tam.latreg(likeli, Y = con_dat[, -1], pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay"), beta.fixed = as.matrix(betas)) } else { latreg <- tam.latreg(likeli, Y = con_dat[, -1], pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay")) } latreg <- tam.latreg(likeli, Y = con_dat1[, -1], pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay"), beta.fixed = as.matrix(betas)) } else { latreg <- tam.latreg(likeli, Y = con_dat1[, -1], pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay")) }

Comment: Draw 5 plausible values for each student out of the resulting distribution  which is assumed to be normal distributed
Category: Statistical Modeling
Code:
pvs    <- tam.pv(latreg, nplausible = 5, normal.approx = T, samp.regr = samp.regr.opt) } else { pvs    <- tam.pv(latreg_md, nplausible = 5, normal.approx = T, samp.regr = samp.regr.opt) } else {

Comment:  Extract the regression coefficients of the conditioning variables, because  they are fixed for the core domains in the next step at that value 
Category: Statistical Modeling
Code:
reg.coefs <- cbind(rep(1:dim(latreg$beta)[1], 3), rep(1:3, each = dim(latreg$beta)[1]), c(latreg$beta[, 1], latreg$beta[, 2], latreg$beta[, 3]))

Comment:  Extract IRT likelihood of the second model (math, read and scie plus digital  domains) 
Category: Statistical Modeling
Code:
likeli_md <- IRT.likelihood(mod2)

Comment: Compute latent regression of the latent ability on the conditioning  variables (excl. the first column which is the student ID). But this time  only the regression coefficients of the digital domains are computed freely.  The rest is fixed at the values of the first model
Category: Statistical Modeling
Code:
latreg_md <- tam.latreg(likeli_md, Y = con_dat[, -1],  pid = pid.sele, control = list(maxiter = iter.2, acceleration = "Ramsay"), beta.fixed = reg.coefs)
File: 01a_DataPrep_Study1.R

Comment: Calculate the number of surveys completed per person
Category: Data Variable
Code:
N <- as.data.frame(table(dat$id)) names(N) <- c("id", "N") dat <- merge(dat, N, by = "id", all.x = T) table(dat$N, useNA = "ifany")
File: exp1aDead-MNL-SAT-A.r

Comment: convert attributes from character to numeric
Category: Data Variable
Code:
for(i in 1:3) { data[[paste0("opt",i,"cost")]] <- as.numeric(substring(data[[paste0("opt",i,"cost")]], 3, 7)) data[[paste0("opt",i,"sides")]] <- as.numeric(substring(data[[paste0("opt",i,"sides")]], 1, 2)) data[[paste0("opt",i,"deliveryTime")]] <- as.numeric(substring(data[[paste0("opt",i,"deliveryTime")]], 2, 3)) }
File: prep.analysis.data.R

Comment:  Step 9: Create time difference variable, and the final dependent variable (media_success)  calculating the time difference between each documentpair 
Category: Data Variable
Code:
result$date_diff <- as.Date(as.character(result$news_date), format="%Y-%m-%d")- as.Date(as.character(result$date), format="%Y-%m-%d")
File: prediction_analyses.R

Comment:  Remove trials with RT < 4710 ms (i.e., presses before disambiguating information in sentence) 
Category: Data Variable
Code:
dataset_exp1 <- dataset_exp1[which(dataset_exp1$rt > 4710), ]

Comment:  Add 'trackloss' column (if not looking at IA_1 or IA_2, then trackloss  1) 
Category: Data Variable
Code:
dataset_exp1 <- within(dataset_exp1, { trackloss <- ifelse(average_target_sample_count_proportion == 0 & average_distractor_sample_count_proportion == 0, 1, 0) })

Comment: Ttests (using participantaveraged data)
Category: Statistical Test
Code:
num_sub_exp1 <- length(unique((eyetrackingr.data.exp1$participant_number))) threshold_t_exp1 <- qt(p = 1 - .05 / 2, df = num_sub_exp1 - 1) # Pick threshold for t based on alpha = .05, two-tailed df_timeclust_exp1 <- make_time_cluster_data(response_time_exp1, test = "t.test", paired = TRUE, predictor_column = "trial_condition_new", threshold = threshold_t_exp1 )
File: MSE.VAR.Sys.R

Comment: MSE for each participant
Category: Data Variable
Code:
MSE.Sys.VAR.i = lapply(1:fold, function(k) MSE.k[[k]]$MSE.ki)
File: titration_answers.R

Comment: use mutate and the dffit fit information to make the data for mal
Category: Statistical Modeling
Code:
mal_fit <- fit_num %>% mutate(fit = (s)/(1.196506 + s)) dex_fit <- fit_num %>% mutate(fit = (s)/(62.736799 + s)) lac_fit <- fit_num %>% mutate(fit = (s)/(43.839063 + s)) maldex_fit <- fit_num %>% mutate(fit = (s)/(7.253739 + s))
File: main_analysis_code.R

Comment: Logistic Mixed Effects Regression for Original Critical Targets
Category: Statistical Modeling
Code:
log_reg_data <- cards_long %>% filter(card == "card_1" | card == "card_3" | card == "card_6" | card == "card_7" | card == "card_9" | card == "card_14" ) %>% mutate( distance = case_when( card == "card_1" | card == "card_3" | card == "card_6"  ~ 0, card == "card_7" | card == "card_9" | card == "card_14" ~ 1 ), comf_acquaint = scale(comf_acquaint, scale = FALSE), comf_close = scale(comf_close, scale = FALSE), approp_acquaint = scale(approp_acquaint, scale = FALSE), approp_close = scale(approp_close, scale = FALSE) ) log_reg_data$amit_wording <- factor(log_reg_data$amit_wording, levels = c("original", "new")) h1_melogreg <- glmer(choice ~ distance + amit_wording + (1 + distance|id) + (1|card), data = log_reg_data, family = binomial(link = "logit")) h1_melogreg_inter <- glmer(choice ~ distance * amit_wording + (1 + distance|id) + (1|card), data = log_reg_data, family = binomial(link = "logit")) h1_model_comparison <- anova(h1_melogreg, h1_melogreg_inter)
File: ordinal_helper_functions.R

Comment:  Highest density interval ' ' This is a function that will calculate the highest density interval from a ' posterior sample. ' ' The default is to calcualte the highest 95 percent interval. It can be used ' with any numeric vector instead of having to use one of the specific MCMC ' classes. This function has been adapted from John K. Kruschke (2011). Doing ' Bayesian Data Analaysis: A Tutorial with R and BUGS. ' ' @param x Numeric vector of a distribution of data, typically a posterior ' sample ' @param prob Width of the interval from some distribution. Defaults to `0.95`. ' @param warn Option to turn off multiple sample warning message Must be in the ' range of `[0,1]`. ' @return Numeric range ' @export ' @examples ' x < qnorm(seq(1e04, .9999, length.out1001)) ' hdi_95 < hdi(x, .95) ' hdi_50 < hdi(x, .50) ' ' hist(x, br50) ' abline(vhdi_95, col"red") ' abline(vhdi_50, col"green") ' ' x < exp(seq(pi * (1  (1/16)), pi, len  1000)) ' x < c(x, rev(x)[1]) ' x < c(x, x) ' plot(sort(x), type"l") ' plot(density(x, adjust0.25)) ' abline(vhdi(x, p.49), col2) ' abline(vhdi(x, p.50), col3) 
Category: Statistical Modeling
Code:
hdi <- function(x, prob=0.95, warn=TRUE) { if (anyNA(x)) { stop("HDI: ", "x must not contain any NA values.", call.=FALSE) } N <- length(x) if (N < 3) { if (warn) { warning("HDI: ", "length of `x` < 3.", " Returning NAs", call.=FALSE) } return(c(NA_integer_, NA_integer_)) } x_sort <- sort(x) window_size <- as.integer(floor(prob * length(x_sort))) if (window_size < 2) { if (warn) { warning("HDI: ", "window_size < 2.", " `prob` is too small or x does not ", "contain enough data points.", " Returning NAs.", call.=FALSE) } return(c(NA_integer_, NA_integer_)) } lower <- seq_len(N - window_size) upper <- window_size + lower
File: Study2B_analyses.R

Comment: test whether Condition predicts exclusion probability
Category: Data Variable
Code:
Cond_exclude <- table(data$Cond, data$exclude) chisq.test(Cond_exclude) rm(Cond_exclude)
File: summarise2.R

Comment:  Fix the following script by:  Take our dataset (df) , and then  group it by our explanatory variable (Condition), and then  Summarise this dataset by  Creating a new variable in this summary dataset called Mean  Mean takes the mean of our Response variable, and ignores NA.  Repeat for standard deviation.  We've added on one more column in our summary dataset  N.  N is the number of observations per group. To do so, we want to add up  How many times our DV is not missing (per group).  When you think it is a complete, save the script. The name of the script  above will go from red to black. That is how you know you've saved it.  You can use ctrl+S to save, or click the floppy disk above.  We want to know how the means and standard deviations and Ns of Hire_Rating differed. 
Category: Data Variable
Code:
sum_hire <-
File: 6) agr_summer_model.R

Comment: Calculate R squared for each model
Category: Statistical Test
Code:
r.squaredGLMM(m1) #indegree r.squaredGLMM(m2) #outdegree r.squaredGLMM(m3) #betweenness r.squaredGLMM(m4) #outcloseness r.squaredGLMM(m5) #incloseness r.squaredGLMM(m6) #local clustering r.squaredGLMM(m7) #average shortest path length r.squaredGLMM(m8) #eigenvector r.squaredGLMM(m9) #outstrength r.squaredGLMM(m10) #instrength
File: R_Code_Buffinton_MorganShort.R

Comment: split the data into two halves
Category: Data Variable
Code:
d$ItemNo = parse_number(as.character(d$ItemNo)) de = d %>%  filter(ItemNo %% 2 == 0) do = d %>%  filter(ItemNo %% 2 == 1)

Comment: Zscore transform RTs, compute zRT difference, remove NAs for the 2 groups 
Category: Data Variable
Code:
de <- de |> group_by(Subject) |> mutate (zRT = scale(Reaction.Time, center = T, scale = T), meanRT = mean(Reaction.Time)) |> select (1,2,4,5) |> pivot_wider(names_from = Condition, values_from = zRT) |> mutate (zrt.diff = R-P) |> filter(!is.na(zrt.diff)) do <- do |> group_by(Subject) |> mutate (zRT = scale(Reaction.Time, center = T, scale = T), meanRT = mean(Reaction.Time)) |> select (1,2,4,5) |> pivot_wider(names_from = Condition, values_from = zRT) |> mutate (zrt.diff = R-P) |> filter(!is.na(zrt.diff)) de <- de |> group_by(Subject) |> mutate (zRT = scale(Reaction.Time, center = T, scale = T), meanRT = mean(Reaction.Time)) |> select (1,2,4,5) |> pivot_wider(names_from = Condition, values_from = zRT) |> mutate (zrt.diff = R-P) |> filter(!is.na(zrt.diff))

Comment: fit models for even and odd numbered items (Bayesian & Generalized LMM)
Category: Statistical Modeling
Code:
m_de = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = de, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) m_do = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = do, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) m_de = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = de, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) m_do = blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = do, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5)))

Comment: fit lmm to the whole dataset
Category: Statistical Modeling
Code:
m <- blmer(-1/Reaction.Time ~ Condition + (1+Condition|Subject) + (1+Condition|ItemNo), data = d_trimmed, control=lmerControl(optimizer = "nloptwrap", optCtrl = list(algorithm = "NLOPT_LN_NELDERMEAD", maxit = 2e5))) summary(m)
File: Goal

Comment: calculate shared and unique variance
Category: Statistical Modeling
Code:
x1 = rsq - rx2y^2 x2 = rsq - rx1y^2 x1_x2 = rsq - x1 - x2 c(x1, x2, x1_x2, rsq) } semipartial_corr = function(r12, r13, r23) {

Comment: create empty df
Category: Data Variable
Code:
df <- data.frame( `rx1y` = numeric(), `rx2y` = numeric(), `rx1x2` = numeric(), `rx1y_x2` = numeric(), `rx2y_x1` = numeric(), `x1` = numeric(), `x2` = numeric(), `Common` = numeric(), `Total` = numeric() )
File: Model_Preference.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   AspElevForm 
Category: Visualization
Code:
emmip(PrefRate, ~AspElevForm, type = "response", CIs = TRUE) (emm <- emmeans(PrefRate, specs = ~AspElevForm, type = "response")) pairs(emm)
File: INLA_GHG_GMD.R

Comment: Operator on x, rescale to be in y unit 
Category: Data Variable
Code:
Hlist <- list() for(i in seq(nt)){ Hlist[[paste0("H",i)]] <- with(data, t(apply(data[[i]]$sdfp, 1, function(x) x*data[[i]]$prior)) %*% A) } H<-bdiag(unlist(Hlist)) strl <- function(x){ x[x < max(x)/1000] <- 0 return(x) } H <- as(t(apply(H, 1, strl)), 'dgCMatrix')  #Make sparser
File: runPrototype.R

Comment:  Creates the variable 'distances', a 540 X 3 distance matrix between stimuli and  category prototypes. 
Category: Data Variable
Code:
distances = as.matrix(pdist(coordinates, prototypes))
File: VADIS_genitives_outer_circle.R

Comment: calculate similarity coefficient (mean of signif_line$similarity.scores)
Category: Statistical Modeling
Code:
mean(signif_line$similarity.scores[,2]) mean(coef_line$similarity.scores[,2]) mean(varimp_line$similarity.scores[,2])
File: ETfun.R

Comment: Calculate Priestley Taylor Ep
Category: Data Variable
Code:
data$PT.Ep <- 1.26/lambda.w*deltav/(deltav+rho.air)*Rn
File: Witt_SDT_Simulations_SeveralTests.R

Comment: plot hit, FA, miss, corrRejection for each effect size/sample size combo 
Category: Visualization
Code:
ap <- aggregate(hits ~ criterion+sampleSize+effectSizes, data=allDt,mean) ap2 <- aggregate(fa ~ criterion+sampleSize+effectSizes, data=allDt,mean) hFA <- merge(ap,ap2,by=c("criterion","sampleSize","effectSizes")) ap2 <- aggregate(miss ~ criterion+sampleSize+effectSizes, data=allDt,mean) hFA <- merge(hFA,ap2,by=c("criterion","sampleSize","effectSizes")) ap2 <- aggregate(corrRej ~ criterion+sampleSize+effectSizes, data=allDt,mean) hFA <- merge(hFA,ap2,by=c("criterion","sampleSize","effectSizes")) hFA$hits <- hFA$hits / numStudies hFA$fa <- hFA$fa / numStudies hFA$corrRej <- hFA$corrRej / numStudies hFA$miss <- hFA$miss / numStudies

Comment:  plot errors only (FA and misses, separately)   Plot ROC dist  
Category: Visualization
Code:
aa <- aggregate(ROCdist ~ criterion, data=allDt,mean) ab <- aggregate(ROCdist ~ criterion, data=allDt,sd) ab$ci <- qnorm(.975) * ab$ROCdist / sqrt(numStudies) titleText <- ifelse(length(sSizesAll) < 2, paste("N=",sSizesAll[1],"d=",effSzAll[1]), paste("firstES:",effSzAll[1])) plot(seq(1:length(crits)),aa$ROCdist,bty="l",xaxt="n",xlab="Criterion for Statistical Significance",ylab="Distance to Perfection",pch=19,col=rainbow(length(crits)),cex=2,ylim=c(0,max(aa$ROCdist)+max(ab$ci)),main = titleText) axis(side=1,at=seq(1:length(crits)),labels = crits) for(i in 1:length(crits)) { segments(i,aa$ROCdist[i] - ab$ci[i],i,aa$ROCdist[i]+ab$ci[i]) }
File: Hospital_Stay_of_Stroke_Patients_forest_plot.R

Comment: calculate the variance and bias for the log(DR)
Category: Statistical Modeling
Code:
log.var <- ((res$se.tau2)^2)/4*1/(sum(w.star))^2*(sum(1/(res$vi + res$tau2)^2))^2 log.sd <- sqrt(log.var) bias <- 1/2*(res$se.tau2)^2*(1/2/sum(w.star)^2 - 1/sum(w.star)*sum(1/(res$vi + res$tau2)^3))

Comment: create the forest plot including extra information (study names, weights, observed effects and associated variances). 
Category: Visualization
Code:
f <- forest(res, col = "blue", border = "blue", ylim = c(-8,12), xlim = c(-4,5), pch = 19, slab = dat$study, showweights = FALSE, addfit = FALSE, refline = FALSE, ilab = cbind(paste(format(round(res$yi,2), nsmall = 2)) , paste(format(round(res$vi, 2), nsmall = 2)), paste(format(round(res$ni, 2))), paste(format(weights, nsmall = 2)), paste(format(weights.f, nsmall = 2))) , ilab.xpos = c(-3.15,-2.75, -2.35,-1.5,-0.75), ilab.pos = 2, efac = 0, digits = 2)
File: TablePrep_Third.R

Comment: STEP 2: Filter the data in overall.data table according to preregistered inclusion criteria    replace 0 with NA in outcome column
Category: Data Variable
Code:
overall.data$LTScreenOut[overall.data$LTScreenOut == 0] <- NA #replace NAs with 0 for averaging in the next steps overall.data$LTObjectOut[overall.data$LTObjectOut == 0] <- NA #replace NAs with 0 for averaging in the next steps overall.data$FirstLookDurationObjectOut[overall.data$FirstLookDurationObjectOut == 0] <- NA #replace NAs with 0 for averaging in the next steps
File: evaluation_data_analysis.R

Comment: fit indices function for the SEM and FA analyses
Category: Statistical Modeling
Code:
fa.CFI<-function(x){ nombre<-paste(x,"CFI",sep = ".") nombre<- ((x$null.chisq-x$null.dof)-(x$STATISTIC-x$dof))/(x$null.chisq-x$null.dof) return(nombre) }

Comment: check Descriptive statistics    gender breakdown
Category: Statistical Test
Code:
df <- eval_data %>% group_by(gender) %>% summarise(counts = n()) df
File: analysis_privacysetting.r

Comment: Decompose variance  Estimate multilevel model (without predictors)
Category: Statistical Modeling
Code:
m_logistic <- lmer(estimate ~ 1 + (1|controls) + (1|age) + (1|year) + (1|age:year) + (1|age:controls) + (1|year:controls), data = results %>% rename(age = age_group))
File: 8_fda_socaccount.R

Comment: Visualize four first principal components
Category: Visualization
Code:
fig.df <- data.frame(HR = c(FPCAdense$phi[,1], FPCAdense$phi[,2], FPCAdense$phi[,3], FPCAdense$phi[,4]), pc = c(rep(1, 51), rep(2, 51), rep(3, 51), rep(4, 51)), Time= rep(FPCAdense$workGrid, 4)) all.four <- ggplot(fig.df, aes(x=Time, y=HR))+geom_line()+ geom_vline(xintercept=.20, linetype="dashed")+ facet_grid(.~pc)+ theme_bw() all.four ggsave("../figures/figure5.png", width=6, height=4)
File: dt_homing_dataproc.R

Comment: SPATIOTEMPORAL VARIABLES AND HOMING SUCCESS  Join territory center pts to the dataframe to calculate translocation distance and homing success
Category: Data Variable
Code:
trajectory <- trajectory.df %>% left_join(territory_centers, by = "id")%>% mutate(trans_dist = sqrt((x_home - first(x_utm))^2+(y_home - first(y_utm))^2), trans_group = ifelse(trans_dist > 100, "200m", "50m"))%>% dplyr::select(id, sex, trans_group, trans_dist, dt, x_utm, y_utm, x_home, y_home, time_lag_min = time_diff, dist)

Comment: Tally the number relocations for each individual per day
Category: Data Variable
Code:
trajectory.df %>% group_by(id, date) %>% count(id) -> relocs.perday

Comment: Plot full circular info by sex  start with blank plot, then add groupspecific points 
Category: Visualization
Code:
dev.new();; par(mai = c(1, 1, 0.1,0.1)) par(mar=c(0.5, 0.5, 0.5, 0.5)) pdf("dt_circ_50m.pdf") plot(corient50_m, bg = rgb(0, 0.749, 0.769), pch = 21, cex = 1.5, lwd = 2, stack = TRUE, bin = 60, xlim = c(-1.2, 1.2), ylim = c(-1.2, 1.2), sep = 0.05, shrink = 1, tcl.text = -0.125, control.circle=circle.control(lwd = 2)) ticks.circular(circular(seq(0,2*pi,pi/2)), tcl=0.075) par(new = T) plot(corient50_f, bg=rgb(0.973, 0.463, 0.427), pch = 21, cex=1.5, lwd = 2, stack=T, bins=60, sep = -0.05, shrink= 1.3, axes = FALSE, control.circle=circle.control(lwd = 1)) arrows.circular(mean(corient50_m), y = rho.circular(corient50_m), col = rgb(0, 0.749, 0.769), lwd = 5) arrows.circular(mean(corient50_f), y = rho.circular(corient50_f), col = rgb(0.973, 0.463, 0.427), lwd = 5) par(new = T) plot(corient50_m, col = NA, shrink= 2.5, axes = FALSE, control.circle=circle.control(lty = 2, lwd = 1)) ticks.circular(circular(seq(0,2*pi,pi/8)), tcl=0.2) lines(density.circular(corient50_m, bw=30), shrink= 1, col = rgb(0, 0.749, 0.769, 0.7), lwd=2, lty=1) lines(density.circular(corient50_f, bw=30), col = rgb(0.973, 0.463, 0.427, 0.7), lwd=2, lty=1) dev.new();; par(mai = c(1, 1, 0.1,0.1)) par(mar=c(0.5, 0.5, 0.5, 0.5)) pdf("dt_circ_200m.pdf") plot(corient200_m, bg = rgb(0, 0.749, 0.769), pch = 21, cex = 1.5, lwd = 2, stack = TRUE, bin = 60, xlim = c(-1.2, 1.2), ylim = c(-1.2, 1.2), sep = 0.05, shrink = 1, tcl.text = -0.125, control.circle=circle.control(lwd = 2)) ticks.circular(circular(seq(0,2*pi,pi/2)), tcl=0.075) par(new = T) plot(corient200_f, bg=rgb(0.973, 0.463, 0.427), pch = 21, cex=1.5, lwd = 2, stack=T, bins=60, sep = -0.05, shrink= 1.3, axes = FALSE, control.circle=circle.control(lwd = 1)) arrows.circular(mean(corient200_m), y = rho.circular(corient200_m), col = rgb(0, 0.749, 0.769), lwd = 5) arrows.circular(mean(corient200_f), y = rho.circular(corient200_f), col = rgb(0.973, 0.463, 0.427), lwd = 5) par(new = T) plot(corient200_m, col = NA, shrink= 2.5, axes = FALSE, control.circle=circle.control(lty = 2, lwd = 1)) ticks.circular(circular(seq(0,2*pi,pi/8)), tcl=0.2) lines(density.circular(corient200_m, bw=30), shrink= 1, col = rgb(0, 0.749, 0.769, 0.7), lwd=2, lty=1) lines(density.circular(corient200_f, bw=30), col = rgb(0.973, 0.463, 0.427, 0.7), lwd=2, lty=1)
File: helper_JsonFormat.R

Comment: Helper function to prepare raw keyboard data ' ' @author F. Bemmann ' @family Preprocessing function ' @description this function unfolds json data into one column per keyvalue pair ' @export
Category: Data Variable
Code:
parseJsonColumnSensing = function(df, column_name){ parseJsonColumn = function(x){ str_c("[ ", str_c(x, collapse = ",", sep=" "), " ]")  %>% jsonlite::fromJSON(flatten = T) %>% as_tibble() } df2 = df %>% select(user_uuid,client_event_id,!!column_name) %>% filter(!is.na(!!rlang::sym(column_name))) %>% map_dfc(.f = parseJsonColumn) %>% distinct() colnames(df2)[1:2] = c("user_uuid", "client_event_id") df = left_join(df, df2, by = c("user_uuid", "client_event_id")) df[,column_name] = NULL return(df) }
File: 0-Script.R

Comment: Separate ANOVAs for each subscale  Pairwise ttests with adjusted alpha level of .05/4  .0125 (because there are four relevant comparisons)
Category: Statistical Test
Code:
summary(aov(value~Fan*time+Error(VP_t0/(time)),data=dat[dat$scale=="Attentiveness",])) pairwise.t.test(dat[dat$scale=="Attentiveness",]$value,paste(dat[dat$scale=="Attentiveness",]$Fan,dat[dat$scale=="Attentiveness",]$time),p.adj="none")