In jtrampush/npsych.data: BrainWorkup Neuropsychological Report Writing Package

WAIS-IV

Load libraries

Sys.setenv(
  JAVA_HOME =
    "/Library/Java/JavaVirtualMachines/temurin-11.jdk/Contents/Home"
)
options(java.parameters = "-Xmx16000m")
knitr::opts_chunk$set(
  root.dir = normalizePath("./"),
  echo = TRUE,
  message = TRUE,
  warning = FALSE,
  error = TRUE
)
library(hablar)
library(here)
library(knitr)
library(magrittr)
library(readr)
library(rmarkdown)
library(rmdformats)
library(shiny)
library(snakecase)
library(tabulapdf)
library(tibble)
library(tidyr)
library(dplyr)
library(bwu)

Patient

patient <- params$patient

Test

test <- params$test
test_name <- params$test_name
version <- params$version

Upload/attach PDF

file <- file.path(params$file)

Pages

pages <- params$pages

Extract Areas with tabulapdf

library(tabulapdf)

f <- file.path("/Users/joey/reports/Biggie/pdf/Biggie_adhd_ld_battery-2a4e56ea-524d-496f-a277-5d4f356a60ca.pdf")

# f <- file.path(file.choose(""))

# locate areas and extract
plucked_tables_wais4 <- tabulapdf::extract_areas(
  file = f,
  pages = c(2, 4, 4, 4, 4),
  method = "stream",
  output = "matrix"
)

# Loop over the list and write each matrix to a CSV file
for (i in seq_along(plucked_tables_wais4)) {
  write.csv(plucked_tables_wais4[[i]], file = paste0(test, "_", i, ".csv"), row.names = FALSE)
}

# Save the entire list to an R data file
save(plucked_tables_wais4, file = "plucked_tables_wais4.RData")

Locate areas

# if known
if (params$version == "full") {
  area <- list(
    index = c(133, 50, 196, 560),
    vci = c(303, 50, 338, 560),
    pri = c(388, 50, 421, 560),
    wmi = c(473, 50, 507, 560),
    psi = c(560, 50, 576, 560),
    bd = c(411, 50, 431, 560),
    ds = c(491, 50, 510, 560)
  )
} else if (params$version == "brief") {
  area <- list(
    vci = c(168, 50, 189, 560),
    pri = c(238, 50, 260, 560),
    wmi = c(308, 50, 329, 560),
    psi = c(376, 50, 402, 560)
  )
}
# with FSIQ
# index = c(132, 50, 227, 560),
# vci = c(364, 50, 398, 560),
# pri = c(450, 50, 484, 560),
# wmi = c(535, 50, 570, 560),
# psi = c(620, 50, 656, 560),
# bd = c(355, 50, 375, 560),
# ds = c(436, 50, 533, 560)

Extract tables

plucked_tables_wais4 <- bwu::gpluck_extract_table(
  file = file,
  pages = pages,
  area = area,
  guess = "FALSE",
  method = "stream",
  output = "matrix"
)

# Load the entire list from an R data file
load("plucked_tables_wais4.RData")

WAIS-IV Index Scores (Table 1)

Pluck and tidy tables

# Assuming you have plucked_tables_wais4 and params already defined

# Use this because q-int didnt give PRI
table1 <- readr::read_csv("wais4_1.csv")

# Convert to data.frame
# table1 <- as.data.frame(plucked_tables_wais4[[1]])

# Rename columns
colnames1 <- params[["colnames1"]]
colnames(table1) <- colnames1

# Convert columns to double
to_double <- c("raw_score", "score", "percentile")
table1[to_double] <- lapply(table1[to_double], as.numeric)


table1[, 1] <- (params$table1)
table1 <- table1 |> dplyr::select(all_of(params$keep1))

Mutate columns

test <- params$test
test_name <- params$test_name
table1 <- bwu::gpluck_make_columns(
  table1,
  range = "",
  test = test,
  test_name = test_name,
  domain = "",
  subdomain = "",
  narrow = "",
  pass = "",
  verbal = "",
  timed = "",
  test_type = "npsych_test",
  score_type = "standard_score",
  description = "",
  result = ""
)

Test score ranges

table1 <- bwu::gpluck_make_score_ranges(table = table1, test_type = "npsych_test")

Domains

table1 <-
  table1 |>
  dplyr::mutate(
    domain = dplyr::case_when(
      scale == "Verbal Comprehension (VCI)" ~ "General Cognitive Ability",
      scale == "Perceptual Reasoning (PRI)" ~ "General Cognitive Ability",
      scale == "Working Memory (WMI)" ~ "General Cognitive Ability",
      scale == "Processing Speed (PSI)" ~ "General Cognitive Ability",
      scale == "Full Scale (FSIQ)" ~ "General Cognitive Ability",
      scale == "General Ability (GAI)" ~ "General Cognitive Ability",
      TRUE ~ as.character(domain)
    )
  )

Subdomain

table1 <-
  table1 |>
  dplyr::mutate(
    subdomain = dplyr::case_when(
      scale == "Full Scale (FSIQ)" ~ "General Intelligence",
      scale == "General Ability (GAI)" ~ "General Intelligence",
      scale == "Verbal Comprehension (VCI)" ~ "Crystallized Knowledge",
      scale == "Perceptual Reasoning (PRI)" ~ "Fluid Reasoning",
      scale == "Working Memory (WMI)" ~ "Working Memory",
      scale == "Processing Speed (PSI)" ~ "Processing Speed",
      TRUE ~ as.character(subdomain)
    )
  )

Narrow subdomain

table1 <-
  table1 |>
  dplyr::mutate(
    narrow = dplyr::case_when(
      scale == "Full Scale (FSIQ)" ~ "General Intelligence",
      scale == "General Ability (GAI)" ~ "General Intelligence",
      scale == "Verbal Comprehension (VCI)" ~ "Crystallized Knowledge",
      scale == "Perceptual Reasoning (PRI)" ~ "Fluid Reasoning",
      scale == "Working Memory (WMI)" ~ "Working Memory",
      scale == "Processing Speed (PSI)" ~ "Processing Speed",
      TRUE ~ as.character(narrow)
    )
  )

PASS model

table1 <-
  table1 |>
  dplyr::mutate(
    pass = dplyr::case_when(
      scale == "Full Scale (FSIQ)" ~ "",
      scale == "General Ability (GAI)" ~ "",
      scale == "Verbal Comprehension (VCI)" ~ "",
      scale == "Perceptual Reasoning (PRI)" ~ "",
      scale == "Working Memory (WMI)" ~ "",
      scale == "Processing Speed (PSI)" ~ "",
      TRUE ~ as.character(pass)
    )
  )

Verbal vs Nonverbal

table1 <-
  table1 |>
  dplyr::mutate(
    verbal = dplyr::case_when(
      scale == "Full Scale (FSIQ)" ~ "",
      scale == "General Ability (GAI)" ~ "",
      scale == "Verbal Comprehension (VCI)" ~ "Verbal",
      scale == "Perceptual Reasoning (PRI)" ~ "Nonverbal",
      scale == "Working Memory (WMI)" ~ "Verbal",
      scale == "Processing Speed (PSI)" ~ "Nonverbal",
      TRUE ~ as.character(verbal)
    )
  )

Timed vs Untimed

table1 <-
  table1 |>
  dplyr::mutate(
    timed = dplyr::case_when(
      scale == "Full Scale (FSIQ)" ~ "",
      scale == "General Ability (GAI)" ~ "",
      scale == "Verbal Comprehension (VCI)" ~ "Untimed",
      scale == "Perceptual Reasoning (PRI)" ~ "Timed",
      scale == "Working Memory (WMI)" ~ "Untimed",
      scale == "Processing Speed (PSI)" ~ "Timed",
      TRUE ~ as.character(timed)
    )
  )

Descriptions

table1 <-
  table1 |>
  dplyr::mutate(
    description = dplyr::case_when(
      scale ==
        "Full Scale IQ" ~
        "General Intelligence (*G*)",
      scale ==
        "General Ability (GAI)" ~
        "A subset of intellectual functioning with reduced influences of working memory and processing speed",
      scale ==
        "Verbal Comprehension (VCI)" ~
        "Verbal Comprehension (i.e., the ability to verbalize meaningful concepts, think about verbal information, and express oneself using words)",
      scale ==
        "Perceptual Reasoning (PRI)" ~
        "Fluid Reasoning (i.e., the ability to use reasoning to identify and apply solutions to problems)",
      scale ==
        "Working Memory (WMI)" ~
        "Working Memory (*G*wm)",
      scale ==
        "Processing Speed (PSI)" ~
        "Processing Speed (*G*s)",
      TRUE ~ as.character(description)
    )
  )

Glue result

table1 <-
  table1 |>
  dplyr::mutate(
    result = dplyr::case_when(
      scale == "Full Scale (FSIQ)" ~ glue::glue(
        "{description} was {range} overall.\n"
      ),
      scale == "General Ability (GAI)" ~ glue::glue(
        "{description} was {range} and ranked at the {percentile}th percentile, indicating performance as good as or better than {percentile}% of same-age peers from the general population.\n"
      ),
      scale == "Verbal Comprehension (VCI)" ~ glue::glue(
        "{description} was classified as {range} and ranked at the {percentile}th percentile.\n"
      ),
      scale == "Perceptual Reasoning (PRI)" ~ glue::glue(
        "{description} was classified as {range} and ranked at the {percentile}th percentile.\n"
      ),
      scale == "Working Memory (WMI)" ~ glue::glue(
        "{description} fell in the {range} range.\n"
      ),
      scale == "Processing Speed (PSI)" ~ glue::glue(
        "{description} was {range}.\n"
      ),
      TRUE ~ as.character(result)
    )
  )

Relocate variables

table1 <- table1 |> dplyr::relocate(c(raw_score, score, percentile, range, ci_95), .before = test)

VCI (Table 2)

Pluck and tidy tables

# Convert to data.frame
table2 <- as.data.frame(plucked_tables_wais4[[2]])

# Rename columns
colnames2 <- params[["colnames2"]]
colnames(table2) <- colnames2

# Convert columns to double
to_double <- c("raw_score", "score", "percentile")
table2[to_double] <- lapply(table2[to_double], as.numeric)

table2[, 1] <- (params$table2)
table2 <- table2 |> dplyr::select(all_of(params$keep2))


# if (params$version == "brief") {
#   table2 <- as.data.frame(plucked_table[[1]])
# } else if (params$version == "full") {
#   table2 <- as.data.frame(plucked_table[[2]])
# }
# colnames2 <- params$colnames2
# colnames(table2) <- params$colnames2
# to_double <- c("raw_score", "score", "percentile")
# table2 <- table2 |> hablar::convert(dbl(all_of(to_double)))
# table2[, 1] <- (params$table2)
# table2 <- table2 |> dplyr::select(all_of(params$keep2))

library(dplyr)

# Initialize a list to store the transformed data.frames
transformed_tables <- list()

# Loop through plucked_tables_wais4 from index 2 to 5
for (i in 2:5) {
  # Convert to data.frame
  table <- as.data.frame(plucked_tables_wais4[[i]])

  # Rename columns using the respective 'colnames' from params
  colnames_param <- params[[paste0("colnames", i)]]
  colnames(table) <- colnames_param

  # Convert columns to double
  to_double <- c("raw_score", "score", "percentile")
  table[to_double] <- lapply(table[to_double], as.numeric)

  # Add the test name as the first column
  table[, 1] <- params[[paste0("table", i)]]

  # Select the relevant columns
  table <- table %>% select(all_of(params[[paste0("keep", i)]]))

  # Store the transformed table in the list
  transformed_tables[[i - 1]] <- table
}

Mutate columns

table2 <- bwu::gpluck_make_columns(
  table2,
  range = "",
  ci_95 = "",
  test = params$test,
  test_name = params$test_name,
  domain = "Verbal/Language",
  subdomain = "",
  narrow = "",
  pass = "Sequential",
  verbal = "Verbal",
  timed = "Untimed",
  test_type = "npsych_test",
  score_type = "scaled_score",
  description = "",
  result = ""
)

Test score ranges

table2 <- bwu::gpluck_make_score_ranges(
  table = table2,
  test_type = "npsych_test"
)

Subdomains

table2 <-
  table2 |>
  dplyr::mutate(
    subdomain = dplyr::case_when(
      scale == "Similarities" ~ "Reasoning",
      scale == "Vocabulary" ~ "Knowledge",
      scale == "Information" ~ "Knowledge",
      scale == "Comprehension" ~ "Comprehension",
      TRUE ~ as.character(subdomain)
    )
  )

Narrow subdomains

table2 <-
  table2 |>
  dplyr::mutate(
    narrow = dplyr::case_when(
      scale == "Similarities" ~ "Word Reasoning",
      scale == "Vocabulary" ~ "Word Knowledge",
      scale == "Information" ~ "World Knowledge",
      scale == "Comprehension" ~ "Acquired Knowledge",
      TRUE ~ as.character(narrow)
    )
  )

Scale descriptions

table2 <-
  table2 |>
  dplyr::mutate(
    description = dplyr::case_when(
      scale ==
        "Similarities" ~ "Verbal inductive reasoning",
      scale ==
        "Vocabulary" ~ "Word/lexical knowledge",
      scale ==
        "Information" ~ "Acquired knowledge/ability to acquire, retain, and retrieve general factual knowledge",
      scale ==
        "Comprehension" ~ "Practical knowledge and judgment of general principles and social situations",
      TRUE ~ as.character(description)
    )
  )

Glue results

table2 <-
  table2 %>%
  dplyr::mutate(
    result = glue::glue(
      "{description} was {range}.\n"
    )
  )

Relocate variables

table2 <- table2 |> dplyr::relocate(c(raw_score, score, percentile, range, ci_95), .before = test)

PRI (Table 3)

Pluck and tidy tables

table3 <- as.data.frame(plucked_tables_wais4[[3]])

# if (params$version == "brief") {
#   table3 <- as.data.frame(plucked_table[[2]])
# } else if (params$version == "full") {
#   table3 <- as.data.frame(plucked_table[[3]])
# }
colnames(table3) <- params$colnames2
to_double <- c("raw_score", "score", "percentile")
table3 <- table3 |> hablar::convert(dbl(all_of(to_double)))
table3$scale <- params$table3
table3 <- table3 |> dplyr::select(all_of(params$keep2))

Mutate columns

table3 <- bwu::gpluck_make_columns(
  table3,
  range = "",
  ci_95 = "",
  test = params$test,
  test_name = params$test_name,
  domain = "Visual Perception/Construction",
  subdomain = "",
  narrow = "",
  timed = "",
  verbal = "Nonverbal",
  pass = "Simultaneous",
  test_type = "npsych_test",
  score_type = "scaled_score",
  description = "",
  result = ""
)

Test score ranges

table3 <- bwu::gpluck_make_score_ranges(table = table3, test_type = "npsych_test")

Subdomains

table3 <-
  table3 |>
  dplyr::mutate(
    subdomain = dplyr::case_when(
      scale == "Block Design" ~ "Construction",
      scale == "Matrix Reasoning" ~ "Reasoning",
      scale == "Visual Puzzles" ~ "Perception",
      scale == "Figure Weights" ~ "Reasoning",
      TRUE ~ as.character(subdomain)
    )
  )

Narrow subdomain

table3 <-
  table3 |>
  dplyr::mutate(
    narrow = dplyr::case_when(
      scale == "Block Design" ~ "Visuoconstruction",
      scale == "Matrix Reasoning" ~ "Nonverbal Reasoning",
      scale == "Visual Puzzles" ~ "Visualization",
      scale == "Figure Weights" ~ "General Sequential Reasoning",
      TRUE ~ as.character(narrow)
    )
  )

Timed vs Untimed

table3 <-
  table3 |>
  dplyr::mutate(
    timed = dplyr::case_when(
      scale == "Block Design" ~ "Timed",
      scale == "Matrix Reasoning" ~ "Untimed",
      scale == "Visual Puzzles" ~ "Timed",
      scale == "Figure Weights" ~ "Timed",
      TRUE ~ as.character(timed)
    )
  )

Description

table3 <-
  table3 |>
  dplyr::mutate(
    description = dplyr::case_when(
      scale ==
        "Block Design" ~ "Understanding visual-spatial relationships to construct geometric designs from a model",
      scale ==
        "Matrix Reasoning" ~ "Inductive reasoning and nonverbal problem-solving",
      scale ==
        "Visual Puzzles" ~ "Generate visual images in the mind's eye",
      scale ==
        "Figure Weights" ~ "General sequential (deductive) reasoning and quantitative reasoning",
      TRUE ~ as.character(description)
    )
  )

Glue results

table3 <-
  table3 %>%
  dplyr::mutate(
    result = glue::glue(
      "{description} was {range}.\n"
    )
  )

Relocate variables

table3 <- table3 |> dplyr::relocate(c(raw_score, score, percentile, range, ci_95), .before = test)

WMI (Table 4)

Pluck and tidy tables

table4 <- as.data.frame(plucked_tables_wais4[[4]])
# if (params$version == "brief") {
#   table4 <- as.data.frame(plucked_table[[3]])
# } else if (params$version == "full") {
#   table4 <- as.data.frame(plucked_table[[4]])
# }
colnames(table4) <- params$colnames2
to_double <- c("raw_score", "score", "percentile")
table4 <- table4 |> hablar::convert(dbl(all_of(to_double)))
table4$scale <- params$table4
table4 <- table4 |> dplyr::select(all_of(params$keep2))

Mutate columns

table4 <- bwu::gpluck_make_columns(
  table4,
  range = "",
  ci_95 = "",
  test = params$test,
  test_name = params$test_name,
  domain = "Attention/Executive",
  subdomain = "Working Memory",
  narrow = "",
  pass = "Attention",
  verbal = "Verbal",
  timed = "Untimed",
  test_type = "npsych_test",
  score_type = "scaled_score",
  description = "",
  result = ""
)

Test score ranges

table4 <- bwu::gpluck_make_score_ranges(table = table4, test_type = "npsych_test")

Subdomains

table4 <-
  table4 |>
  dplyr::mutate(
    subdomain = dplyr::case_when(
      scale == "Digit Span" ~ "Working Memory",
      scale == "Arithmetic" ~ "Working Memory",
      scale == "Letter-Number Sequencing" ~ "Working Memory",
      TRUE ~ as.character(subdomain)
    )
  )

Narrow subdomains

table4 <-
  table4 |>
  dplyr::mutate(
    narrow = dplyr::case_when(
      scale == "Digit Span" ~ "Working Memory Capacity",
      scale == "Arithmetic" ~ "Working Memory Capacit",
      scale == "Letter-Number Sequencing" ~ "Working Memory Capacit",
      TRUE ~ as.character(narrow)
    )
  )

Timed vs Untimed

table4 <-
  table4 |>
  dplyr::mutate(
    timed = dplyr::case_when(
      scale == "Digit Span" ~ "Untimed",
      scale == "Arithmetic" ~ "Timed",
      scale == "Letter-Number Sequencing" ~ "Untimed",
      TRUE ~ as.character(timed)
    )
  )

PASS model

table4 <-
  table4 |>
  dplyr::mutate(
    pass = dplyr::case_when(
      scale == "Digit Span" ~ "Attention",
      scale == "Arithmetic" ~ "Attention",
      scale == "Letter-Number Sequencing" ~ "Attention",
      TRUE ~ as.character(pass)
    )
  )

Scale descriptions

table4 <-
  table4 |>
  dplyr::mutate(
    description = dplyr::case_when(
      scale == "Digit Span" ~ "Registering, maintaining, and manipulating auditory information",
      scale == "Arithmetic" ~ "Solving math word problems in working memory",
      scale == "Letter-Number Sequencing" ~ "Maintenance and resequencing of progressively lengthier number and letter strings in working memory",
      TRUE ~ as.character(description)
    )
  )

Glue results

table4 <-
  table4 %>%
  dplyr::mutate(
    result = glue::glue(
      "{description} was {range}.\n"
    )
  )

Relocate variables

table4 <- table4 |> dplyr::relocate(c(raw_score, score, percentile, range, ci_95), .before = test)

PSI (Table 5)

Pluck and tidy tables

table5 <- as.data.frame(plucked_tables_wais4[[5]])
# if (params$version == "brief") {
#   table5 <- as.data.frame(plucked_table[[4]])
# } else if (params$version == "full") {
#   table5 <- as.data.frame(plucked_table[[5]])
# }
colnames(table5) <- params$colnames2
to_double <- c("raw_score", "score", "percentile")
table5 <- table5 |> hablar::convert(dbl(all_of(to_double)))
table5$scale <- params$table5
table5 <- table5 |> dplyr::select(all_of(params$keep2))

Mutate columns

table5 <- bwu::gpluck_make_columns(
  table5,
  range = "",
  ci_95 = "",
  test = params$test,
  test_name = params$test_name,
  domain = "Attention/Executive",
  subdomain = "Processing Speed",
  narrow = "",
  pass = "Planning",
  verbal = "Nonverbal",
  timed = "Timed",
  test_type = "npsych_test",
  score_type = "scaled_score",
  description = "",
  result = ""
)

Test score ranges

table5 <- bwu::gpluck_make_score_ranges(table = table5, test_type = "npsych_test")

Subdomains

table5 <-
  table5 |>
  dplyr::mutate(
    subdomain = dplyr::case_when(
      scale == "Coding" ~ "Processing Speed",
      scale == "Symbol Search" ~ "Processing Speed",
      scale == "Cancellation" ~ "Processing Speed",
      TRUE ~ as.character(subdomain)
    )
  )

Narrow subdomains

table5 <-
  table5 |>
  dplyr::mutate(
    narrow = dplyr::case_when(
      scale == "Coding" ~ "Cognitive Efficiency",
      scale == "Symbol Search" ~ "Cognitive Efficiency",
      scale == "Cancellation" ~ "Attentional Fluency",
      TRUE ~ as.character(narrow)
    )
  )

PASS model

table5 <-
  table5 |>
  dplyr::mutate(
    pass = dplyr::case_when(
      scale == "Cancellation" ~ "Attention",
      scale == "Coding" ~ "Planning",
      scale == "Symbol Search" ~ "Attention",
      TRUE ~ as.character(pass)
    )
  )

Scale descriptions

table5 <-
  table5 |>
  dplyr::mutate(
    description = dplyr::case_when(
      scale == "Coding" ~ "Efficiency of psychomotor speed, visual scanning ability, and visual-motor coordination",
      scale == "Symbol Search" ~ "Visual-perceptual decision-making speed",
      scale == "Cancellation" ~ "Selective visual attention, visual discrimination, and visual-perceptual processing",
      TRUE ~ as.character(description)
    )
  )

Glue results

table5 <-
  table5 %>%
  dplyr::mutate(
    result = glue::glue(
      "{description} was {range}.\n"
    )
  )

Relocate variables

table5 <- table5 |> dplyr::relocate(c(raw_score, score, percentile, range, ci_95), .before = test)

Block Design Process Score Summary (Table 6)

Pluck and tidy tables

if (params$version == "brief") {
  table6 <- as.data.frame(plucked_table[[5]])
} else if (params$version == "full") {
  table6 <- as.data.frame(plucked_table[[6]])
}
colnames(table6) <- params$colnames3
to_double <- c("raw_score", "score", "percentile")
table6 <- table6 %>% hablar::convert(dbl(all_of(to_double)))
table6$scale <- params$table6
table6 <- table6 %>% dplyr::select(all_of(params$keep2))

Mutate columns

table6 <- bwu::gpluck_make_columns(
  table6,
  range = "",
  ci_95 = "",
  test = params$test,
  test_name = params$test_name,
  domain = "Visual Perception/Construction",
  subdomain = "Visual Processing",
  narrow = "Construction (Untimed)",
  timed = "Untimed",
  verbal = "Nonverbal",
  pass = "Simultaneous",
  test_type = "npsych_test",
  score_type = "scaled_score",
  description = "",
  result = ""
)

Test score ranges

table6 <- bwu::gpluck_make_score_ranges(table = table6, test_type = "npsych_test")

Scale descriptions

table6 <-
  table6 |>
  dplyr::mutate(
    description = dplyr::case_when(
      scale ==
        "Block Design No Time Bonus" ~
        "Untimed Block Design performance",
      TRUE ~ as.character(description)
    )
  )

Glue results

# result text
table6 <-
  table6 %>%
  dplyr::mutate(
    result = glue::glue(
      "{description} was {range}.\n"
    )
  )

Relocate variables

table6 <- table6 |> dplyr::relocate(c(raw_score, score, percentile, range, ci_95), .before = test)

Span Process Score Summary (Table 7)

Pluck and tidy tables

if (params$version == "brief") {
  table7 <- as.data.frame(plucked_table[[6]])
} else if (params$version == "full") {
  table7 <- as.data.frame(plucked_table[[7]])
}
colnames(table7) <- params$colnames4
to_double <- c("raw_score", "score", "percentile")
table7 <- table7 |> hablar::convert(dbl(all_of(to_double)))
table7$scale <- params$table7
table7 <- table7 |> dplyr::select(all_of(params$keep2))

Mutate columns

table7 <- bwu::gpluck_make_columns(
  table7,
  range = "",
  ci_95 = "",
  test = params$test,
  test_name = params$test_name,
  domain = "Attention/Executive",
  subdomain = "Working Memory",
  narrow = "",
  pass = "",
  verbal = "Verbal",
  timed = "Untimed",
  test_type = "npsych_test",
  score_type = "",
  description = "",
  result = ""
)

Test score ranges

table7 <- bwu::gpluck_make_score_ranges(table = table7, test_type = "npsych_test")

Narrow subdomains

table7 <-
  table7 %>%
  dplyr::mutate(
    narrow = dplyr::case_when(
      scale == "Digit Span Forward" ~ "Verbal Attention",
      scale == "Digit Span Backward" ~ "Verbal Working Memory",
      scale == "Digit Span Sequencing" ~ "Verbal Working Memory",
      scale == "Longest Digit Span Forward" ~ "Verbal Attention",
      scale == "Longest Digit Span Backward" ~ "Verbal Working Memory",
      scale == "Longest Digit Span Sequence" ~ "Verbal Working Memory",
      scale == "Longest Letter-Number Sequence" ~ "Verbal Working Memory",
      TRUE ~ as.character(narrow)
    )
  )

PASS model

table7 <-
  table7 |>
  dplyr::mutate(
    pass = dplyr::case_when(
      scale == "Digit Span Forward" ~ "Sequential",
      scale == "Digit Span Backward" ~ "Attention",
      scale == "Digit Span Sequencing" ~ "Attention",
      scale == "Longest Digit Span Forward" ~ "Sequential",
      scale == "Longest Digit Span Backward" ~ "Attention",
      scale == "Longest Digit Span Sequence" ~ "Attention",
      scale == "Longest Letter-Number Sequence" ~ "Attention",
      TRUE ~ as.character(pass)
    )
  )

Score type

table7 <-
  table7 |>
  dplyr::mutate(
    score_type = dplyr::case_when(
      scale == "Digit Span Forward" ~ "scaled_score",
      scale == "Digit Span Backward" ~ "scaled_score",
      scale == "Digit Span Sequencing" ~ "scaled_score",
      scale == "Longest Digit Span Forward" ~ "raw_score",
      scale == "Longest Digit Span Backward" ~ "raw_score",
      scale == "Longest Digit Span Sequence" ~ "raw_score",
      scale == "Longest Letter-Number Sequence" ~ "raw_score",
      TRUE ~ as.character(score_type)
    )
  )

Scale descriptions

table7 <-
  table7 |>
  dplyr::mutate(
    description = dplyr::case_when(
      scale ==
        "Digit Span Forward" ~
        "Forward digit span/attention span",
      scale ==
        "Digit Span Backward" ~
        "Verbal working memory manipulation",
      scale ==
        "Digit Span Sequencing" ~
        "Verbal working memory and sequencing",
      scale ==
        "Longest Digit Span Forward" ~
        "Auditory attentional capacity",
      scale ==
        "Longest Digit Span Backward" ~
        "Working memory for orally presented information",
      scale ==
        "Longest Digit Span Sequence" ~
        "Recall of digits sequences/resequencing",
      scale ==
        "Longest Letter-Number Sequence" ~
        "Longest letter-number sequence span",
      TRUE ~ as.character(description)
    )
  )

Glue results

table7 <-
  table7 %>%
  dplyr::mutate(
    result = glue::glue(
      "{description} was {range}.\n"
    )
  )

Relocate variables

table7 <-
  table7 |>
  dplyr::relocate(
    c(raw_score, score, percentile, range, ci_95),
    .before = test
  )

Finalize and save csv

Merge tables

wais4 <- dplyr::bind_rows(table1, table2, table3, table4, table5)
# if (params$version == "full") {
#   wais4 <-
#     dplyr::bind_rows(table1, table2, table3, table4, table5)
# }
# if (params$version == "brief") {
#   wais4 <-
#     dplyr::bind_rows(table2, table3, table4, table5)
# }

Match subtests to include

# Concatenate the indices into a single vector
# row_indices <- c(6, 1, 7, 12:19, 2, 20, 24, 3, 27:32, 4, 33:34, 5, 35:37)

# Use slice to select the rows by these indices
# nabs <- nabs |>
#   dplyr::slice(row_indices)

match_wais4 <- c(
  # IQ
  "Full Scale (FSIQ)",
  "General Ability (GAI)",
  # VCI
  "Verbal Comprehension (VCI)",
  "Similarities",
  "Vocabulary",
  # PRI
  "Perceptual Reasoning (PRI)",
  "Matrix Reasoning",
  "Block Design",
  "Block Design No Time Bonus",
  "Figure Weights",
  # WMI
  "Working Memory (WMI)",
  "Arithmetic",
  "Letter-Number Sequencing",
  "Longest Letter-Number Sequence",
  "Digit Span",
  "Digit Span Forward",
  "Digit Span Backward",
  "Digit Span Sequencing",
  "Longest Digit Span Forward",
  "Longest Digit Span Backward",
  "Longest Digit Span Sequence",
  # PSI
  "Processing Speed (PSI)",
  "Coding",
  "Symbol Search",
  "Cancellation"
)

matched_indices <- match(
  x = match_wais4,
  table = wais4$scale,
  nomatch = NA
)

# Remove NA values from the matched indices
matched_indices <- na.omit(matched_indices)

# Subset wais4 using the non-NA matched indices
wais4_subset <- wais4[matched_indices, ] # Assuming wais4 is a dataframe

Write out final csv

wais4 <- wais4 |> dplyr::select(-row_names)

readr::write_excel_csv(wais4, here::here("csv", "wais4.csv"), col_names = TRUE)

Write to "g2"

has_headers <- function(file_path) {
  if (!file.exists(file_path)) {
    return(FALSE) # File doesn't exist, headers are needed
  }
  # Check if the file has at least one line (header)
  return(length(readLines(file_path, n = 1)) > 0)
}

table <- wais4
test <- "g2"
file_path <- here::here("csv", paste0(test, ".csv"))

readr::write_excel_csv(
  table,
  file_path,
  append = TRUE,
  col_names = !has_headers(file_path),
  quote = "all"
)

jtrampush/npsych.data documentation built on Feb. 25, 2025, 12:30 a.m.