BruceFrequencyRequest

Revised Table Request 9/1/2025 for Experiment 1

#Data with added effect codes 
ScaledData <- read.table(
  "C:/Users/woodph/OneDrive - University of Missouri/Documents/bartholow/May202025/ScaledVars.csv",quote = "",header = T,sep=',')
#identify all character columns
chars <- sapply(ScaledData, is.character)

names(ScaledData)

##  [1] "subid"    "ISD"      "Drink"    "ISA"      "ISC"      "ISP"     
##  [7] "ISE1"     "ISE2"     "ISE3"     "exp"      "Antisac1" "Antisac2"
## [13] "Antisac3" "PerSSRT1" "PerSSRT2" "PerSSRT3" "Stroop1"  "Stroop2" 
## [19] "Stroop3"  "Keeptrk1" "Keeptrk2" "Keeptrk3" "Letmem1"  "Letmem2" 
## [25] "Letmem3"  "Nback1"   "Nback2"   "Nback3"   "Catswt1"  "Catswt2" 
## [31] "Catswt3"  "Colswt1"  "Colswt2"  "Colswt3"  "Numswt1"  "Numswt2" 
## [37] "Numswt3"

library(dplyr)

## 
## Attaching package: 'dplyr'

## The following objects are masked from 'package:stats':
## 
##     filter, lag

## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union

library(tidyr)
library(stringr)

#variable name can't be an argumentm evidently
subid <- "subid"

# (Sanitize encoding to avoid gsub/regex errors
SD <- ScaledData
names(SD) <- iconv(names(SD), from = "", to = "UTF-8", sub = "")
SD[] <- lapply(SD, function(x) if (is.character(x)) iconv(x, from = "", to = "UTF-8", sub = "") else x)


# Variables for Experiment 1 

baselines <- c("Antisac1", "Keeptrk1", "Stroop1")

asc_vars  <- c("Antisac2","PerSSRT2","Stroop2","Catswt2","Colswt2","Numswt2","Keeptrk2","Letmem2",
               "Nback2")

desc_vars <- c("Antisac3","PerSSRT3","Stroop3","Catswt3","Colswt3","Numswt3","Keeptrk3","Letmem3",
               "Nback3")

# Keep what's needed and filter on first experiment
need <- unique(c(subid, "exp", baselines, asc_vars, desc_vars))
df1 <- SD[SD$exp == 1, intersect(need, names(SD)), drop = FALSE]

# Count subjects with non-missing baseline AND target
count_for_target <- function(target, baselines, data, subid) {
  sapply(baselines, function(b) {
    sel <- !is.na(data[[b]]) & !is.na(data[[target]])
    length(unique(data[[subid]][sel]))
  }, USE.NAMES = TRUE)
}

# Build rows for ascending and descending
make_block <- function(target_vars, limb_label) {
  do.call(rbind, lapply(target_vars, function(tgt) {
    counts <- count_for_target(tgt, baselines, df1, subid)
    data.frame(
      Limb  = limb_label,       # "Ascending (2)" or "Descending (3)"
      Target = tgt,             # e.g., "PerSSRT2"
      t(counts),                # columns: Antisac1, Keeptrk1, Stroop1
      check.names = FALSE,
      row.names = NULL
    )
  }))
}

tab_asc  <- make_block(asc_vars,  "Ascending (2)")
tab_desc <- make_block(desc_vars, "Descending (3)")

result_table <- rbind(tab_asc, tab_desc)

#Pretty table

library(flextable)

## Warning: package 'flextable' was built under R version 4.5.1

flextable(result_table) |>
  theme_booktabs() |>
  set_caption("Counts of subjects for Experiment = 1.") |>
  autofit()

Counts of subjects for Experiment = 1.

Limb	Target	Antisac1	Keeptrk1	Stroop1
Ascending (2)	Antisac2	115	115	114
Ascending (2)	PerSSRT2	98	98	98
Ascending (2)	Stroop2	115	115	114
Ascending (2)	Catswt2	39	39	38
Ascending (2)	Colswt2	39	39	39
Ascending (2)	Numswt2	36	36	36
Ascending (2)	Keeptrk2	36	36	36
Ascending (2)	Letmem2	38	38	38
Ascending (2)	Nback2	40	40	40
Descending (3)	Antisac3	226	226	225
Descending (3)	PerSSRT3	202	202	202
Descending (3)	Stroop3	223	223	222
Descending (3)	Catswt3	75	75	75
Descending (3)	Colswt3	77	77	77
Descending (3)	Numswt3	72	72	72
Descending (3)	Keeptrk3	73	73	73
Descending (3)	Letmem3	74	74	74
Descending (3)	Nback3	79	79	78

flextable(result_table) %>% save_as_docx( path = "Experiment1.docx")

Revised Table Request 9/1/2025 for Experiment 2

# Variables for Experiment 2

baselines <- c("Catswt1","Colswt1","Numswt1")

asc_vars  <- c("Antisac2","PerSSRT2","Stroop2","Catswt2","Colswt2","Numswt2","Keeptrk2","Letmem2",
               "Nback2")

desc_vars <- c("Antisac3","PerSSRT3","Stroop3","Catswt3","Colswt3","Numswt3","Keeptrk3","Letmem3",
               "Nback3")

# Keep what's needed and filter on Experiment 2
need <- unique(c(subid, "exp", baselines, asc_vars, desc_vars))
df1 <- SD[SD$exp == 2, intersect(need, names(SD)), drop = FALSE]

# Make a count of subjects with non-missing baseline & target
count_for_target <- function(target, baselines, data, subid) {
  sapply(baselines, function(b) {
    sel <- !is.na(data[[b]]) & !is.na(data[[target]])
    length(unique(data[[subid]][sel]))
  }, USE.NAMES = TRUE)
}

# Build rows for ascending and descending
make_block <- function(target_vars, limb_label) {
  do.call(rbind, lapply(target_vars, function(tgt) {
    counts <- count_for_target(tgt, baselines, df1, subid)
    data.frame(
      Limb  = limb_label,       # "Ascending (2)" or "Descending (3)"
      Target = tgt,             # e.g., "PerSSRT2"
      t(counts),                # columns: Antisac1, Keeptrk1, Stroop1
      check.names = FALSE,
      row.names = NULL
    )
  }))
}

tab_asc  <- make_block(asc_vars,  "Ascending (2)")
tab_desc <- make_block(desc_vars, "Descending (3)")

result_table <- rbind(tab_asc, tab_desc)

#Make a pretty table

library(flextable)
flextable(result_table) |>
  theme_booktabs() |>
  set_caption("Counts of subjects for Experiment 2.") |>
  autofit()

Counts of subjects for Experiment 2.

Limb	Target	Catswt1	Colswt1	Numswt1
Ascending (2)	Antisac2	38	38	36
Ascending (2)	PerSSRT2	37	37	37
Ascending (2)	Stroop2	39	39	39
Ascending (2)	Catswt2	116	116	114
Ascending (2)	Colswt2	117	117	115
Ascending (2)	Numswt2	115	115	114
Ascending (2)	Keeptrk2	38	38	37
Ascending (2)	Letmem2	39	39	38
Ascending (2)	Nback2	39	39	39
Descending (3)	Antisac3	76	77	74
Descending (3)	PerSSRT3	75	75	75
Descending (3)	Stroop3	76	75	76
Descending (3)	Catswt3	233	232	230
Descending (3)	Colswt3	233	233	231
Descending (3)	Numswt3	232	232	230
Descending (3)	Keeptrk3	77	77	75
Descending (3)	Letmem3	79	78	78
Descending (3)	Nback3	72	73	73

flextable(result_table) %>% save_as_docx( path = "Experiment2.docx")

Frequency counts for Experiment 3

# Variable Names for Experiment 3

baselines <- c("Keeptrk1","Letmem1","Nback1")

asc_vars  <- c("Antisac2","PerSSRT2","Stroop2","Catswt2","Colswt2","Numswt2","Keeptrk2","Letmem2",
               "Nback2")

desc_vars <- c("Antisac3","PerSSRT3","Stroop3","Catswt3","Colswt3","Numswt3","Keeptrk3","Letmem3",
               "Nback3")

# Keep what's needed and filter on Experiment 3
need <- unique(c(subid, "exp", baselines, asc_vars, desc_vars))
df1 <- SD[SD$exp == 3, intersect(need, names(SD)), drop = FALSE]

# Make a count of unique subjects with non-missing baseline AND target
count_for_target <- function(target, baselines, data, subid) {
  sapply(baselines, function(b) {
    sel <- !is.na(data[[b]]) & !is.na(data[[target]])
    length(unique(data[[subid]][sel]))
  }, USE.NAMES = TRUE)
}

# Rows for ascending and descending
make_block <- function(target_vars, limb_label) {
  do.call(rbind, lapply(target_vars, function(tgt) {
    counts <- count_for_target(tgt, baselines, df1, subid)
    data.frame(
      Limb  = limb_label,       # "Ascending (2)" or "Descending (3)"
      Target = tgt,             # e.g., "PerSSRT2"
      t(counts),                # columns: Antisac1, Keeptrk1, Stroop1
      check.names = FALSE,
      row.names = NULL
    )
  }))
}

tab_asc  <- make_block(asc_vars,  "Ascending (2)")
tab_desc <- make_block(desc_vars, "Descending (3)")

result_table <- rbind(tab_asc, tab_desc)

# Make a pretty table

library(flextable)
flextable(result_table) |>
  theme_booktabs() |>
  set_caption("Counts for Experiment 3.") |>
  autofit()

Counts for Experiment 3.

Limb	Target	Keeptrk1	Letmem1	Nback1
Ascending (2)	Antisac2	39	39	38
Ascending (2)	PerSSRT2	31	31	29
Ascending (2)	Stroop2	41	41	41
Ascending (2)	Catswt2	39	39	37
Ascending (2)	Colswt2	41	41	41
Ascending (2)	Numswt2	39	39	38
Ascending (2)	Keeptrk2	120	120	117
Ascending (2)	Letmem2	120	120	117
Ascending (2)	Nback2	119	119	117
Descending (3)	Antisac3	77	77	76
Descending (3)	PerSSRT3	62	62	60
Descending (3)	Stroop3	80	80	79
Descending (3)	Catswt3	77	77	75
Descending (3)	Colswt3	81	81	79
Descending (3)	Numswt3	76	76	75
Descending (3)	Keeptrk3	233	233	228
Descending (3)	Letmem3	233	233	228
Descending (3)	Nback3	231	231	227

flextable(result_table) %>% save_as_docx( path = "Experiment3.docx")

Original Frequency Counts

#Data with added effect codes 
ScaledData <- read.table(
  "C:/Users/woodph/OneDrive - University of Missouri/Documents/bartholow/May202025/ScaledVars.csv",quote = "",header = T,sep=',')
#identify all character columns
chars <- sapply(ScaledData, is.character)

names(ScaledData)

##  [1] "subid"    "ISD"      "Drink"    "ISA"      "ISC"      "ISP"     
##  [7] "ISE1"     "ISE2"     "ISE3"     "exp"      "Antisac1" "Antisac2"
## [13] "Antisac3" "PerSSRT1" "PerSSRT2" "PerSSRT3" "Stroop1"  "Stroop2" 
## [19] "Stroop3"  "Keeptrk1" "Keeptrk2" "Keeptrk3" "Letmem1"  "Letmem2" 
## [25] "Letmem3"  "Nback1"   "Nback2"   "Nback3"   "Catswt1"  "Catswt2" 
## [31] "Catswt3"  "Colswt1"  "Colswt2"  "Colswt3"  "Numswt1"  "Numswt2" 
## [37] "Numswt3"

library(dplyr)
library(tidyr)

# Task stems
tasks <- c("Antisac","PerSSRT","Stroop","Catswt","Colswt","Numswt", "Keeptrk","Letmem",
           "Nback")

# Keep only columns that actually exist in data
cols_wanted <- intersect(names(ScaledData), as.vector(outer(tasks, 1:3, paste0)))

result <- ScaledData %>%
  group_by(exp, subid) %>%
  pivot_longer(
    cols = all_of(cols_wanted),
    names_to = c("task","time"),
    names_pattern = "([A-Za-z]+)([123])",
    values_to = "value"
  ) %>%
  mutate(has = !is.na(value)) %>%
  # one row per subject per task with flags for time 1/2/3
  group_by(exp, subid, task) %>%
  summarise(
    has1 = any(time == "1" & has),
    has2 = any(time == "2" & has),
    has3 = any(time == "3" & has),
    .groups = "drop"   # <-- keep all columns, no grouping carried forward
  ) %>%
  # now count subjects per exp × task
  group_by(exp, task) %>%
  summarise(
    n_baseline_asc  = sum(has1 & has2),
    n_baseline_desc = sum(has1 & has3),
    # optional sanity check:
    n_all_three     = sum(has1 & has2 & has3),
    .groups = "drop"
  ) %>%
  arrange(exp, task)

library(flextable)

# Counts were put into `result`
apa_df <- result %>%
  transmute(
    Condition = exp,
    Task = task,
    `Baseline + Ascending` = n_baseline_asc,
    `Baseline + Descending` = n_baseline_desc,
    `All Three` = n_all_three
  )

ft <- flextable(apa_df) |>
  autofit() |>
  theme_booktabs() |>
  set_caption("Table for Bruce\nCounts of subjects with baseline and limb data by condition and task.") |>
  footnote(i = 1, j = 1,
           value = as_paragraph("Note. Counts reflect unique subjects per condition and task who meet each data-availability criterion."),
           ref_symbols = "a")

ft

Table for Bruce Counts of subjects with baseline and limb data by condition and task.

Condition	Task	Baseline + Ascending	Baseline + Descending	All Three
1a	Antisac	115	226	115
1	Catswt	39	75	37
1	Colswt	39	77	39
1	Keeptrk	36	73	36
1	Letmem	38	74	38
1	Nback	40	79	40
1	Numswt	36	72	36
1	PerSSRT	96	199	96
1	Stroop	114	222	113
2	Antisac	38	77	38
2	Catswt	116	233	116
2	Colswt	117	233	117
2	Keeptrk	38	77	38
2	Letmem	39	79	39
2	Nback	39	72	36
2	Numswt	114	230	114
2	PerSSRT	37	74	37
2	Stroop	39	76	39
3	Antisac	39	76	38
3	Catswt	38	76	38
3	Colswt	41	81	41
3	Keeptrk	120	233	120
3	Letmem	120	233	120
3	Nback	117	227	117
3	Numswt	39	76	39
3	PerSSRT	31	62	31
3	Stroop	41	80	41
aNote. Counts reflect unique subjects per condition and task who meet each data-availability criterion.