Supplementary Material
This code contains the process, models, figures, and results that were used to analyze the effects of encumbrance and walking on movement time (see section 3.1), pointing offset (see section 3.2), error rate (see section 3.3), target acquisition throughput (see section 3.4), text entry throughput (see section 4.1), uncorrected error rate/corrected error rate (section 4.2), and words per minute (section 4.3) with Bayesian regression models. We plot the results for visual representation and report the posterior probability to further prove our model as well.
The key libraries used for model generation and plotting, along with their respective versions, are listed below.
cat("lme4:", as.character(packageVersion("lme4")),
"glmmTMB:", as.character(packageVersion("glmmTMB")),
"brms:", as.character(packageVersion("brms")),
"betareg:", as.character(packageVersion("betareg")),
"bayestestR:", as.character(packageVersion("bayestestR")),
"ggplot2:", as.character(packageVersion("ggplot2")))lme4: 1.1.35.5 glmmTMB: 1.1.10 brms: 2.22.0 betareg: 3.2.1 bayestestR: 0.15.0 ggplot2: 3.5.1This section contains the analysis of target acquisition task performed in the paper.
Model for target acquisition (direct selection)
ggplot(mt_poke, aes(x = log(MT))) +
geom_histogram(binwidth = 0.2, color = "black", fill = "blue") +
labs(title = "Histogram of Log-Transformed Data", x = "Log(Movement Time)", y = "Frequency")
mt_model_poke <- brm(MT ~ 1 + (1|participant) + iterationNum + exercise + (ID * (weight * movement)),
mt_poke,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(mt_model, file = "brm_model/mt_model_poke.rds")mt_model_poke <- readRDS("brm_model/mt_model_poke.rds")
summary(mt_model_poke) Family: shifted_lognormal
Links: mu = identity; sigma = identity; ndt = identity
Formula: MT ~ 1 + (1 | participant) + iterationNum + exercise + (ID * (weight * movement))
Data: no_error_poke (Number of observations: 11877)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.31 0.04 0.24 0.40 1.00 1196 2043
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept 6.06 0.09 5.87 6.25 1.00 1234
iterationNum -0.05 0.00 -0.06 -0.05 1.00 6569
exercise -0.01 0.01 -0.03 0.00 1.00 1512
ID 0.28 0.04 0.20 0.36 1.00 2542
weight 0.41 0.05 0.31 0.51 1.00 2520
movementWalking 0.17 0.05 0.08 0.27 1.00 2355
weight:movementWalking -0.07 0.07 -0.21 0.07 1.00 2425
ID:weight -0.11 0.06 -0.24 0.02 1.00 2396
ID:movementWalking 0.07 0.06 -0.05 0.19 1.00 2220
ID:weight:movementWalking 0.14 0.09 -0.04 0.31 1.00 2326
Tail_ESS
Intercept 1956
iterationNum 4829
exercise 1908
ID 3563
weight 3709
movementWalking 3541
weight:movementWalking 3152
ID:weight 3430
ID:movementWalking 3674
ID:weight:movementWalking 3349
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.46 0.00 0.45 0.46 1.00 5754 5189
ndt 177.66 0.77 176.00 179.02 1.00 5358 4967
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Model for target acquisition (ray-casting)
ggplot(mt_ray, aes(x = log(MT))) +
geom_histogram(binwidth = 0.2, color = "black", fill = "blue") +
labs(title = "Histogram of Log-Transformed Data", x = "Log(Movement Time)", y = "Frequency")
mt_model_ray <- brm(MT ~ 1 + (1|participant) + iterationNum + exercise + (ID * (weight * movement)),
mt_ray,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(mt_model, file = "brm_model/mt_model_ray.rds")mt_model_ray <- readRDS("brm_model/mt_model_ray.rds")
summary(mt_model_ray) Family: shifted_lognormal
Links: mu = identity; sigma = identity; ndt = identity
Formula: MT ~ 1 + (1 | participant) + iterationNum + exercise + (ID * (weight * movement))
Data: no_error_ray (Number of observations: 11880)
Draws: 4 chains, each with iter = 5000; warmup = 2500; thin = 1;
total post-warmup draws = 10000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.24 0.03 0.18 0.32 1.00 1398 2268
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept 6.74 0.08 6.58 6.89 1.00 2241
iterationNum -0.04 0.00 -0.04 -0.03 1.00 9358
exercise -0.01 0.01 -0.02 0.00 1.00 2220
ID 0.48 0.06 0.37 0.59 1.00 3862
weight 0.27 0.07 0.14 0.41 1.00 3640
movementWalking 0.09 0.06 -0.03 0.22 1.00 3304
weight:movementWalking 0.22 0.10 0.02 0.41 1.00 3276
ID:weight -0.00 0.09 -0.17 0.17 1.00 3587
ID:movementWalking 0.55 0.08 0.39 0.71 1.00 3277
ID:weight:movementWalking -0.24 0.12 -0.48 0.00 1.00 3257
Tail_ESS
Intercept 3585
iterationNum 6708
exercise 3510
ID 5157
weight 5106
movementWalking 4962
weight:movementWalking 5166
ID:weight 5035
ID:movementWalking 5002
ID:weight:movementWalking 4933
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.63 0.00 0.62 0.64 1.00 7406 6934
ndt 175.36 3.15 168.76 181.18 1.00 6360 5719
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior Probability Check
# Target Acquisition (Direct Selection) Movement Time Model
pp_check(mt_model_poke)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Target Acquisition (Direct Selection) Movement Time Model
post <- as_draws_df(mt_model_poke)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 1 Motion Probability: 1 Weight x Motion Probability: 0.186875# Target Acquisition (Ray-Casting) Movement Time Model
pp_check(mt_model_ray)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Target Acquisition (Ray-Casting) Movement Time Model
post <- as_draws_df(mt_model_ray)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 1 Motion Probability: 0.929 Weight x Motion Probability: 0.986Bayes Factor
# Target Acquisition (Direct Selection) Movement Time without Weight
mt_model_poke_weight <- brm(MT ~ 1 + (1|participant) + iterationNum + exercise + (ID * movement),
data = mt_poke,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(mt_model_poke_weight, file = "brm_model/mt_model_poke_weight.rds")
# Target Acquisition (Direct Selection) Movement Time without Motion
mt_model_poke_movement <- brm(MT ~ 1 + (1|participant) + iterationNum + exercise + (ID * weight),
data = mt_poke,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(mt_model_poke_movement, file = "brm_model/mt_model_poke_movement.rds")
# Target Acquisition (Ray-Casting) Movement Time without Weight
mt_model_ray_weight <- brm(MT ~ 1 + (1|participant) + (1|order) + exercise + (ID * movement),
mt_ray,
family = shifted_lognormal(),
iter = 5000,
save_pars = save_pars(all = TRUE))
saveRDS(mt_model_ray_weight, file = "brm_model/mt_model_ray_weight.rds")
# Target Acquisition (Ray-Casting) Movement Time without Motion
mt_model_ray_movement <- brm(MT ~ 1 + (1|participant) + iterationNum + exercise + (ID * weight),
mt_ray,
family = shifted_lognormal(),
iter = 5000,
save_pars = save_pars(all = TRUE))
saveRDS(mt_model_ray_movement, file = "brm_model/mt_model_ray_movement.rds")mt_model_poke_weight <- readRDS("brm_model/mt_model_poke_weight.rds")
mt_model_poke_movement <- readRDS("brm_model/mt_model_poke_movement.rds")
mt_model_ray_weight <- readRDS("brm_model/mt_model_ray_weight.rds")
mt_model_ray_movement <- readRDS("brm_model/mt_model_ray_movement.rds")
bf_mt_poke_weight <- bayes_factor(mt_model_poke, mt_model_poke_weight)
bf_mt_poke_movement <- bayes_factor(mt_model_poke, mt_model_poke_movement)
bf_mt_ray_weight <- bayes_factor(mt_model_ray, mt_model_ray_weight)
bf_mt_ray_movement <- bayes_factor(mt_model_ray, mt_model_ray_movement)# Target Acquisition (Direct Selection) Movement Time without Weight
print(bf_mt_poke_weight)Estimated Bayes factor in favor of mt_model_poke over mt_model_poke_weight: 820921509091744588492921523912306436850208406660350505681406079880328682796688531537873389122028189795077132969143008233710258094292793933802522397854404956123495257448176021010252723556407090137200459203661516901784292374970344931328.00000# Target Acquisition (Direct Selection) Movement Time without Motion
print(bf_mt_poke_movement)Estimated Bayes factor in favor of mt_model_poke over mt_model_poke_movement: 45967948027229486546461942633664313557225991762044189197933929938417523452508722244621818754054815040951576832711421876441522343187255757843385028279273071797346437015580344057856.00000# Target Acquisition (Ray-Casting) Movement Time without Weight
print(bf_mt_ray_weight)Estimated Bayes factor in favor of mt_model_ray over mt_model_ray_weight: 141699340824287369083892770663921232630760317557146210391409070187606806806564448501760.00000# Target Acquisition (Ray-Casting) Movement Time without Motion
print(bf_mt_ray_movement)Estimated Bayes factor in favor of mt_model_ray over mt_model_ray_movement: Inf# Effect of Weight on Movement Time
combined_weight_plot
# Effect of Motion on Movement Time
combined_motion_plot
# Interaction Effect of Weight and Motion on Movement Time
combined_interaction_plot
This section presents the pointing offset models and the corresponding outcomes from the target acquisition task.
Model for target acquisition (direct selection)
ggplot(offset_poke, aes(x = log(offset))) +
geom_histogram(binwidth = 0.2, color = "black", fill = "blue") +
labs(title = "Histogram of Offset", x = "Log(Offset)", y = "Frequency")
offset_model_poke <- brm(
formula = offset ~ 1 + (1 | participant) + iterationNum + exercise + width * (weight * movement),
data = offset_poke,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE)
)
saveRDS(offset_model_poke, file = "brm_model/offset_model_poke.rds")offset_model_poke <- readRDS("brm_model/offset_model_poke.rds")
summary(offset_model_poke) Family: shifted_lognormal
Links: mu = identity; sigma = identity; ndt = identity
Formula: offset ~ 1 + (1 | participant) + iterationNum + exercise + width * (weight * movement)
Data: no_error_poke (Number of observations: 11877)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.11 0.02 0.08 0.14 1.00 1310 2615
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept 2.43 0.06 2.31 2.54 1.00 1701
iterationNum 0.01 0.00 0.00 0.02 1.00 10533
exercise 0.01 0.00 -0.00 0.01 1.00 1123
width 0.01 0.00 0.00 0.01 1.00 2984
weight -0.25 0.07 -0.39 -0.11 1.00 2577
movementWalking 0.04 0.06 -0.09 0.17 1.00 2548
weight:movementWalking 0.11 0.10 -0.09 0.31 1.00 2131
width:weight 0.00 0.00 0.00 0.00 1.00 2529
width:movementWalking 0.00 0.00 -0.00 0.00 1.00 2572
width:weight:movementWalking -0.00 0.00 -0.00 0.00 1.00 2184
Tail_ESS
Intercept 3206
iterationNum 5816
exercise 1776
width 4884
weight 4206
movementWalking 4210
weight:movementWalking 3668
width:weight 4329
width:movementWalking 4492
width:weight:movementWalking 3957
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.59 0.00 0.59 0.60 1.00 8608 5868
ndt 0.00 0.00 0.00 0.02 1.00 5778 3271
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Model for target acquisition (ray-casting)
ggplot(offset_ray, aes(x = log(offset))) +
geom_histogram(binwidth = 0.2, color = "black", fill = "blue") +
labs(title = "Histogram of Offset", x = "Log(Offset)", y = "Frequency")
offset_model_ray <- brm(
formula = offset ~ 1 + (1 | participant) + iterationNum + exercise + width * (weight * movement),
data = offset_ray,
family = shifted_lognormal(),
save_pars = save_pars(all = TRUE)
)
saveRDS(offset_model_ray, file = "brm_model/offset_model_ray.rds")offset_model_ray <- readRDS("brm_model/offset_model_ray.rds")
summary(offset_model_ray) Family: shifted_lognormal
Links: mu = identity; sigma = identity; ndt = identity
Formula: offset ~ 1 + (1 | participant) + iterationNum + exercise + width * (weight * movement)
Data: no_error_ray (Number of observations: 11880)
Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
total post-warmup draws = 4000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.04 0.01 0.02 0.06 1.00 1203 1669
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept 2.69 0.05 2.60 2.79 1.00 2854
iterationNum 0.00 0.00 -0.00 0.01 1.00 5824
exercise 0.00 0.00 -0.00 0.00 1.00 2409
width 0.01 0.00 0.01 0.01 1.00 3040
weight -0.00 0.07 -0.14 0.13 1.00 2995
movementWalking 0.12 0.06 -0.01 0.24 1.00 2692
weight:movementWalking -0.04 0.10 -0.23 0.16 1.00 2500
width:weight 0.00 0.00 -0.00 0.00 1.00 2967
width:movementWalking 0.00 0.00 -0.00 0.00 1.00 2708
width:weight:movementWalking 0.00 0.00 -0.00 0.00 1.00 2509
Tail_ESS
Intercept 3284
iterationNum 2676
exercise 2431
width 3288
weight 3109
movementWalking 2924
weight:movementWalking 2815
width:weight 3057
width:movementWalking 3277
width:weight:movementWalking 2993
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.59 0.00 0.58 0.60 1.00 4791 3189
ndt 0.02 0.02 0.00 0.07 1.00 3056 1747
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior Probability Check
# Target Acquisition (Direct Selection) Offset Model
pp_check(offset_model_poke)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Target Acquisition (Direct Selection) Offset Model
post <- as_draws_df(offset_model_poke)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0.00025 Motion Probability: 0.742875 Weight x Motion Probability: 0.860375# Target Acquisition (Ray-Casting) Offset Model
pp_check(offset_model_ray)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Target Acquisition (Ray-Casting) Offset Model
post <- as_draws_df(offset_model_ray)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0.49425 Motion Probability: 0.964 Weight x Motion Probability: 0.367Bayes Factor
# Target Acquisition (Direct Selection) Offset without Weight
offset_model_poke_weight <- brm(offset ~ 1 + (1 | participant) + iterationNum + exercise + width * movement,
offset_poke,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(offset_model_poke_weight, file = "brm_model/offset_model_poke_weight.rds")
# Target Acquisition (Direct Selection) Offset without Motion
offset_model_poke_movement <- brm(offset ~ 1 + (1 | participant) + (1|order) + exercise + width * weight,
offset_poke,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(offset_model_poke_movement, file = "brm_model/offset_model_poke_movement.rds")
# Target Acquisition (Ray-Casting) Offset without Weight
offset_model_ray_weight <- brm(offset ~ 1 + (1 | participant) + iterationNum + exercise + width * movement,
offset_ray,
family = shifted_lognormal(),
save_pars = save_pars(all = TRUE))
saveRDS(offset_model_ray_weight, file = "brm_model/offset_model_ray_weight.rds")
# Target Acquisition (Ray-Casting) Offset without Motion
offset_model_ray_movement <- brm(offset ~ 1 + (1 | participant) + iterationNum + exercise + width * weight,
offset_ray,
family = shifted_lognormal(),
save_pars = save_pars(all = TRUE))
saveRDS(offset_model_ray_movement, file = "brm_model/offset_model_ray_movement.rds")offset_model_poke_weight <- readRDS("brm_model/offset_model_poke_weight.rds")
offset_model_poke_movement <- readRDS("brm_model/offset_model_poke_movement.rds")
offset_model_ray_weight <- readRDS("brm_model/offset_model_ray_weight.rds")
offset_model_ray_movement <- readRDS("brm_model/offset_model_ray_movement.rds")
bf_offset_poke_weight <- bayes_factor(offset_model_poke, offset_model_poke_weight)
bf_offset_poke_movement <- bayes_factor(offset_model_poke, offset_model_poke_movement)
bf_offset_ray_weight <- bayes_factor(offset_model_ray, offset_model_ray_weight)
bf_offset_ray_movement <- bayes_factor(offset_model_ray, offset_model_ray_movement)# Target Acquisition (Direct Selection) Offset without Weight
print(bf_offset_poke_weight)Estimated Bayes factor in favor of offset_model_poke over offset_model_poke_weight: 1.44394# Target Acquisition (Direct Selection) Offset without Motion
print(bf_offset_poke_movement)Estimated Bayes factor in favor of offset_model_poke over offset_model_poke_movement: 1960939006892845481530129666539520.00000# Target Acquisition (Ray-Casting) Offset without Weight
print(bf_offset_ray_weight)Estimated Bayes factor in favor of offset_model_ray over offset_model_ray_weight: 0.00000# Target Acquisition (Ray-Casting) Offset without Motion
print(bf_offset_ray_movement)Estimated Bayes factor in favor of offset_model_ray over offset_model_ray_movement: 284699629050047409548931400877809336320.00000# Effect of Weight on Offset
combined_weight_plot
# Effect of Motion on Offset
combined_motion_plot
# Interaction Effect of Weight and Motion on Offsets
combined_interaction_plot
This section presents the error rate models and the corresponding outcomes from the target acquisition task.
Model for target acquisition (direct selection)
err_model_poke <- brm(error ~ 1 + (1|participant) + iterationNum + exercise + (ID * (weight * movement)),
poke,
family = poisson(),
save_pars = save_pars(all = TRUE))
saveRDS(err_model_poke, file = "brm_model/err_model_poke.rds")err_model_poke <- readRDS("brm_model/err_model_poke.rds")
summary(err_model_poke) Family: poisson
Links: mu = log
Formula: error ~ 1 + (1 | participant) + iterationNum + exercise + (ID * (weight * movement))
Data: poke (Number of observations: 11978)
Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
total post-warmup draws = 4000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.78 0.21 0.44 1.25 1.00 1429 2327
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept -5.90 0.94 -7.77 -4.09 1.00 1573
iterationNum 0.05 0.06 -0.07 0.17 1.00 6047
exercise 0.03 0.03 -0.02 0.08 1.00 2403
ID 0.36 1.08 -1.82 2.41 1.00 1494
weight 1.02 1.36 -1.64 3.70 1.00 1262
movementWalking 1.93 1.22 -0.45 4.39 1.00 1242
weight:movementWalking -1.87 1.80 -5.39 1.67 1.00 1164
ID:weight -1.57 1.77 -5.12 1.94 1.00 1343
ID:movementWalking -2.69 1.62 -5.93 0.44 1.00 1318
ID:weight:movementWalking 3.73 2.39 -1.06 8.43 1.00 1224
Tail_ESS
Intercept 2382
iterationNum 2878
exercise 2624
ID 2176
weight 2204
movementWalking 2104
weight:movementWalking 1822
ID:weight 2191
ID:movementWalking 2034
ID:weight:movementWalking 1790
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Model for target acquisition (ray-casting)
err_model_ray <- brm(error ~ 1 + (1|participant) + iterationNum + exercise + (ID * (weight * movement)),
ray,
family = poisson(),
iter = 3000,
save_pars = save_pars(all = TRUE))
saveRDS(err_model_ray, file = "brm_model/err_model_ray.rds")err_model_ray <- readRDS("brm_model/err_model_ray.rds")
summary(err_model_ray) Family: poisson
Links: mu = log
Formula: error ~ 1 + (1 | participant) + iterationNum + exercise + (ID * (weight * movement))
Data: ray (Number of observations: 12908)
Draws: 4 chains, each with iter = 3000; warmup = 1500; thin = 1;
total post-warmup draws = 6000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.71 0.11 0.53 0.96 1.00 1247 2282
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept -4.01 0.59 -5.15 -2.87 1.00 1492
iterationNum 0.04 0.02 -0.00 0.08 1.00 4775
exercise -0.01 0.02 -0.04 0.03 1.00 1160
ID -0.59 0.71 -2.02 0.75 1.00 1430
weight -0.65 0.81 -2.23 0.91 1.00 1359
movementWalking 2.05 0.59 0.92 3.20 1.00 1438
weight:movementWalking 0.58 0.86 -1.09 2.30 1.00 1348
ID:weight 1.21 1.02 -0.74 3.20 1.00 1318
ID:movementWalking -0.11 0.76 -1.55 1.41 1.00 1450
ID:weight:movementWalking -0.82 1.08 -2.97 1.23 1.00 1315
Tail_ESS
Intercept 2451
iterationNum 3922
exercise 1891
ID 2404
weight 2332
movementWalking 2330
weight:movementWalking 2286
ID:weight 2172
ID:movementWalking 2386
ID:weight:movementWalking 2109
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior Probability Check
# Target Acquisition (Direct Selection) Error Rate Model
pp_check(err_model_poke)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Target Acquisition (Direct Selection) Error Rate Model
post <- as_draws_df(err_model_poke)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0.77 Motion Probability: 0.9455 Weight x Motion Probability: 0.1455# Target Acquisition (Ray-Casting) Error Rate Model
pp_check(err_model_ray)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Target Acquisition (Ray-Casting) Error Rate Model
post <- as_draws_df(err_model_ray)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0.217 Motion Probability: 0.999833333333333 Weight x Motion Probability: 0.745833333333333Bayes Factor
# Target Acquisition (Direct Selection) Error Rate without Weight
err_model_poke_weight <- brm(error ~ 1 + (1|participant) + iterationNum + exercise + (ID * movement), poke, family = poisson(), save_pars = save_pars(all = TRUE))
saveRDS(err_model_poke_weight, file = "brm_model/err_model_poke_weight.rds")
# Target Acquisition (Direct Selection) Error Rate without Motion
err_model_poke_movement <- brm(error ~ 1 + (1|participant) + iterationNum + exercise + (ID * weight), poke, family = poisson(), save_pars = save_pars(all = TRUE))
saveRDS(err_model_poke_movement, file = "brm_model/err_model_poke_movement.rds")
# Target Acquisition (Ray-Casting) Error Rate without Weight
err_model_ray_weight <- brm(error ~ 1 + (1|participant) + iterationNum + exercise + (ID * movement), ray, family = poisson(), iter = 3000, save_pars = save_pars(all = TRUE))
saveRDS(err_model_ray_weight, file = "brm_model/err_model_ray_weight.rds")
# Target Acquisition (Ray-Casting) Error Rate without Motion
err_model_ray_movement <- brm(error ~ 1 + (1|participant) + iterationNum + exercise + (ID * weight), ray, family = poisson(), iter = 3000, save_pars = save_pars(all = TRUE))
saveRDS(err_model_ray_movement, file = "brm_model/err_model_ray_movement.rds")err_model_poke_weight <- readRDS("brm_model/err_model_poke_weight.rds")
err_model_poke_movement <- readRDS("brm_model/err_model_poke_movement.rds")
err_model_ray_weight <- readRDS("brm_model/err_model_ray_weight.rds")
err_model_ray_movement <- readRDS("brm_model/err_model_ray_movement.rds")
bf_err_poke_weight <- bayes_factor(err_model_poke, err_model_poke_weight)
bf_err_poke_movement <- bayes_factor(err_model_poke, err_model_poke_movement)
bf_err_ray_weight <- bayes_factor(err_model_ray, err_model_ray_weight)
bf_err_ray_movement <- bayes_factor(err_model_ray, err_model_ray_movement)# Target Acquisition (Direct Selection) Error Rate without Weight
print(bf_err_poke_weight)Estimated Bayes factor in favor of err_model_poke over err_model_poke_weight: 504.45755# Target Acquisition (Direct Selection) Error Rate without Motion
print(bf_err_poke_movement)Estimated Bayes factor in favor of err_model_poke over err_model_poke_movement: 1269.29526# Target Acquisition (Ray-Casting) Error Rate without Weight
print(bf_err_ray_weight)Estimated Bayes factor in favor of err_model_ray over err_model_ray_weight: 83.28777# Target Acquisition (Ray-Casting) Error Rate without Motion
print(bf_err_ray_movement)Estimated Bayes factor in favor of err_model_ray over err_model_ray_movement: 960303539253815798042592358768939348005679829458041452384837507437709113691942491964125531173486811208479513378073209565347840.00000# Effect of Weight on Error Rate
combined_weight_plot
# Effect of Motion on Error Rate
combined_motion_plot
# Interaction Effect of Weight and Motion on Error Rate
combined_interaction_plot
Model for target acquisition (direct selection)
tp_poke <- poke %>%
# Step 1: Group by participant, width, distance, and iterationNum, calculate SD of accuracy
group_by(participant, halfWidth, distance, iterationNum) %>%
mutate(SD = sd(accuracy, na.rm = TRUE)) %>%
ungroup() %>%
# Step 2: Calculate ID_e
mutate(We = 4.133 * SD,
IDe = log2((distance / We) + 1)) %>%
# Step 3: Calculate TP
mutate(TP = IDe / (MT/1000))ggplot(tp_poke, aes(x = log(TP))) +
geom_histogram(binwidth = 0.2, color = "black", fill = "blue") +
labs(title = "Histogram of Log-Transformed Data", x = "Log(Throughput)", y = "Frequency")
tp_model_poke <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + (IDe * (weight * movement)),
tp_poke,
family = shifted_lognormal(),
iter = 5000,
save_pars = save_pars(all = TRUE))
saveRDS(tp_model_poke, file = "brm_model/tp_model_poke.rds")tp_model_poke <- readRDS("brm_model/tp_model_poke.rds")
summary(tp_model_poke) Family: shifted_lognormal
Links: mu = identity; sigma = identity; ndt = identity
Formula: TP ~ 1 + (1 | participant) + iterationNum + exercise + (IDe * (weight * movement))
Data: poke_tp (Number of observations: 11978)
Draws: 4 chains, each with iter = 5000; warmup = 2500; thin = 1;
total post-warmup draws = 10000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.24 0.03 0.19 0.32 1.00 1525 2675
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept -0.71 0.07 -0.85 -0.57 1.00 1992
iterationNum 0.04 0.00 0.03 0.04 1.00 9141
exercise 0.01 0.01 -0.00 0.02 1.00 1829
IDe 0.95 0.02 0.90 0.99 1.00 3687
weight -0.33 0.04 -0.40 -0.26 1.00 3566
movementWalking -0.26 0.03 -0.32 -0.19 1.00 3479
weight:movementWalking 0.08 0.05 -0.03 0.18 1.00 3397
IDe:weight 0.10 0.04 0.02 0.17 1.00 3580
IDe:movementWalking 0.11 0.03 0.05 0.18 1.00 3403
IDe:weight:movementWalking -0.15 0.05 -0.26 -0.05 1.00 3431
Tail_ESS
Intercept 2691
iterationNum 5680
exercise 2737
IDe 4673
weight 4861
movementWalking 4220
weight:movementWalking 4734
IDe:weight 5108
IDe:movementWalking 3780
IDe:weight:movementWalking 4477
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.39 0.00 0.39 0.40 1.00 7639 5767
ndt 0.00 0.00 0.00 0.00 1.00 4876 3461
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Model for target acquisition (ray-casting)
tp_ray <- ray %>%
# Step 1: Group by participant, width, distance, and iterationNum, calculate SD of accuracy
group_by(participant, halfWidth, distance, iterationNum) %>%
mutate(SD = sd(accuracy, na.rm = TRUE)) %>%
ungroup() %>%
# Step 2: Calculate ID_e
mutate(We = 4.133 * SD,
IDe = log2((distance / We) + 1)) %>%
# Step 3: Calculate TP
mutate(TP = IDe / (MT/1000))ggplot(tp_ray, aes(x = log(TP))) +
geom_histogram(binwidth = 0.2, color = "black", fill = "blue") +
labs(title = "Histogram of Log-Transformed Data", x = "Log(Throughput)", y = "Frequency")
tp_model_ray <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + (IDe * (weight * movement)),
tp_ray,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(tp_model_ray, file = "brm_model/tp_model_ray.rds")tp_model_ray <- readRDS("brm_model/tp_model_ray.rds")
summary(tp_model_ray) Family: shifted_lognormal
Links: mu = identity; sigma = identity; ndt = identity
Formula: TP ~ 1 + (1 | participant) + iterationNum + exercise + (IDe * (weight * movement))
Data: ray_tp (Number of observations: 12908)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.24 0.04 0.18 0.32 1.00 1162 2130
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept -1.30 0.08 -1.45 -1.14 1.00 1725
iterationNum 0.03 0.00 0.02 0.04 1.00 7627
exercise 0.01 0.01 -0.00 0.02 1.00 1535
IDe 0.86 0.04 0.79 0.94 1.00 3133
weight -0.31 0.06 -0.43 -0.19 1.00 2824
movementWalking -0.21 0.06 -0.32 -0.10 1.00 2852
weight:movementWalking -0.16 0.09 -0.33 0.01 1.00 2609
IDe:weight 0.09 0.06 -0.03 0.20 1.00 2814
IDe:movementWalking -0.13 0.05 -0.24 -0.03 1.00 2837
IDe:weight:movementWalking 0.06 0.08 -0.10 0.23 1.00 2599
Tail_ESS
Intercept 2712
iterationNum 5154
exercise 2379
IDe 4227
weight 4103
movementWalking 4137
weight:movementWalking 3935
IDe:weight 4052
IDe:movementWalking 3974
IDe:weight:movementWalking 4008
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.71 0.00 0.70 0.72 1.00 7251 5536
ndt 0.00 0.00 0.00 0.00 1.00 4877 3224
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior Probability Check
# Target Acquisition (Direct Selection) Throughput Model
pp_check(tp_model_poke)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Target Acquisition (Direct Selection) Throughput Model
post <- as_draws_df(tp_model_poke)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0 Motion Probability: 0 Weight x Motion Probability: 0.9286# Target Acquisition (Ray-Casting) Throughput Model
pp_check(tp_model_ray)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Target Acquisition (Ray-Casting) Throughput Model
post <- as_draws_df(tp_model_ray)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0 Motion Probability: 0.000625 Weight x Motion Probability: 0.03575Bayes Factor
# Target Acquisition (Direct Selection) Throughput without Weight
tp_model_poke_weight <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + (IDe * movement), poke_tp, family = shifted_lognormal(), iter = 5000, save_pars = save_pars(all = TRUE))
saveRDS(tp_model_poke_weight, file = "brm_model/tp_model_poke_weight.rds")
# Target Acquisition (Direct Selection) Throughput without Motion
tp_model_poke_movement <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + (IDe * weight), poke_tp, family = shifted_lognormal(), iter = 5000, save_pars = save_pars(all = TRUE))
saveRDS(tp_model_poke_movement, file = "brm_model/tp_model_poke_movement.rds")
# Target Acquisition (Ray-Casting) Throughput without Weight
tp_model_ray_weight <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + (IDe * movement), ray_tp, family = shifted_lognormal(), iter = 4000, save_pars = save_pars(all = TRUE))
saveRDS(tp_model_ray_weight, file = "brm_model/tp_model_ray_weight.rds")
# Target Acquisition (Ray-Casting) Throughput without Motion
tp_model_ray_movement <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + (IDe * weight), ray_tp, family = shifted_lognormal(), iter = 4000, save_pars = save_pars(all = TRUE))
saveRDS(tp_model_ray_movement, file = "brm_model/tp_model_ray_movement.rds")tp_model_poke_weight <- readRDS("brm_model/tp_model_poke_weight.rds")
tp_model_poke_movement <- readRDS("brm_model/tp_model_poke_movement.rds")
tp_model_ray_weight <- readRDS("brm_model/tp_model_ray_weight.rds")
tp_model_ray_movement <- readRDS("brm_model/tp_model_ray_movement.rds")
bf_tp_poke_weight <- bayes_factor(tp_model_poke, tp_model_poke_weight)
bf_tp_poke_movement <- bayes_factor(tp_model_poke, tp_model_poke_movement)
bf_tp_ray_weight <- bayes_factor(tp_model_ray, tp_model_ray_weight)
bf_tp_ray_movement <- bayes_factor(tp_model_ray, tp_model_ray_movement)# Target Acquisition (Direct Selection) Throughput without Weight
print(bf_tp_poke_weight)Estimated Bayes factor in favor of tp_model_poke over tp_model_poke_weight: 467430803803050987135571610859256676001244517536043823658105342677392780156011977163175020624827510553968062329916812736912229509000093911257052281022268853140463975881694516181337013876586454750068736.00000# Target Acquisition (Direct Selection) Throughput without Motion
print(bf_tp_poke_movement)Estimated Bayes factor in favor of tp_model_poke over tp_model_poke_movement: 10076450288795630919747705896559947944442206091627632411215016413870234056804400923970203659054626685561416909858307143207005661931954688229376.00000# Target Acquisition (Ray-Casting) Throughput without Weight
print(bf_tp_ray_weight)Estimated Bayes factor in favor of tp_model_ray over tp_model_ray_weight: 354702725003401265719533688488721599702310771690525950822723418612301824.00000# Target Acquisition (Ray-Casting) Throughput without Motion
print(bf_tp_ray_movement)Estimated Bayes factor in favor of tp_model_ray over tp_model_ray_movement: 22242811702178469876925861022274648360435609589962739350233775066912835195327115534771302010582580498352697787396211565501640883188028576125956592795310525932445432793799248767590835617538521847065214976.00000# Effect of Weight on Target Acquisition Throughput
combined_weight_plot
# Effect of Motion on Target Acquisition Throughput
combined_motion_plot
# Interaction Effect of Weight and Motion on Target Acquisition Throughput
combined_interaction_plot
This section contains the analysis of text entry task performed in the paper.
This section presents the text entry throughput models and the corresponding outcomes from the text entry task.
text_nozero <- text %>% filter(TP > 0)ggplot(text_nozero, aes(x = TP)) +
geom_histogram(binwidth = 0.2, color = "black", fill = "blue") +
labs(title = "Histogram of Throughput", x = "Throughput", y = "Frequency")
tp_nozero_model <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + weight * movement,
text_nozero,
family = gaussian(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(tp_nozero_model, file = "brm_model/tp_nozero_model.rds")tp_nozero_model <- readRDS("brm_model/tp_nozero_model.rds")
summary(tp_nozero_model) Family: gaussian
Links: mu = identity; sigma = identity
Formula: TP ~ 1 + (1 | participant) + iterationNum + exercise + weight * movement
Data: text_nozero (Number of observations: 882)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.77 0.11 0.58 1.03 1.00 1506 3217
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept 4.44 0.24 3.99 4.92 1.00 1206
iterationNum 0.17 0.02 0.13 0.21 1.00 8756
exercise -0.00 0.02 -0.04 0.04 1.00 1330
weight -0.82 0.12 -1.05 -0.58 1.00 4747
movementWalking -2.52 0.11 -2.74 -2.31 1.00 4300
weight:movementWalking 0.52 0.17 0.19 0.86 1.00 3974
Tail_ESS
Intercept 2093
iterationNum 5554
exercise 2366
weight 5597
movementWalking 5857
weight:movementWalking 5115
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 1.05 0.03 1.00 1.10 1.00 9107 6121
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior Probability Check
# Text Entry Throughput Model
pp_check(tp_nozero_model)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Text Entry Throughput Model
post <- as_draws_df(tp_nozero_model)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0 Motion Probability: 0 Weight x Motion Probability: 0.9985Bayes Factor
# Text Entry Throughput without Weight
tp_nozero_model_weight <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + movement, text_nozero, family = gaussian(), iter = 4000, save_pars = save_pars(all = TRUE))
saveRDS(tp_nozero_model_weight, file = "brm_model/tp_nozero_model_weight.rds")
# Text Entry Throughput without Motion
tp_nozero_model_movement <- brm(TP ~ 1 + (1|participant) + iterationNum + exercise + weight, text_nozero, family = gaussian(), iter = 4000, save_pars = save_pars(all = TRUE))
saveRDS(tp_nozero_model_movement, file = "brm_model/tp_nozero_model_movement.rds")tp_nozero_model_weight <- readRDS("brm_model/tp_nozero_model_weight.rds")
tp_nozero_model_movement <- readRDS("brm_model/tp_nozero_model_movement.rds")
bf_tp_weight <- bayes_factor(tp_nozero_model, tp_nozero_model_weight)
bf_tp_movement <- bayes_factor(tp_nozero_model, tp_nozero_model_movement)# Text Entry Throughput without Weight
print(bf_tp_weight)Estimated Bayes factor in favor of tp_nozero_model over tp_nozero_model_weight: 4660427286.16737# Text Entry Throughput without Motion
print(bf_tp_movement)Estimated Bayes factor in favor of tp_nozero_model over tp_nozero_model_movement: 32172716177568100452049714312465671137546631882506495229276867284328419644235462520188214626347686245744933880213869909517975375369632804274962432.00000# Effect of Weight on Text Entry Throughput
combined_weight_plot
# Effect of Motion on Text Entry Throughput
combined_motion_plot
# Interaction Effect of Weight and Motion on Text Entry Throughput
combined_interaction_plot
Model for uncorrected error rate
ggplot(text_nozero, aes(x = UER)) +
geom_histogram(binwidth = 0.01, color = "black", fill = "blue") +
labs(title = "Histogram of UER", x = "UER", y = "Frequency")
uer_nozero_model <- brm(UER ~ 1 + (1|participant) + iterationNum + exercise + weight * movement,
text_nozero,
family = zero_inflated_beta(),
save_pars = save_pars(all = TRUE))
saveRDS(uer_nozero_model, file = "brm_model/uer_nozero_model.rds")uer_nozero_model <- readRDS("brm_model/uer_nozero_model.rds")
summary(uer_nozero_model) Family: zero_inflated_beta
Links: mu = logit; phi = identity; zi = identity
Formula: UER ~ 1 + (1 | participant) + iterationNum + exercise + weight * movement
Data: text_nozero (Number of observations: 881)
Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
total post-warmup draws = 4000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.40 0.10 0.23 0.61 1.00 1749 2504
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept -1.38 0.27 -1.93 -0.85 1.00 3222
iterationNum -0.02 0.04 -0.09 0.05 1.00 7588
exercise 0.01 0.01 -0.01 0.04 1.00 3298
weight 0.55 0.28 -0.01 1.11 1.00 3606
movementWalking 0.63 0.22 0.19 1.08 1.00 3746
weight:movementWalking -0.57 0.34 -1.23 0.09 1.00 3538
Tail_ESS
Intercept 2960
iterationNum 2800
exercise 2758
weight 3307
movementWalking 2882
weight:movementWalking 3046
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 1.94 0.14 1.67 2.22 1.00 6018 2819
zi 0.61 0.02 0.57 0.64 1.00 8660 2802
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).pp_check(uer_nozero_model)Using 10 posterior draws for ppc type 'dens_overlay' by default.
post <- as_draws_df(uer_nozero_model)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)))Weight Probability: 0.972 Motion Probability: 0.9975Model for corrected error rate
ggplot(text_nozero, aes(x = CER)) +
geom_histogram(binwidth = 0.01, color = "black", fill = "blue") +
labs(title = "Histogram of CER", x = "Log(CER)", y = "Frequency")
cer_nozero_model <- brm(CER ~ 1 + (1|participant) + iterationNum + exercise + weight * movement,
text_nozero,
family = zero_inflated_beta(),
save_pars = save_pars(all = TRUE))
saveRDS(cer_nozero_model, file = "brm_model/cer_nozero_model.rds")cer_nozero_model <- readRDS("brm_model/cer_nozero_model.rds")
summary(cer_nozero_model) Family: zero_inflated_beta
Links: mu = logit; phi = identity; zi = identity
Formula: CER ~ 1 + (1 | participant) + iterationNum + exercise + weight * movement
Data: text_nozero (Number of observations: 881)
Draws: 4 chains, each with iter = 2000; warmup = 1000; thin = 1;
total post-warmup draws = 4000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.16 0.04 0.09 0.25 1.00 1578 2530
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept -2.45 0.10 -2.64 -2.27 1.00 4039
iterationNum -0.03 0.02 -0.06 -0.00 1.00 7692
exercise 0.00 0.01 -0.01 0.01 1.00 3274
weight -0.07 0.10 -0.26 0.13 1.00 3997
movementWalking 0.47 0.08 0.32 0.63 1.00 3982
weight:movementWalking 0.20 0.12 -0.04 0.44 1.00 3978
Tail_ESS
Intercept 3051
iterationNum 2923
exercise 2694
weight 3110
movementWalking 3215
weight:movementWalking 3451
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 25.08 1.53 22.20 28.23 1.00 7487 2958
zi 0.30 0.02 0.27 0.34 1.00 8315 2529
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior Probability Check
# Text Entry UER Model
pp_check(uer_nozero_model)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Text Entry UER Model
post <- as_draws_df(uer_nozero_model)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0.972 Motion Probability: 0.9975 Weight x Motion Probability: 0.045# Text Entry CER Model
pp_check(cer_nozero_model)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Text Entry CER Model
post <- as_draws_df(cer_nozero_model)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0.24075 Motion Probability: 1 Weight x Motion Probability: 0.945Bayes Factor
# Text Entry UER without Weight
uer_nozero_model_weight <- brm(UER ~ 1 + (1|participant) + iterationNum + exercise + movement, text_nozero, family = zero_inflated_beta(), save_pars = save_pars(all = TRUE))
saveRDS(uer_nozero_model_weight, file = "brm_model/uer_nozero_model_weight.rds")
# Text Entry UER without Motion
uer_nozero_model_movement <- brm(UER ~ 1 + (1|participant) + iterationNum + exercise + weight, text_nozero, family = zero_inflated_beta(), save_pars = save_pars(all = TRUE))
saveRDS(uer_nozero_model_movement, file = "brm_model/uer_nozero_model_movement.rds")
# Text Entry CER without Weight
cer_nozero_model_weight <- brm(CER ~ 1 + (1|participant) + iterationNum + exercise + movement, text_nozero, family = zero_inflated_beta(), save_pars = save_pars(all = TRUE))
saveRDS(cer_nozero_model_weight, file = "brm_model/cer_nozero_model_weight.rds")
# Text Entry CER without Motion
cer_nozero_model_movement <- brm(CER ~ 1 + (1|participant) + iterationNum + exercise + weight, text_nozero, family = zero_inflated_beta(), save_pars = save_pars(all = TRUE))
saveRDS(cer_nozero_model_movement, file = "brm_model/cer_nozero_model_movement.rds")uer_nozero_model_weight <- readRDS("brm_model/uer_nozero_model_weight.rds")
uer_nozero_model_movement <- readRDS("brm_model/uer_nozero_model_movement.rds")
cer_nozero_model_weight <- readRDS("brm_model/cer_nozero_model_weight.rds")
cer_nozero_model_movement <- readRDS("brm_model/cer_nozero_model_movement.rds")
bf_uer_weight <- bayes_factor(uer_nozero_model, uer_nozero_model_weight)
bf_uer_movement <- bayes_factor(uer_nozero_model, uer_nozero_model_movement)
bf_cer_weight <- bayes_factor(cer_nozero_model, cer_nozero_model_weight)
bf_cer_movement <- bayes_factor(cer_nozero_model, cer_nozero_model_movement)# Text Entry UER without Weight
print(bf_uer_weight)Estimated Bayes factor in favor of uer_nozero_model over uer_nozero_model_weight: 0.11244# Text Entry UER without Motion
print(bf_uer_movement)Estimated Bayes factor in favor of uer_nozero_model over uer_nozero_model_movement: 1.30425# Text Entry CER without Weight
print(bf_cer_weight)Estimated Bayes factor in favor of cer_nozero_model over cer_nozero_model_weight: 0.00497# Text Entry CER without Motion
print(bf_cer_movement)Estimated Bayes factor in favor of cer_nozero_model over cer_nozero_model_movement: 9850109666765366624256.00000# Effect of Weight on UER/CER
combined_weight_plot
# Effect of Motion on UER/CER
combined_motion_plot
# Interaction Effect of Weight and Motion on UER/CER
combined_interaction_plot
This section presents the words per minute models and the corresponding outcomes from the text entry task.
ggplot(text_nozero, aes(x = log(WPM))) +
geom_histogram(binwidth = 0.2, color = "black", fill = "blue") +
labs(title = "Histogram of Log-Transformed Data", x = "Log(WPM)", y = "Frequency")
wpm_nozero_model <- brm(WPM ~ 1 + (1|participant) + iterationNum + exercise + weight * movement,
text_nozero,
family = shifted_lognormal(),
iter = 4000,
save_pars = save_pars(all = TRUE))
saveRDS(wpm_nozero_model, file = "brm_model/wpm_nozero_model.rds")wpm_nozero_model <- readRDS("brm_model/wpm_nozero_model.rds")
summary(wpm_nozero_model) Family: shifted_lognormal
Links: mu = identity; sigma = identity; ndt = identity
Formula: WPM ~ 1 + (1 | participant) + iterationNum + exercise + weight * movement
Data: text_nozero (Number of observations: 882)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~participant (Number of levels: 30)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sd(Intercept) 0.20 0.03 0.15 0.27 1.00 1886 3475
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept 2.48 0.07 2.35 2.61 1.00 1981
iterationNum 0.07 0.01 0.06 0.08 1.00 12611
exercise 0.00 0.01 -0.01 0.01 1.00 1954
weight -0.18 0.04 -0.26 -0.09 1.00 5877
movementWalking -0.61 0.04 -0.68 -0.53 1.00 5544
weight:movementWalking 0.01 0.06 -0.11 0.13 1.00 4765
Tail_ESS
Intercept 3551
iterationNum 5964
exercise 3210
weight 6812
movementWalking 6185
weight:movementWalking 6278
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
sigma 0.36 0.01 0.34 0.38 1.00 12774 6160
ndt 0.01 0.01 0.00 0.03 1.00 8901 4308
Draws were sampled using sampling(NUTS). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).Posterior Probability Check
# Text Entry WPM Model
pp_check(wpm_nozero_model)Using 10 posterior draws for ppc type 'dens_overlay' by default.
# Text Entry WPM Model
post <- as_draws_df(wpm_nozero_model)
cat("Weight Probability:", as.character(mean(post$b_weight > 0)),
"Motion Probability:", as.character(mean(post$b_movementWalking > 0)),
"Weight x Motion Probability:", as.character(mean(post$`b_weight:movementWalking` > 0)))Weight Probability: 0 Motion Probability: 0 Weight x Motion Probability: 0.567Bayes Factor
# Text Entry WPM without Weight
wpm_nozero_model_weight <- brm(WPM ~ 1 + (1|participant) + iterationNum + exercise + movement, text_nozero, family = gaussian(), iter = 4000, save_pars = save_pars(all = TRUE))
saveRDS(wpm_nozero_model_weight, file = "brm_model/wpm_nozero_model_weight.rds")
# Text Entry WPM without Motion
wpm_nozero_model_movement <- brm(WPM ~ 1 + (1|participant) + iterationNum + exercise + weight, text_nozero, family = gaussian(), iter = 4000, save_pars = save_pars(all = TRUE))
saveRDS(wpm_nozero_model_movement, file = "brm_model/wpm_nozero_model_movement.rds")wpm_nozero_model_weight <- readRDS("brm_model/wpm_nozero_model_weight.rds")
wpm_nozero_model_movement <- readRDS("brm_model/wpm_nozero_model_movement.rds")
bf_wpm_weight <- bayes_factor(wpm_nozero_model, wpm_nozero_model_weight)
bf_wpm_movement <- bayes_factor(wpm_nozero_model, wpm_nozero_model_movement)# Text Entry WPM without Weight
print(bf_wpm_weight)Estimated Bayes factor in favor of wpm_nozero_model over wpm_nozero_model_weight: 0.00000# Text Entry WPM without Motion
print(bf_wpm_movement)Estimated Bayes factor in favor of wpm_nozero_model over wpm_nozero_model_movement: 6977298496252057787610597680695399150514446794752.00000# Effect of Weight on Words Per Minute
combined_weight_plot
# Effect of Motion on Words Per Minute
combined_motion_plot
# Interaction Effect of Weight and Motion on Words Per Minute
combined_interaction_plot