E1 Extras

Analysis
R
Published

March 13, 2024

plot_violin_condit <- function(fcondit, fvb, pvar) {

  full_range <- testAvg |> pull({{pvar}}) |> range(na.rm=TRUE)
  testAvg |>
    filter(condit == fcondit, vb==fvb) |> 
    ggplot(aes(.data[[pvar]])) +
    geom_density(fill = 'dodgerblue4') +
    theme_void() +
    coord_cartesian(xlim = full_range)
}

unique_combinations = testAvg |> ungroup() |>
  distinct(condit, vb)

testAvg |> group_by(condit,vb) |> 
  summarize(mean=mean(dist),sd=sd(dist)) |> 
  mutate(Distribution=vb) |> 
  gt() |>
  tab_spanner(
    label = 'Training Condit',
    columns = -condit
  ) |> 
  cols_label_with(fn = str_to_title) |> 
  fmt_number(decimals = 2) |> 
  cols_align('left', columns = condit) |> 
  text_transform(
    locations = cells_body(columns = 'Distribution'),
    fn = function(column) {
      map2(unique_combinations$condit, unique_combinations$vb,~plot_violin_condit(.x,.y,'vx')) |>
        ggplot_image(height = px(50), aspect_ratio = 3)
    }
  )
Training Condit
Vb Mean Sd Distribution
Constant
100-300 252.99 219.63
350-550 191.58 159.52
600-800 150.40 110.83
800-1000 188.91 160.60
1000-1200 240.57 173.05
1200-1400 295.42 186.14
Varied
100-300 387.25 343.45
350-550 289.01 272.48
600-800 236.17 188.89
800-1000 224.16 145.95
1000-1200 209.20 130.32
1200-1400 242.13 136.30 
vars_to_plot <- c('dist', 'vx')

tables <- map(vars_to_plot, function(pvar) {
  testAvg |>
    group_by(condit, vb) |>
    summarize(mean = mean(.data[[pvar]]), sd = sd(.data[[pvar]])) |>
    mutate(Distribution = vb) |>
    gt() |>
    tab_spanner(
      label = 'Training Condit',
      columns = -condit
    ) |>
    cols_label_with(fn = str_to_title) |>
    fmt_number(decimals = 2) |>
    cols_align('left', columns = condit) |>
    text_transform(
      locations = cells_body(columns = 'Distribution'),
      fn = function(column) {
        map2(unique_combinations$condit, unique_combinations$vb, ~plot_violin_condit(.x, .y, pvar)) |>
          ggplot_image(height = px(50), aspect_ratio = 3)
      }
    )
})
#print(tables[[1]])
#print(tables[[2]])

library(gtExtras)
gt_two_column_layout(tables)
Training Condit
Vb Mean Sd Distribution
Constant
100-300 252.99 219.63
350-550 191.58 159.52
600-800 150.40 110.83
800-1000 188.91 160.60
1000-1200 240.57 173.05
1200-1400 295.42 186.14
Varied
100-300 387.25 343.45
350-550 289.01 272.48
600-800 236.17 188.89
800-1000 224.16 145.95
1000-1200 209.20 130.32
1200-1400 242.13 136.30
Training Condit
Vb Mean Sd Distribution
Constant
100-300 522.83 245.10
350-550 660.61 224.30
600-800 771.75 210.50
800-1000 1,008.76 254.58
1000-1200 1,173.42 307.89
1200-1400 1,306.99 355.81
Varied
100-300 665.49 365.02
350-550 772.47 321.45
600-800 879.54 291.57
800-1000 1,070.25 248.79
1000-1200 1,180.70 265.92
1200-1400 1,269.34 291.65 
#https://modelsummary.com/articles/datasummary.html

datasummary(vx*vb ~ Mean + SD + Histogram, data = testAvg)
vb Mean SD Histogram
vx 100-300 592.33 316.56 ▂▆▇▄▂▃▂▁▁
350-550 715.10 280.69 ▁▅▇▇▅▃▂▁▁▁
600-800 824.26 258.15 ▁▅▅▇▅▃▂▁▁▁
800-1000 1038.72 252.85 ▁▃▆▆▇▃▂▁▁
1000-1200 1176.96 287.31 ▁▂▄▆▇▅▃▂▁▁
1200-1400 1288.65 325.64 ▂▄▅▇▅▃▁▂▁ 
datasummary(vx*vb*condit ~ Mean + SD + Histogram, data = testAvg)
vb condit Mean SD Histogram
vx 100-300 Constant 522.83 245.10 ▁▅▅▇▄▃▂▁▂▁
Varied 665.49 365.02 ▄▇▇▂▁▅▃▂▂▁
350-550 Constant 660.61 224.30 ▁▃▅▇▇▃▂▂ ▁
Varied 772.47 321.45 ▄▄▇▄▃▂▁▂▁▂
600-800 Constant 771.75 210.50 ▁▄▆▃▇▄▂▁▂▁
Varied 879.54 291.57 ▃▄▄▇▇▄▂▁▂▂
800-1000 Constant 1008.76 254.58 ▂▄▇▆▅▂▁▁
Varied 1070.25 248.79 ▁▂▅▃▅▇▄▃▁▂
1000-1200 Constant 1173.42 307.89 ▁▂▅▆▇▆▃▂ ▃
Varied 1180.70 265.92 ▁▂▄▆▇▆▃▃▁▃
1200-1400 Constant 1306.99 355.81 ▂▄▆▇▄▃▁▃▁
Varied 1269.34 291.65 ▂▄▂▅▆▇▄▂▁ 
datasummary(vx*vb*condit ~ Mean + SD + Histogram, data = test)
vb condit Mean SD Histogram
vx 100-300 Constant 524.28 326.84 ▅▇▆▃▂▁▁
Varied 663.96 448.23 ▅▇▄▃▂▂▁
350-550 Constant 658.76 302.96 ▁▅▇▆▄▂▁
Varied 767.77 401.84 ▂▇▆▄▃▂▁▁
600-800 Constant 770.39 299.50 ▁▄▇▆▄▃▁
Varied 876.49 389.91 ▁▆▇▆▄▃▂▁
800-1000 Constant 1000.54 356.85 ▃▇▆▃▂▁
Varied 1063.94 369.78 ▂▅▆▇▄▃▁
1000-1200 Constant 1166.65 429.75 ▁▂▅▇▄▂▁
Varied 1180.43 372.22 ▁▄▇▇▅▂▁
1200-1400 Constant 1282.55 482.56 ▁▂▄▇▆▃▂▂▁
Varied 1264.68 411.92 ▁▂▄▇▆▄▃▁ 
datasummary_crosstab(vb ~ condit * tOrder, data = test)
Constant
Varied
vb testFirst trainFirst testFirst trainFirst All
100-300 N 671 493 564 544 2272
% row 29.5 21.7 24.8 23.9 100.0
350-550 N 679 499 573 543 2294
% row 29.6 21.8 25.0 23.7 100.0
600-800 N 673 497 573 543 2286
% row 29.4 21.7 25.1 23.8 100.0
800-1000 N 265 197 224 214 900
% row 29.4 21.9 24.9 23.8 100.0
1000-1200 N 250 190 228 206 874
% row 28.6 21.7 26.1 23.6 100.0
1200-1400 N 244 187 226 208 865
% row 28.2 21.6 26.1 24.0 100.0
All N 2782 2063 2388 2258 9491
% row 29.3 21.7 25.2 23.8 100.0 
datasummary_crosstab(result ~ condit,
                     statistic = 1 ~ Percent("col"),
                     data = test)
result Constant  Varied
Hit % col 25.0 21.4
Over % col 52.5 59.0
Under % col 22.6 19.7
All % col 100.0 100.0 
datasummary_crosstab(result ~ condit*vb,
                     statistic = 1 ~ Percent("col"),
                     data = test)
Constant
Varied
result  100-300  350-550  600-800  800-1000  1000-1200  1200-1400  100-300  350-550  600-800  800-1000  1000-1200  1200-1400
Hit % col 25.3 24.7 28.1 28.1 21.8 16.2 20.1 24.7 20.7 19.4 21.0 19.8
Over % col 71.6 60.1 40.4 42.4 41.6 34.6 77.9 63.7 51.8 53.9 47.2 33.9
Under % col 3.2 15.2 31.5 29.4 36.6 49.2 2.0 11.6 27.5 26.7 31.8 46.3
All % col 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 100.0 
datasummary(vx+dist+vy ~ mean *condit*vb,
            data = e1)
Constant
Varied
 100-300  350-550  600-800  800-1000  1000-1200  1200-1400  100-300  350-550  600-800  800-1000  1000-1200  1200-1400
vx 509.05 644.81 760.25 927.21 1166.65 1282.55 611.22 733.03 848.60 1012.53 1103.13 1185.13
dist 240.32 178.74 145.34 137.17 232.80 287.09 338.27 258.83 215.48 204.68 204.51 260.39
vy 81.42 115.76 157.74 206.72 244.71 276.07 92.91 126.21 158.92 189.22 209.89 230.23 
datasummary(Heading("X Velocity")*vx+Heading("Abs. Deviation")*dist+vy ~ mean *condit*vb,
            data = e1)
Constant
Varied
 100-300  350-550  600-800  800-1000  1000-1200  1200-1400  100-300  350-550  600-800  800-1000  1000-1200  1200-1400
X Velocity 509.05 644.81 760.25 927.21 1166.65 1282.55 611.22 733.03 848.60 1012.53 1103.13 1185.13
Abs. Deviation 240.32 178.74 145.34 137.17 232.80 287.09 338.27 258.83 215.48 204.68 204.51 260.39
vy 81.42 115.76 157.74 206.72 244.71 276.07 92.91 126.21 158.92 189.22 209.89 230.23 
datasummary(vx + dist ~ Factor(condit) * (mean + sd),
            data = test)
Constant
Varied
mean sd mean sd
vx 787.61 423.16 882.02 452.04
dist 207.76 254.08 279.52 329.31 
datasummary(vx + dist ~ Factor(condit)*vb * (mean + sd),
            data = test)
Constant
Varied
100-300
350-550
600-800
800-1000
1000-1200
1200-1400
100-300
350-550
600-800
800-1000
1000-1200
1200-1400
mean sd mean sd mean sd mean sd mean sd mean sd mean sd mean sd mean sd mean sd mean sd mean sd
vx 524.28 326.84 658.76 302.96 770.39 299.50 1000.54 356.85 1166.65 429.75 1282.55 482.56 663.96 448.23 767.77 401.84 876.49 389.91 1063.94 369.78 1180.43 372.22 1264.68 411.92
dist 253.85 297.56 190.57 229.23 150.01 184.41 183.91 241.99 232.80 282.14 287.09 290.25 385.65 426.23 285.04 340.41 234.14 269.93 220.87 248.39 207.87 226.43 241.93 234.68 
datasummary(vb*Factor(condit) * (mean + sd) ~ vx + dist,
            data = test)
vb condit vx dist
100-300 Constant mean 524.28 253.85
sd 326.84 297.56
Varied mean 663.96 385.65
sd 448.23 426.23
350-550 Constant mean 658.76 190.57
sd 302.96 229.23
Varied mean 767.77 285.04
sd 401.84 340.41
600-800 Constant mean 770.39 150.01
sd 299.50 184.41
Varied mean 876.49 234.14
sd 389.91 269.93
800-1000 Constant mean 1000.54 183.91
sd 356.85 241.99
Varied mean 1063.94 220.87
sd 369.78 248.39
1000-1200 Constant mean 1166.65 232.80
sd 429.75 282.14
Varied mean 1180.43 207.87
sd 372.22 226.43
1200-1400 Constant mean 1282.55 287.09
sd 482.56 290.25
Varied mean 1264.68 241.93
sd 411.92 234.68 
tmp <- mtcars[, c("mpg", "hp")]

# create a list with individual variables
# remove missing and rescale
tmp_list <- lapply(tmp, na.omit)
tmp_list <- lapply(tmp_list, scale)

# create a table with `datasummary`
# add a histogram with column_spec and spec_hist
# add a boxplot with colun_spec and spec_box
emptycol = function(x) " "
datasummary(mpg + hp ~ Mean + SD + Heading("Boxplot") * emptycol + Heading("Histogram") * emptycol,
    output = "kableExtra",
    data = tmp) %>%
    kableExtra::column_spec(column = 4, image = spec_boxplot(tmp_list)) %>%
    kableExtra::column_spec(column = 5, image = spec_hist(tmp_list))
Mean SD Boxplot Histogram
mpg 20.09 6.03
hp 146.69 68.56 
tmp_list <- lapply(test |> ungroup() |> select(vx,vb,condit), na.omit)
# scale only numeric columns - not all are numeric so can't just lapply

tmp_list <- map(tmp_list, ~if(is.numeric(.x)) scale(.x) else .x)

ts=test |> ungroup() |> select(vx,vb,condit) |> mutate(vxScale=scale(vx)[,1])

 datasummary(vxScale*vb ~  Mean + Histogram,
            data=ts, output = "kableExtra")  %>%
    kableExtra::column_spec(column = 4, image = spec_boxplot(ts))
Warning in ensure_len_html(image, nrows, "image"): The number of provided
values in image does not equal to the number of rows.
vb Mean Histogram
vxScale 100-300 −0.55 ▆▇▄▂▁▁
350-550 −0.28 ▂▇▇▅▃▁▁
600-800 −0.03 ▁▅▇▅▃▂▁
800-1000 0.45 ▁▃▇▇▄▂▁
1000-1200 0.77 ▂▅▇▅▂▁
1200-1400 1.00 ▂▄▇▆▄▂▁ 
datasummary(vx*vb ~  Mean + Median+ SD + Histogram,
            data=test, output = "markdown")
vb Mean Median SD Histogram
vx 100-300 592.40 477.71 396.88 ▆▇▄▂▁▁
350-550 711.79 646.42 358.61 ▂▇▇▅▃▁▁
600-800 822.19 764.23 350.56 ▁▅▇▅▃▂▁
800-1000 1031.39 988.06 364.38 ▁▃▇▇▄▂▁
1000-1200 1173.49 1144.20 402.04 ▂▅▇▅▂▁
1200-1400 1273.58 1237.95 448.34 ▂▄▇▆▄▂▁ 
datasummary(dist*vb ~  Mean + Median+ SD + Histogram,
            data=test, output = "markdown")
vb Mean Median SD Histogram
dist 100-300 318.12 177.71 371.81 ▇▂▁▁▁
350-550 236.53 126.28 292.49 ▇▂▁▁
600-800 191.08 111.93 233.93 ▇▃▁▁
800-1000 201.90 131.15 245.69 ▇▃▁▁
1000-1200 220.42 149.37 256.15 ▇▃▁▁
1200-1400 264.43 197.72 264.65 ▇▄▂▂▁▁ 
datasummary(vx*vb*condit ~  Mean + Histogram,
            data=test, output = "kableExtra")  %>%
    kableExtra::column_spec(column = 5, image = spec_boxplot(tmp_list)) 
Warning in ensure_len_html(image, nrows, "image"): The number of provided
values in image does not equal to the number of rows.
vb condit Mean Histogram
vx 100-300 Constant 524.28 ▅▇▆▃▂▁▁
Varied 663.96 ▅▇▄▃▂▂▁
350-550 Constant 658.76 ▁▅▇▆▄▂▁
Varied 767.77 ▂▇▆▄▃▂▁▁
600-800 Constant 770.39 ▁▄▇▆▄▃▁
Varied 876.49 ▁▆▇▆▄▃▂▁
800-1000 Constant 1000.54 ▃▇▆▃▂▁
Varied 1063.94 ▂▅▆▇▄▃▁
1000-1200 Constant 1166.65 ▁▂▅▇▄▂▁
Varied 1180.43 ▁▄▇▇▅▂▁
1200-1400 Constant 1282.55 ▁▂▄▇▆▃▂▂▁
Varied 1264.68 ▁▂▄▇▆▄▃▁ 
cap <- "Testing - No Feedback"
f <- (`Condit` = condit) ~ (` ` = vx) * (`Distribution` = Histogram) + vx * vb * ((`Avg.` = Mean)*Arguments(fmt='%.0f') + (`SD` = SD)*Arguments(fmt='%.0f'))

datasummary(f,
            data = test,
            output = 'gt',
            title = cap,
            notes = 'Artwork by @Thomas',
            sparse_header = TRUE)
Testing - No Feedback
Condit Distribution 100-300 350-550 600-800 800-1000 1000-1200 1200-1400
Avg. SD Avg. SD Avg. SD Avg. SD Avg. SD Avg. SD
Constant ▃▇▇▄▂▁ 524 327 659 303 770 300 1001 357 1167 430 1283 483
Varied ▃▇▇▆▄▃▁ 664 448 768 402 876 390 1064 370 1180 372 1265 412
Artwork by @Thomas 
f <- (`Band` = vb) ~ (` ` = vx) * (`Distribution` = Histogram) + vx * condit * ((`Avg.` = Mean)*Arguments(fmt='%.0f') + (`SD` = SD)*Arguments(fmt='%.0f'))

datasummary(f,
            data = test,
            output = 'gt',
            title = cap,
            notes = 'Artwork by @Thomas',
            sparse_header = TRUE)
Testing - No Feedback
Band Distribution Constant Varied
Avg. SD Avg. SD
100-300 ▆▇▄▂▁▁ 524 327 664 448
350-550 ▂▇▇▅▃▁▁ 659 303 768 402
600-800 ▁▅▇▅▃▂▁ 770 300 876 390
800-1000 ▁▃▇▇▄▂▁ 1001 357 1064 370
1000-1200 ▂▅▇▅▂▁ 1167 430 1180 372
1200-1400 ▂▄▇▆▄▂▁ 1283 483 1265 412
Artwork by @Thomas 
f <- (`Band` = vb) ~ (` ` = vx) * (`Distribution` = Histogram) + vx * condit * expMode2 * ((`Avg.` = Mean)*Arguments(fmt='%.0f') + (`SD` = SD)*Arguments(fmt='%.0f'))

datasummary(f,
            data = e1,
            output = 'gt',
            sparse_header = TRUE)
Constant Varied
Train Train-Nf Test Test-Fb Train Train-Nf Test Test-Fb
Band Distribution Avg. SD Avg. SD Avg. SD Avg. SD Avg. SD Avg. SD Avg. SD Avg. SD
100-300 ▇▇▄▂▁▁ 599 368 524 327 395 265 652 413 664 448 484 406
350-550 ▂▇▅▂▁▁ 714 332 659 303 554 265 754 395 768 402 655 379
600-800 ▁▅▇▄▂▁ 816 321 770 300 688 267 882 393 876 390 770 354
800-1000 ▂▇▄▁ 922 298 1001 357 1002 369 1064 370
1000-1200 ▂▆▇▃▁ 1167 430 1087 383 1180 372
1200-1400 ▁▂▅▇▅▂▁ 1283 483 1169 430 1265 412 
f <- (`Band` = vb)* expMode2 ~ vx * condit  * ((`Avg.` = Mean)*Arguments(fmt='%.0f') + (`SD` = SD)*Arguments(fmt='%.0f'))

datasummary(f,
            data = e1,
            output = 'gt',
            sparse_header = TRUE)
Band expMode2 Constant Varied
Avg. SD Avg. SD
100-300 Train
Train-Nf 599 368 652 413
Test 524 327 664 448
Test-Fb 395 265 484 406
350-550 Train
Train-Nf 714 332 754 395
Test 659 303 768 402
Test-Fb 554 265 655 379
600-800 Train
Train-Nf 816 321 882 393
Test 770 300 876 390
Test-Fb 688 267 770 354
800-1000 Train 922 298 1002 369
Train-Nf
Test 1001 357 1064 370
Test-Fb
1000-1200 Train 1087 383
Train-Nf
Test 1167 430 1180 372
Test-Fb
1200-1400 Train 1169 430
Train-Nf
Test 1283 483 1265 412
Test-Fb 
f <- (`Band` = vb)* expMode2 ~ dist * condit  * ((`Avg.` = Mean)*Arguments(fmt='%.0f') )

datasummary(f,
            data = e1,
            output = 'gt',
            sparse_header = TRUE)
Band expMode2 Constant Varied
Avg. Avg.
100-300 Train
Train-Nf 321 374
Test 254 386
Test-Fb 138 225
350-550 Train
Train-Nf 229 281
Test 191 285
Test-Fb 110 194
600-800 Train
Train-Nf 169 231
Test 150 234
Test-Fb 115 169
800-1000 Train 134 201
Train-Nf
Test 184 221
Test-Fb
1000-1200 Train 204
Train-Nf
Test 233 208
Test-Fb
1200-1400 Train 264
Train-Nf
Test 287 242
Test-Fb 
```{r}
#| label: test vx table
#| tbl-cap: "Testing - No Feedback"
#| tbl-subcap: ["Constant Testing - X Velocity", "Varied Testing - X Velocity"]
#| layout-ncol: 2

result <- test_summary_table(test, "vx", mfun = list(mean = mean, median = median, sd = sd))
result$constant #|> kable_styling(full_width = F)
result$varied #|> kable_styling(full_width = F)
```
# A tibble: 6 × 5
  Band      `Band Type`    Mean Median    Sd
  <fct>     <fct>         <dbl>  <dbl> <dbl>
1 100-300   Extrapolation   524    448   327
2 350-550   Extrapolation   659    624   303
3 600-800   Extrapolation   770    724   300
4 800-1000  Trained        1001    940   357
5 1000-1200 Extrapolation  1167   1104   430
6 1200-1400 Extrapolation  1283   1225   483
# A tibble: 6 × 5
  Band      `Band Type`    Mean Median    Sd
  <fct>     <fct>         <dbl>  <dbl> <dbl>
1 100-300   Extrapolation   664    533   448
2 350-550   Extrapolation   768    677   402
3 600-800   Extrapolation   876    813   390
4 800-1000  Trained        1064   1029   370
5 1000-1200 Trained        1180   1179   372
6 1200-1400 Trained        1265   1249   412
nb=5
vt1=e1 |> filter(expMode=="train") |>
  learn_curve_table(gt.train,vx,gw=Trial_Bin,groupVec=c(id,vb,condit),nbins=nb,prefix="Block_") |>
  rename("Band"=vb,"Group"=condit)
  
vt1 %>% kable() %>% add_header_above(c(" "=2, "Training Block "=1," " = ncol(vt1)-3))
Mean Vx over blocks. Mean (Standard Error)
Training Block
Band Group Block_1 Block_2 Block_3 Block_4 Block_5
800-1000 Constant 921 (11) 941 (8) 912 (7) 907 (7) 931 (7)
800-1000 Varied 970 (20) 975 (17) 1017 (18) 1020 (17) 1029 (16)
1000-1200 Varied 1068 (22) 1100 (19) 1080 (19) 1110 (17) 1080 (15)
1200-1400 Varied 1109 (24) 1183 (19) 1160 (23) 1198 (20) 1200 (18) 
# vt1 %>% gt() %>% tab_options(column_labels.background.color = "#176940",
#                 table.font.size = px(14))

Training Performance

# vpt1=plotWithTable(vp1,vt1,arrange="V")
nb=5
vp1=e1 |> filter(expMode=="train") |> learn_curve_plot(gt.train,vx,condit,facet_var=vb,groupVec=c(gt.train,condit,tOrder,id,vb),nbins=nb)
vp1

#vp1 / gridExtra::tableGrob(vt1)
#vp1 / gt_temp(vt1)
# vt2=e1 |> filter(expMode=="train") |> 
#   learn_curve_table(gt.train,dist,gw=condit,groupVec=c(id,condit,vb),nbins=nb) %>%
#   rename("Block"=Trial_Bin)

vt2=e1 |> filter(expMode=="train") |> 
  learn_curve_table(gt.train,dist,gw=Trial_Bin,groupVec=c(id,condit,vb),nbins=nb,prefix="Block_") %>%
  rename("Band"=vb,"Group"=condit) 
vp2=e1 |> filter(expMode=="train") |> 
  learn_curve_plot(gt.train,dist,condit,facet_var=vb,groupVec=c(gt.train,condit,tOrder,id,vb),nbins=nb) 
vp2
vt3=e1 |> filter(expMode=="train") |> 
  learn_curve_table(gt.train,sdist,gw=Trial_Bin,groupVec=c(id,vb,condit),nbins=nb,prefix="Block_") |>
  rename("Band"=vb,"Group"=condit) 
vt3 %>% kable(format = "html",escape = FALSE)
Signed Deviation over blocks. Mean (Standard Error)
Band Group Block_1 Block_2 Block_3 Block_4 Block_5
800-1000 Constant 24 (9) 34 (6) 13 (6) 10 (5) 28 (5)
800-1000 Varied 64 (17) 61 (13) 96 (15) 102 (14) 104 (13)
1000-1200 Varied -14 (19) 10 (15) -11 (15) 18 (13) -11 (12)
1200-1400 Varied -155 (21) -85 (16) -108 (19) -78 (16) -76 (14) 
vp3=e1 |> filter(expMode=="train") |> learn_curve_plot(gt.train,sdist,condit,facet_var=vb,groupVec=c(gt.train,condit,tOrder,id,vb),nbins=nb) 
vp3
vp4 <- e1 |> filter(expMode=="train") |> group_by(id) |>
  mutate(Trial_Bin = cut(gt.train,breaks = nb,include.lowest=TRUE,labels=FALSE)) |>
  group_by(id,Trial_Bin,condit, vb) |> summarise(nHits=sum(dist==0),n=n(),Percent_Hit=nHits/n) %>%
  learn_curve_plot2(Trial_Bin,Percent_Hit,color_var=condit,facet_var=vb,groupVec=c(id,vb,condit))

22

```{r}
#| layout: [[65, 65],[-5], [1,550, 550]]
#| label: train tables2
#| tbl-subcap:
#|   - "Vx"
#|   - "Deviation from target"
#| eval: false
#|
vt1 %>% kable(format = "html",escape = FALSE)
vt2 %>% kable(format = "html",escape = FALSE)

vp3+big_text()
vp4+big_text()
```

33

```{r}
#| layout: [[65, 65],[-5], [1,350, 350,10]]
#| label: train tables
#| tbl-subcap:
#|   - "Vx"
#|   - "Deviation from target"
#| column: screen-inset-right
#| eval: false
vt1 %>% kable(format = "html",escape = FALSE)
vt2 %>% kable(format = "html",escape = FALSE)

vp3
vp4
```
((vp1+big_text()+vp2+big_text())/(vp3+big_text()+vp4+big_text())) + plot_layout(guides = "collect")

Testing

e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |>  
  ggplot(aes(x = vb, y = dist,fill=condit)) +
    stat_summary(geom = "bar", position=position_dodge(), fun = mean) +
    stat_summary(geom = "errorbar", position=position_dodge(.9), fun.data = mean_se, width = .4, alpha = .7) 

e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |>  ggplot(aes(x = vb, y = dist,fill=condit)) +
    stat_summary(geom = "bar", position=position_dodge(), fun = mean) +
    stat_summary(geom = "errorbar", position=position_dodge(.9), fun.data = mean_se, width = .4, alpha = .7) 

# create a kable table to mirror plot of distance effects for vb and condit 


e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |> group_by(vb,condit) %>% 
  summarise(distMean=mean(dist),distSd=sd(dist)) %>% 
  mutate(meanLab=paste0("Mean=",round(distMean,0)),sdLab=paste0("Sd=",round(distSd,0))) %>% 
  mutate(sumStatLab=paste0(meanLab,"\n",sdLab)) %>% 
  select(vb,condit,sumStatLab) %>% 
  spread(condit,sumStatLab) %>% 
  kable(format = "html",escape = FALSE) %>% 
  kable_styling(font_size = 10)
vb Constant Varied
100-300 Mean=254 Sd=298 Mean=386 Sd=426
350-550 Mean=191 Sd=229 Mean=285 Sd=340
600-800 Mean=150 Sd=184 Mean=234 Sd=270
800-1000 Mean=184 Sd=242 Mean=221 Sd=248
1000-1200 Mean=233 Sd=282 Mean=208 Sd=226
1200-1400 Mean=287 Sd=290 Mean=242 Sd=235 
e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |>  ggplot(aes(x = vb, y = vx,fill=condit)) +
    stat_summary(geom = "bar", position=position_dodge(), fun = mean) +
    stat_summary(geom = "errorbar", position=position_dodge(.9), fun.data = mean_se, width = .4, alpha = .7) 

testAvg |>  ggplot(aes(x = vb, y = vx,fill=condit)) +
    stat_summary(geom = "bar", position=position_dodge(), fun = mean) +
    stat_summary(geom = "errorbar", position=position_dodge(.9), fun.data = mean_se, width = .4, alpha = .7) 

e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |> group_by(vb,condit) %>% 
  summarise(vxMean=mean(vx),vxSd=sd(vx)) %>% 
  mutate(meanLab=paste0("Mean=",round(vxMean,0)),sdLab=paste0("Sd=",round(vxSd,0))) %>% 
  mutate(sumStatLab=paste0(meanLab,"\n",sdLab)) %>% 
  select(vb,condit,sumStatLab) %>% 
  spread(condit,sumStatLab) %>% 
  kable(format = "html",escape = FALSE) %>% 
  kable_styling(font_size = 10)
vb Constant Varied
100-300 Mean=524 Sd=327 Mean=664 Sd=448
350-550 Mean=659 Sd=303 Mean=768 Sd=402
600-800 Mean=770 Sd=300 Mean=876 Sd=390
800-1000 Mean=1001 Sd=357 Mean=1064 Sd=370
1000-1200 Mean=1167 Sd=430 Mean=1180 Sd=372
1200-1400 Mean=1283 Sd=483 Mean=1265 Sd=412 
e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |>  ggplot(aes(x = vb, y = sdist,fill=condit)) +
    stat_summary(geom = "bar", position=position_dodge(), fun = mean) +
    stat_summary(geom = "errorbar", position=position_dodge(.9), fun.data = mean_se, width = .4, alpha = .7) 

testAvg |>  ggplot(aes(x = vb, y = sdist,fill=condit)) +
    stat_summary(geom = "bar", position=position_dodge(), fun = mean) +
    stat_summary(geom = "errorbar", position=position_dodge(.9), fun.data = mean_se, width = .4, alpha = .7) 

e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |> group_by(vb,condit) %>% 
  summarise(sdistMean=mean(sdist),sdistSd=sd(sdist)) %>% 
  mutate(meanLab=paste0("Mean=",round(sdistMean,0)),sdLab=paste0("Sd=",round(sdistSd,0))) %>% 
  mutate(sumStatLab=paste0(meanLab,"\n",sdLab)) %>% 
  select(vb,condit,sumStatLab) %>% 
  spread(condit,sumStatLab) %>% 
  kable(format = "html",escape = FALSE) %>% 
  kable_styling(font_size = 10)
vb Constant Varied
100-300 Mean=252 Sd=299 Mean=385 Sd=427
350-550 Mean=163 Sd=250 Mean=265 Sd=356
600-800 Mean=62 Sd=229 Mean=152 Sd=323
800-1000 Mean=89 Sd=291 Mean=136 Sd=303
1000-1200 Mean=64 Sd=360 Mean=66 Sd=300
1200-1400 Mean=-3 Sd=408 Mean=-25 Sd=336 
testAvg |>  ggplot(aes(x = vb, y = Percent_Hit,fill=condit)) +
    stat_summary(geom = "bar", position=position_dodge(), fun = mean) +
    stat_summary(geom = "errorbar", position=position_dodge(.9), fun.data = mean_se, width = .4, alpha = .7) 

testAvg |> group_by(vb,condit) %>% 
  summarise(Percent_HitMean=mean(Percent_Hit),Percent_HitSd=sd(Percent_Hit)) %>% 
  mutate(meanLab=paste0("Mean=",round(Percent_HitMean,3)),sdLab=paste0("Sd=",round(Percent_HitSd,2))) %>% 
  mutate(sumStatLab=paste0(meanLab,"\n",sdLab)) %>% 
  select(vb,condit,sumStatLab) %>% 
  spread(condit,sumStatLab) %>% 
  kable(format = "html",escape = FALSE) %>% 
  kable_styling(font_size = 10)
vb Constant Varied
100-300 Mean=0.252 Sd=0.26 Mean=0.201 Sd=0.26
350-550 Mean=0.246 Sd=0.19 Mean=0.245 Sd=0.21
600-800 Mean=0.281 Sd=0.17 Mean=0.206 Sd=0.16
800-1000 Mean=0.278 Sd=0.23 Mean=0.19 Sd=0.19
1000-1200 Mean=0.21 Sd=0.2 Mean=0.206 Sd=0.2
1200-1400 Mean=0.161 Sd=0.17 Mean=0.2 Sd=0.19

BandType

create_table(test, "vx")
Summary of vx
Band Band Type Constant Band Type Varied
100-300 Extrapolation Mean=523 SD=245 Extrapolation Mean=665 SD=365
350-550 Extrapolation Mean=661 SD=224 Extrapolation Mean=772 SD=321
600-800 Extrapolation Mean=772 SD=210 Extrapolation Mean=880 SD=292
800-1000 Trained Mean=1009 SD=255 Trained Mean=1070 SD=249
1000-1200 Extrapolation Mean=1173 SD=308 Trained Mean=1181 SD=266
1200-1400 Extrapolation Mean=1307 SD=356 Trained Mean=1269 SD=292 
create_table(test, "Percent_Hit")
Summary of Percent_Hit
Band Band Type Constant Band Type Varied
100-300 Extrapolation Mean=0.252 SD=0.26 Extrapolation Mean=0.201 SD=0.26
350-550 Extrapolation Mean=0.246 SD=0.19 Extrapolation Mean=0.245 SD=0.21
600-800 Extrapolation Mean=0.281 SD=0.17 Extrapolation Mean=0.206 SD=0.16
800-1000 Trained Mean=0.278 SD=0.23 Trained Mean=0.19 SD=0.19
1000-1200 Extrapolation Mean=0.21 SD=0.2 Trained Mean=0.206 SD=0.2
1200-1400 Extrapolation Mean=0.161 SD=0.17 Trained Mean=0.2 SD=0.19

Aggregation

e1 %>%
  filter(expMode %in% c("test-Nf","test-train-nf")) %>%
  group_by(vb, condit, bandType) %>%
  summarise(distMean = mean(dist), distSd = sd(dist)) %>%
  mutate(
    meanLab = paste0("Mean=", round(distMean, 0)),
    sdLab = paste0("Sd=", round(distSd, 0))
  ) %>%
  mutate(sumStatLab = paste0(meanLab, "\n", sdLab)) %>%
  pivot_wider(
    id_cols = c(vb, bandType),
    names_from = condit,
    values_from = sumStatLab
  ) %>%
  arrange(vb, bandType) %>%
  kable(format = "html", escape = FALSE)
vb bandType Constant Varied
100-300 Extrapolation Mean=254 Sd=298 Mean=386 Sd=426
350-550 Extrapolation Mean=191 Sd=229 Mean=285 Sd=340
600-800 Extrapolation Mean=150 Sd=184 Mean=234 Sd=270
800-1000 Trained Mean=184 Sd=242 Mean=221 Sd=248
1000-1200 Trained NA Mean=208 Sd=226
1000-1200 Extrapolation Mean=233 Sd=282 NA
1200-1400 Trained NA Mean=242 Sd=235
1200-1400 Extrapolation Mean=287 Sd=290 NA 
e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |> group_by(vb,condit) %>% 
  summarise(vxMean=mean(vx),vxSd=sd(vx)) %>% 
  mutate(meanLab=paste0("Mean=",round(vxMean,0)),sdLab=paste0("Sd=",round(vxSd,0))) %>% 
  mutate(sumStatLab=paste0(meanLab,"\n",sdLab)) %>% 
  select(vb,condit,sumStatLab) %>% 
  spread(condit,sumStatLab) %>% 
  kable(format = "html",escape = FALSE,caption = "Vx Mean") %>% 
  kable_styling(font_size = 10)
Vx Mean
vb Constant Varied
100-300 Mean=524 Sd=327 Mean=664 Sd=448
350-550 Mean=659 Sd=303 Mean=768 Sd=402
600-800 Mean=770 Sd=300 Mean=876 Sd=390
800-1000 Mean=1001 Sd=357 Mean=1064 Sd=370
1000-1200 Mean=1167 Sd=430 Mean=1180 Sd=372
1200-1400 Mean=1283 Sd=483 Mean=1265 Sd=412 
e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |> group_by(vb,condit) %>% 
  summarise(sdistMean=mean(sdist),sdistSd=sd(sdist)) %>% 
  mutate(meanLab=paste0("Mean=",round(sdistMean,0)),sdLab=paste0("Sd=",round(sdistSd,0))) %>% 
  mutate(sumStatLab=paste0(meanLab,"\n",sdLab)) %>% 
  select(vb,condit,sumStatLab) %>% 
  spread(condit,sumStatLab) %>% 
  kable(format = "html",escape = FALSE,caption = "Signed Deviation Mean") %>% 
  kable_styling(font_size = 10)
Signed Deviation Mean
vb Constant Varied
100-300 Mean=252 Sd=299 Mean=385 Sd=427
350-550 Mean=163 Sd=250 Mean=265 Sd=356
600-800 Mean=62 Sd=229 Mean=152 Sd=323
800-1000 Mean=89 Sd=291 Mean=136 Sd=303
1000-1200 Mean=64 Sd=360 Mean=66 Sd=300
1200-1400 Mean=-3 Sd=408 Mean=-25 Sd=336 
testAvg |> group_by(vb,condit) %>% 
  summarise(Percent_HitMean=mean(Percent_Hit),Percent_HitSd=sd(Percent_Hit)) %>% 
  mutate(meanLab=paste0("Mean=",round(Percent_HitMean,3)),sdLab=paste0("Sd=",round(Percent_HitSd,2))) %>% 
  mutate(sumStatLab=paste0(meanLab,"\n",sdLab)) %>% 
  select(vb,condit,sumStatLab) %>% 
  spread(condit,sumStatLab) %>% 
  kable(format = "html",escape = FALSE,caption = "Mean % Hit") %>% 
  kable_styling(font_size = 10)
Mean % Hit
vb Constant Varied
100-300 Mean=0.252 Sd=0.26 Mean=0.201 Sd=0.26
350-550 Mean=0.246 Sd=0.19 Mean=0.245 Sd=0.21
600-800 Mean=0.281 Sd=0.17 Mean=0.206 Sd=0.16
800-1000 Mean=0.278 Sd=0.23 Mean=0.19 Sd=0.19
1000-1200 Mean=0.21 Sd=0.2 Mean=0.206 Sd=0.2
1200-1400 Mean=0.161 Sd=0.17 Mean=0.2 Sd=0.19

Tables Aggregating by Id first

e1 %>% group_by(id, vb, condit) %>%
  summarise(dist = mean(dist), .groups = 'drop') %>%
  group_by(vb, condit) %>%
  summarise(distMean = mean(dist), distSd = sd(dist), .groups = 'drop') %>%
  mutate(
    meanLab = paste0("Mean=", round(distMean, 0)),
    sdLab = paste0("Sd=", round(distSd, 0))
  ) %>%
  mutate(sumStatLab = paste0(meanLab, "\n", sdLab)) %>%
  select(vb, condit, sumStatLab) %>%
  spread(condit, sumStatLab) %>%
  kable(format = "html", escape = FALSE, caption = "Deviation Mean - Aggregate by Id") %>%
  kable_styling(font_size = 11)
Deviation Mean - Aggregate by Id
vb Constant Varied
100-300 Mean=241 Sd=174 Mean=340 Sd=264
350-550 Mean=180 Sd=121 Mean=261 Sd=202
600-800 Mean=146 Sd=76 Mean=218 Sd=145
800-1000 Mean=138 Sd=57 Mean=206 Sd=86
1000-1200 Mean=241 Sd=173 Mean=206 Sd=74
1200-1400 Mean=295 Sd=186 Mean=261 Sd=70 
e1 %>%
  filter(expMode %in% c("test-Nf", "test-train-nf")) %>%
  group_by(id, vb, condit) %>%
  summarise(vx = mean(vx), .groups = 'drop') %>%
  group_by(vb, condit) %>%
  summarise(vxMean = mean(vx), vxSd = sd(vx), .groups = 'drop') %>%
  mutate(
    meanLab = paste0("Mean=", round(vxMean, 0)),
    sdLab = paste0("Sd=", round(vxSd, 0))
  ) %>%
  mutate(sumStatLab = paste0(meanLab, "\n", sdLab)) %>%
  select(vb, condit, sumStatLab) %>%
  spread(condit, sumStatLab) %>%
  kable(format = "html", escape = FALSE, caption = "Vx Mean - Aggregate by Id") %>%
  kable_styling(font_size = 11)
Vx Mean - Aggregate by Id
vb Constant Varied
100-300 Mean=523 Sd=245 Mean=665 Sd=365
350-550 Mean=661 Sd=224 Mean=772 Sd=321
600-800 Mean=772 Sd=210 Mean=880 Sd=292
800-1000 Mean=1009 Sd=255 Mean=1070 Sd=249
1000-1200 Mean=1173 Sd=308 Mean=1181 Sd=266
1200-1400 Mean=1307 Sd=356 Mean=1269 Sd=292 
e1 %>%
  filter(expMode %in% c("test-Nf", "test-train-nf")) %>%
  group_by(id, vb, condit) %>%
  summarise(sdist = mean(sdist), .groups = 'drop') %>%
  group_by(vb, condit) %>%
  summarise(sdistMean = mean(sdist), sdistSd = sd(sdist), .groups = 'drop') %>%
  mutate(
    meanLab = paste0("Mean=", round(sdistMean, 0)),
    sdLab = paste0("Sd=", round(sdistSd, 0))
  ) %>%
  mutate(sumStatLab = paste0(meanLab, "\n", sdLab)) %>%
  select(vb, condit, sumStatLab) %>%
  spread(condit, sumStatLab) %>%
  kable(format = "html", escape = FALSE, caption = "Signed Distance Mean - Aggregate by Id") %>%
  kable_styling(font_size = 11)
Signed Distance Mean - Aggregate by Id
vb Constant Varied
100-300 Mean=251 Sd=221 Mean=386 Sd=344
350-550 Mean=164 Sd=181 Mean=270 Sd=286
600-800 Mean=63 Sd=156 Mean=155 Sd=241
800-1000 Mean=96 Sd=206 Mean=141 Sd=196
1000-1200 Mean=70 Sd=253 Mean=66 Sd=209
1200-1400 Mean=17 Sd=297 Mean=-20 Sd=232 
testAvg %>%
  group_by(id, vb, condit) %>%
  summarise(Percent_Hit = mean(Percent_Hit), .groups = 'drop') %>%
  group_by(vb, condit) %>%
  summarise(
    Percent_HitMean = mean(Percent_Hit),
    Percent_HitSd = sd(Percent_Hit),
    .groups = 'drop'
  ) %>%
  mutate(
    meanLab = paste0("Mean=", round(Percent_HitMean, 3)),
    sdLab = paste0("Sd=", round(Percent_HitSd, 2))
  ) %>%
  mutate(sumStatLab = paste0(meanLab, "\n", sdLab)) %>%
  select(vb, condit, sumStatLab) %>%
  spread(condit, sumStatLab) %>%
  kable(format = "html", escape = FALSE, caption = "Mean % Hit - Aggregate by Id") %>%
  kable_styling(font_size = 10)
Mean % Hit - Aggregate by Id
vb Constant Varied
100-300 Mean=0.252 Sd=0.26 Mean=0.201 Sd=0.26
350-550 Mean=0.246 Sd=0.19 Mean=0.245 Sd=0.21
600-800 Mean=0.281 Sd=0.17 Mean=0.206 Sd=0.16
800-1000 Mean=0.278 Sd=0.23 Mean=0.19 Sd=0.19
1000-1200 Mean=0.21 Sd=0.2 Mean=0.206 Sd=0.2
1200-1400 Mean=0.161 Sd=0.17 Mean=0.2 Sd=0.19

Tables that also indicate bandType

# Create the Constant table
constant_table <- e1 %>%
  filter(expMode %in% c("test-Nf", "test-train-nf")) %>%
  group_by(vb, bandType, condit) %>%
  summarise(distMean = mean(dist), distSd = sd(dist)) %>%
  filter(condit == "Constant") %>%
  mutate(
    meanLab = paste0("Mean=", round(distMean, 0)),
    sdLab = paste0("Sd=", round(distSd, 0)),
    sumStatLab = paste0(meanLab, "\n", sdLab)
  ) %>%
  select(vb, bandType, sumStatLab) %>%
  rename(Constant = sumStatLab)

# Create the Varied table
varied_table <- e1 %>%
  filter(expMode %in% c("test-Nf", "test-train-nf")) %>%
  group_by(vb, bandType, condit) %>%
  summarise(distMean = mean(dist), distSd = sd(dist)) %>%
  filter(condit == "Varied") %>%
  mutate(
    meanLab = paste0("Mean=", round(distMean, 0)),
    sdLab = paste0("Sd=", round(distSd, 0)),
    sumStatLab = paste0(meanLab, "\n", sdLab)
  ) %>%
  select(vb, bandType, sumStatLab) %>%
  rename(Varied = sumStatLab)

# Merge tables
final_table <- full_join(constant_table, varied_table, by = "vb")

# Create the table
final_table %>%
  kbl(digits = c(0, 0, 0, 0, 0),
      caption = "Data summary") %>%
  kable_minimal(full_width = FALSE,
      position = "left") %>%
  add_header_above(c("vb" = 1, "Constant" = 2, "Varied" = 2))
Data summary
vb
Constant
Varied
vb bandType.x Constant bandType.y Varied
100-300 Extrapolation Mean=254 Sd=298 Extrapolation Mean=386 Sd=426
350-550 Extrapolation Mean=191 Sd=229 Extrapolation Mean=285 Sd=340
600-800 Extrapolation Mean=150 Sd=184 Extrapolation Mean=234 Sd=270
800-1000 Trained Mean=184 Sd=242 Trained Mean=221 Sd=248
1000-1200 Extrapolation Mean=233 Sd=282 Trained Mean=208 Sd=226
1200-1400 Extrapolation Mean=287 Sd=290 Trained Mean=242 Sd=235 
rectWidth=.4
vbRect<- e1 %>% group_by(vb) %>% 
  summarise(lowBound=first(bandInt),highBound=first(highBound)) %>% mutate(vbn=as.numeric(vb),
                  vbLag=vbn-rectWidth,vbLead=vbn+rectWidth)

e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |>  ggplot(aes(x = condit, y = vx,fill=vb)) + 
  ggdist::stat_halfeye()


vbRect<- e1 |> group_by(vb) |>
  summarise(lowBound=first(bandInt),highBound=first(highBound)) |> 
  mutate(vbn=as.numeric(vb), rectWidth=.2,
                  vbLag=vbn-rectWidth,vbLead=vbn+rectWidth)

e1 |> filter(expMode %in% c("test-Nf","test-train-nf")) |>  
  ggplot(aes(x = vb, y = vx,fill=vb)) + 
  ggdist::stat_halfeye(alpha=.5) + 
  geom_rect(data=vbRect,aes(xmin=vbLag,xmax=vbLead,ymin=lowBound,ymax=highBound,fill=vb),alpha=.3,inherit.aes = FALSE)+
  scale_y_continuous(expand=expansion(add=100),breaks=round(seq(0,2400,by=200),2)) +
  geom_segment(data=vbRect, aes(x=vbLag,xend=vbLead,y=highBound,yend=highBound),alpha=1,linetype="dashed")+
  geom_segment(data=vbRect, aes(x=vbLag,xend=vbLead,y=lowBound,yend=lowBound),alpha=1,linetype="dashed")+
  geom_text(data=vbRect,aes(x=vbLag-.03,y=lowBound+100,label=vb),angle=90,size=3.5,fontface="bold")


testAvg |>  
  ggplot(aes(x = vb, y = vx,fill=vb)) + 
  ggdist::stat_halfeye(alpha=.5,width=.7) + 
  geom_rect(data=vbRect,aes(xmin=vbLag,xmax=vbLead,ymin=lowBound,ymax=highBound,fill=vb),alpha=.3,inherit.aes = FALSE)+
  facet_wrap(~condit,ncol=1)+
  scale_y_continuous(expand=expansion(add=100),breaks=round(seq(0,2000,by=200),2)) +
  geom_segment(data=vbRect, aes(x=vbLag,xend=vbLead,y=highBound,yend=highBound),alpha=1,linetype="dashed",inherit.aes = FALSE)+
  geom_segment(data=vbRect, aes(x=vbLag,xend=vbLead,y=lowBound,yend=lowBound),alpha=1,linetype="dashed",inherit.aes = FALSE)+
  geom_text(data=vbRect,aes(x=vbLag-.03,y=lowBound+100,label=vb),angle=90,size=5.5,fontface="bold",inherit.aes = FALSE)  
  


# testAvg |>  
#   ggplot(aes(x = vb, y = sdist,fill=vb)) + 
#   ggdist::stat_halfeye(alpha=.5,width=.7) + 
#   facet_wrap(~condit,ncol=1)
# 
# 
# testAvg |>  
#   ggplot(aes(x = vb, y = dist,fill=vb)) + 
#   ggdist::stat_halfeye(alpha=.5,width=.7) + 
#   facet_wrap(~condit,ncol=1)
# 
# 
sumStats2 = test %>% group_by(id,condit,vb) %>%
  summarise(distMean=mean(dist),distMedian=median(dist),distSd=sd(dist)) %>%group_by(condit,vb) %>%
  summarise(groupMean=round(mean(distMean),0),groupMedian=round(mean(distMedian),0),groupSd=round(mean(distSd),0)) %>%
  mutate(meanLab=paste0("Mean=",groupMean),medianLab=paste0("Median=",groupMedian),sdLab=paste0("Sd=",groupSd)) %>%
  mutate(sumStatLab=paste0(meanLab,"\n",medianLab,"\n",sdLab))

sumStats = test %>% group_by(id,condit,vb) %>%
  summarise(distMean=mean(vx),distMedian=median(vx),distSd=sd(vx)) %>%group_by(condit,vb) %>%
  summarise(groupMean=round(mean(distMean),0),groupMedian=round(mean(distMedian),0),groupSd=round(mean(distSd),0)) %>%
  mutate(meanLab=paste0("Mean=",groupMean),medianLab=paste0("Median=",groupMedian),sdLab=paste0("Sd=",groupSd)) %>%
  mutate(sumStatLab=paste0(meanLab,"\n",medianLab,"\n",sdLab))

bandLines4 <- list(geom_segment(data=vbRect,aes(x=vbLag,xend=vbLead,y=highBound,yend=highBound),alpha=1,linetype="dashed"),
                   geom_segment(data=vbRect,aes(x=vbLag,xend=vbLead,y=lowBound,yend=lowBound),alpha=1,linetype="dashed"),
                   geom_text(data=vbRect,aes(x=vbLag-.03,y=lowBound+100,label=vb),angle=90,size=2.5,fontface="bold") )    


test %>% group_by(id,vb,condit) %>% 
  summarise(vxMean=mean(vx)) %>%
  ggplot(aes(x=vb,y=vxMean,fill=vb))+
  gghalves::geom_half_violin(color=NA)+ # remove border color
  gghalves::geom_half_boxplot(position=position_nudge(x=-0.05),side="r",outlier.shape = NA,center=TRUE, 
                    errorbar.draw = FALSE,width=.25)+
  gghalves::geom_half_point(transformation = position_jitter(width = 0.05, height = 0.05),size=.3,aes(color=vb))+
  facet_wrap(~condit,scale="free_x")+
  geom_rect(data=vbRect,aes(xmin=vbLag,xmax=vbLead,ymin=lowBound,ymax=highBound,fill=vb),alpha=.3,inherit.aes = FALSE)+
  bandLines4+
  #geom_text(data=sumStats,aes(x=vb,y=2100,label = groupMean),size=2, vjust = -0.5)+
  scale_y_continuous(expand=expansion(add=100),breaks=round(seq(0,2000,by=200),2))+
  theme(legend.position='none',
        plot.title=element_text(face="bold"),
        axis.title.x=element_text(face="bold"),
        axis.title.y=element_text(face="bold"),
        axis.text.x = element_text(size = 7.5))+
  ylab("Mean X Velocity")+xlab("Target Velocity Band") + 
  ggtitle("Testing Performance (no-feedback) - X-Velocity Per Band")+ 
  geom_text(data=sumStats2,aes(y=2090,label = sumStatLab),size=1.9)


#test %>% group_by(id,vb,condit) |> plot_distByCondit()


test %>% group_by(id,vb,condit) %>% 
  summarise(distMean=mean(dist)) %>% 
  ggplot(aes(x=vb,y=distMean,fill=vb))+
  geom_half_violin(color=NA)+ # remove border color
  geom_half_boxplot(position=position_nudge(x=-0.05),side="r",outlier.shape = NA,center=TRUE, 
                    errorbar.draw = FALSE,width=.25)+
  geom_half_point(transformation = position_jitter(width = 0.05, height = 0.05),size=.3,aes(color=vb))+
  facet_wrap(~condit,scale="free_x")+
  scale_y_continuous(expand=expansion(add=100),breaks=round(seq(0,2000,by=200),2))+
  theme(legend.position='none',
        plot.title=element_text(face="bold"),
        axis.title.x=element_text(face="bold"),
        axis.title.y=element_text(face="bold"),
        axis.text.x = element_text(size = 9.0))+
  ylab("Mean Distance From Boundary")+xlab("Target Velocity Band") + 
  ggtitle("Testing Performance (no-feedback) - Absolute Distance from Boundary")+ 
  geom_text(data=sumStats2,aes(y=1200,label = sumStatLab),size=3,fontface="bold")
test %>% group_by(sbjCode,condit,vb) %>% 
  summarise(distMean=mean(dist)) %>% 
  ggplot(aes(x=condit,y=distMean,fill=condit))+
  stat_summary(geom="bar",fun=mean,position=position_nudge(x=.21),alpha=.7,width=.2)+
   stat_summary(geom="errorbar",fun.data=mean_se,position=position_nudge(x=.21),alpha=.7,width=.1,)+
  geom_half_violin(position=position_dodge(.5),alpha=.55,color=NA)+ # remove border color
  geom_half_boxplot(position=position_dodge(.5),side="r",outlier.shape = NA,center=TRUE, 
                    errorbar.draw = FALSE,width=.25,alpha=.55)+
  geom_half_point(transformation = position_jitter(width = 0.05, height = 0.05),alpha=.2,size=.3)+
  facet_wrap(~vb,scale="free_x")+
  scale_y_continuous(expand=expansion(add=200),breaks=round(seq(0,2000,by=200),2))+
  theme(legend.position='none',
        plot.title=element_text(face="bold"),
        axis.title.x=element_text(face="bold"),
        axis.title.y=element_text(face="bold"),
        axis.text.x = element_text(size = 9.0))+
  ylab("Mean Distance From Boundary")+xlab("Training Condition") + 
  ggtitle("Testing Performance (no-feedback) - Absolute Distance from Boundary")+ 
  geom_text(data=sumStats2,aes(y=1390,label = sumStatLab),position=position_dodge(.5),size=3,fontface="bold")
library(ggforce)

testAvg %>% ggplot(aes(x=vx,y=condit,col=condit))+ ggdist::stat_halfeye()+facet_col(facets="vb")

testAvg %>% ggplot(aes(x=sdist,y=condit,col=condit))+ geom_boxplot()+facet_col(facets="vb")+geom_vline(xintercept=0)+theme_classic()

library(ggh4x)
library(ggdist)

testAvg %>% ggplot(aes(x=vx,y=vb,col=bandType)) +  ggdist::stat_halfeye(normalize="groups")+ facet_nested_wrap(vars(condit,tOrder),nrow=2)+theme_classic()

testAvg %>% ggplot(aes(x=vx,y=vb,col=bandType)) +  ggdist::stat_histinterval(normalize="groups")+ facet_nested_wrap(vars(condit,tOrder),nrow=2)+theme_classic()

testAvg %>% ggplot(aes(x=vx,y=vb,col=bandType)) +  ggdist::stat_histinterval(normalize="groups")+ facet_nested_wrap(vars(condit,tOrder),nrow=2)+theme_classic()

e1 |> group_by(id, condit, vb, bandInt,bandType,tOrder,expMode2) %>%
  summarise(vx=mean(vx),dist=mean(dist),sdist=mean(sdist)) %>%
  ggplot(aes(x=vx,y=condit,col=condit)) +  ggdist::stat_histinterval(normalize="groups")+ facet_nested_wrap(vars(vb,expMode2),nrow=6)+theme_classic()

e1 |> group_by(id, condit, vb, bandInt,bandType,tOrder,expMode2) %>%
  summarise(vx=mean(vx),dist=mean(dist),sdist=mean(sdist)) %>% ggplot(aes(x=sdist,y=vb,col=condit))+ stat_histinterval(normalize="groups",position=position_dodge())+facet_col(facets="expMode2")+geom_vline(xintercept=0)+theme_classic()

Dictionary

Variable Name Variable Levels Description
condit Constant, Varied Condition of the experiment: constant or varied
tOrder Test First, Train First Order of testing and training stages: test first or train first
expMode train, train-Nf, test-Nf, etc. Mode of the experiment: train, train-Nf, test-Nf, etc.
trainStage Beginning, Middle, End, Test Stage of the training: beginning, middle, end, or test
expStage TrainStart, intTest1, etc. Stage of the experiment: TrainStart, intTest1, TrainMid1, etc.
band 1, 2, 3, 4, 5, 6 Band number
vb 100-300, 350-550, etc. Velocity band range
lowBound 100, 350, 600, etc. Lower bound of the velocity band range
feedback 0, 1 Feedback type: 0 (no feedback), 1 (feedback)
stage 1, 2, 3, etc. Stage number of the experiment