In jtrampush/npsych.data: BrainWorkup Neuropsychological Report Writing Package
NAB Screener
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(tidytable)
library(bwu)
library(hablar)
library(here)
library(magrittr)
library(readr)
library(rJava)
library(rmarkdown)
library(rmdformats)
library(shiny)
library(tabulapdf)
library(tabulapdfjars)
library(tibble)
library(tidyr)
library(dplyr)
Patient
patient <- params$patient
Test
test <- params$test
test_name <- params$test_name
Upload/attach PDF
file <- file.path(params$file)
Pages
pages <- params$pages
writeLines(file, here::here(patient, "pre_csv", "nabs_pdf"))
file <- readLines(here::here(patient, "pre_csv", "nabs_pdf"))
Locate areas
area <- list(
index = c(134, 65, 292, 543),
att = c(133, 66, 468, 542),
lan = c(138, 67, 354, 533),
mem = c(229, 67, 387, 541),
spt = c(139, 65, 194, 542),
exe = c(374, 65, 456, 542)
)
# if unknown
file <- file.choose()
area2 <- bwu::gpluck_locate_areas(
file = file,
pages = c(2, 5, 6, 7, 8, 8)
)
saveRDS(area, here::here(patient, "pre_csv", "area_nabs.rds"))
area <- readRDS(here::here(patient, "pre_csv", "area_nabs.rds"))
Extract tables
plucked_tables <- bwu::gpluck_extract_tables(
file = file,
pages = pages,
area = area,
guess = NULL,
method = "lattice",
output = "matrix"
)
NAB Index Score
table1 <- tibble::as_tibble(plucked_tables[[1]])
colnames(table1) <- params$column_names1
table1$raw_score <- ""
to_double <- c("raw_score", "score", "percentile")
table1 <- table1 |>
hablar::convert(dbl(all_of(to_double))) |>
dplyr::relocate(raw_score, .before = score)
table1 <- table1 %>% dplyr::mutate(absort = paste0(seq_len(nrow(table1))))
table1$absort <- as.numeric(table1$absort)
table1 <-
table1 |>
arrange(desc(score)) |>
arrange(desc(percentile)) |>
slice(1:6) |>
arrange(absort)
table1[1, 1] <- c("NAB Attention Index")
table1[2, 1] <- c("NAB Language Index")
table1[3, 1] <- c("NAB Memory Index")
table1[4, 1] <- c("NAB Spatial Index")
table1[5, 1] <- c("NAB Executive Functions Index")
table1[6, 1] <- c("NAB Total Index")
NAB Attention
table2 <- as_tibble(plucked_tables[[2]])
colnames(table2) <- params$column_names2
to_double <- c("raw_score", "z_score", "score", "percentile")
table2 <- table2 |> hablar::convert(dbl(all_of(to_double)))
table2 <- table2 |> dplyr::mutate(absort = paste0(seq_len(nrow(table2))))
table2$absort <- as.numeric(table2$absort)
table2 <-
table2 |>
arrange(desc(raw_score)) |>
arrange(desc(score)) |>
arrange(desc(percentile)) |>
slice(1:13) |>
arrange(absort)
if (params$test == "nabs") {
table2[1, 1] <- c("Orientation")
table2[2, 1] <- c("Orientation to Self")
table2[3, 1] <- c("Orientation to Time")
table2[4, 1] <- c("Orientation to Place")
table2[5, 1] <- c("Orientation to Situation")
table2[6, 1] <- c("Digits Forward")
table2[7, 1] <- c("Digits Forward Longest Span")
table2[8, 1] <- c("Digits Backward")
table2[9, 1] <- c("Digits Backward Longest Span")
table2[10, 1] <- c("Numbers & Letters Part A Speed")
table2[11, 1] <- c("Numbers & Letters Part A Errors")
table2[12, 1] <- c("Numbers & Letters Part A Efficiency")
table2[13, 1] <- c("Numbers & Letters Part B Efficiency")
} else if (params$test == "nab") {
table2[1, 1] <- c("Digits Forward")
table2[2, 1] <- c("Digits Backward")
table2[3, 1] <- c("Dots")
table2[4, 1] <- c("Numbers & Letters Part A Efficiency")
table2[5, 1] <- c("Numbers & Letters Part B Efficiency")
table2[6, 1] <- c("Numbers & Letters Part C Efficiency")
table2[7, 1] <- c("Numbers & Letters Part D Efficiency")
table2[8, 1] <- c("Driving Scenes")
}
table2[10, 5] <- 1
table2[12, 5] <- 1
table2[13, 5] <- 1
NAB Language
table3 <- as_tibble(plucked_tables[[3]])
colnames(table3) <- params$column_names2
to_double <- c("raw_score", "z_score", "score", "percentile")
table3 <-
table3 |>
hablar::convert(dbl(all_of(to_double))) %>%
slice(2, 5, 8, 11, 14, 16, 19)
if (params$test == "nabs") {
table3[1, 1] <- c("Auditory Comprehension")
table3[2, 1] <- c("Auditory Comprehension Colors")
table3[3, 1] <- c("Auditory Comprehension Shapes")
table3[4, 1] <- c("Auditory Comprehension Colors/Shapes/Numbers")
table3[5, 1] <- c("Naming")
table3[6, 1] <- c("Naming Semantic Cuing")
table3[7, 1] <- c("Naming Phonemic Cuing")
} else if (params$test == "nab") {
table3[1, 1] <- c("Oral Production")
table3[2, 1] <- c("Auditory Comprehension")
table3[3, 1] <- c("Naming")
table3[4, 1] <- c("Writing")
table3[5, 1] <- c("Bill Payment")
}
table3[1, 5] <- 1
NAB Memory
table4 <- as_tibble(plucked_tables[[4]])
colnames(table4) <- params$column_names3
to_double <- c("raw_score", "z_score", "score", "percentile")
table4 <- table4 |> hablar::convert(dbl(all_of(to_double)))
table4 <- table4 |> dplyr::mutate(absort = paste0(seq_len(nrow(table4))))
table4$absort <- as.numeric(table4$absort)
table4 <- table4 |>
arrange(desc(raw_score)) |>
arrange(desc(score)) |>
arrange(desc(percentile)) |>
slice(1:6) |>
arrange(absort)
if (params$test == "nabs") {
table4[1, 1] <- c("Shape Learning Immediate Recognition")
table4[2, 1] <- c("Shape Learning Delayed Recognition")
table4[3, 1] <- c("Shape Learning Percent Retention")
table4[4, 1] <- c("Story Learning Immediate Recall")
table4[5, 1] <- c("Story Learning Delayed Recall")
table4[6, 1] <- c("Story Learning Percent Retention")
} else if (params$test == "nab") {
table4[1, 1] <- c("List Learning Immediate Recall")
table4[2, 1] <- c("List Learning Short Delayed Recall")
table4[3, 1] <- c("List Learning Long Delayed Recall")
} else if (params$test == "nab") {
table4[1, 1] <- c("List Learning Immediate Recall")
table4[2, 1] <- c("List Learning Short Delayed Recall")
table4[3, 1] <- c("List Learning Long Delayed Recall")
table4[4, 1] <- c("Story Learning Immediate Recall")
table4[5, 1] <- c("Story Learning Short Delayed Recall")
table4[6, 1] <- c("Story Learning Long Delayed Recall")
}
NAB Spatial
table5 <- as_tibble(plucked_tables[[5]])
colnames(table5) <- params$column_names3
to_double <- c("raw_score", "z_score", "score", "percentile")
table5 <- table5 |> hablar::convert(dbl(all_of(to_double)))
table5 <- table5 |> dplyr::mutate(absort = paste0(seq_len(nrow(table5))))
table5$absort <- as.numeric(table5$absort)
table5 <- table5 |>
arrange(desc(raw_score)) |>
arrange(desc(score)) |>
arrange(desc(percentile)) |>
slice(1:2) |>
arrange(absort)
table5[1, 1] <- c("Visual Discrimination")
table5[2, 1] <- c("Design Construction")
# table5[1, 5] <- 1
NAB Executive Functions
table6 <- as_tibble(plucked_tables[[6]])
colnames(table6) <- params$column_names3
to_double <- c("raw_score", "z_score", "score", "percentile")
table6 <- table6 |> hablar::convert(dbl(all_of(to_double)))
table6 <- table6 |> dplyr::mutate(absort = paste0(seq_len(nrow(table6))))
table6$absort <- as.numeric(table6$absort)
table6 <- table6 |>
arrange(desc(raw_score)) |>
arrange(desc(score)) |>
arrange(desc(percentile)) |>
slice(1:3) |>
arrange(absort)
table6[1, 1] <- c("Mazes")
table6[2, 1] <- c("Word Generation")
table6[3, 1] <- c("Word Generation Perseverations")
# table6[1, 5] <- 1
Select variables to keep
table1 <- table1 |> dplyr::select(all_of(params$keep1))
table2 <- table2 |> dplyr::select(all_of(params$keep2))
table3 <- table3 |> dplyr::select(all_of(params$keep2))
table4 <- table4 |> dplyr::select(all_of(params$keep2))
table5 <- table5 |> dplyr::select(all_of(params$keep2))
table6 <- table6 |> dplyr::select(all_of(params$keep2))
Mutate/Format Tables
table1 <- bwu::gpluck_make_columns(
table1,
range = "",
test = params$test,
test_name = params$test_name,
domain = "",
subdomain = "",
narrow = "",
pass = "",
verbal = "",
timed = "",
test_type = "npsych_test",
score_type = "standard_score",
absort = "",
description = "",
result = ""
)
table2 <- bwu::gpluck_make_columns(
table2,
range = "",
ci_95 = "",
test = params$test,
test_name = params$test_name,
domain = "Attention/Executive",
subdomain = "",
narrow = "",
timed = "",
verbal = "",
pass = "Attention",
test_type = "npsych_test",
score_type = "t_score",
absort = "",
description = "",
result = ""
)
table3 <- bwu::gpluck_make_columns(
table3,
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 = "t_score",
description = "",
result = ""
)
table4 <- bwu::gpluck_make_columns(
table4,
range = "",
ci_95 = "",
test = params$test,
test_name = params$test_name,
domain = "Memory",
subdomain = "",
narrow = "",
pass = "",
verbal = "",
timed = "Untimed",
test_type = "npsych_test",
score_type = "t_score",
description = "",
result = ""
)
table5 <- bwu::gpluck_make_columns(
table5,
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 = "t_score",
absort = "",
description = "",
result = ""
)
table6 <- bwu::gpluck_make_columns(
table6,
range = "",
ci_95 = "",
test = params$test,
test_name = params$test_name,
domain = "Attention/Executive",
subdomain = "",
narrow = "",
timed = "Timed",
verbal = "",
pass = "",
test_type = "npsych_test",
score_type = "t_score",
absort = "",
description = "",
result = ""
)
Test score ranges
table1 <-
bwu::gpluck_make_score_ranges(table = table1, test_type = "npsych_test")
table2 <-
bwu::gpluck_make_score_ranges(table = table2, test_type = "npsych_test")
table3 <-
bwu::gpluck_make_score_ranges(table = table3, test_type = "npsych_test")
table4 <-
bwu::gpluck_make_score_ranges(table = table4, test_type = "npsych_test")
table5 <-
bwu::gpluck_make_score_ranges(table = table5, test_type = "npsych_test")
table6 <-
bwu::gpluck_make_score_ranges(table = table6, test_type = "npsych_test")
Domains
table1 <-
table1 |>
dplyr::mutate(
domain = dplyr::case_when(
scale == "NAB Total Index" ~ "General Cognitive Ability",
scale == "NAB Attention Index" ~ "General Cognitive Ability",
scale == "NAB Language Index" ~ "General Cognitive Ability",
scale == "NAB Memory Index" ~ "General Cognitive Ability",
scale == "NAB Spatial Index" ~ "General Cognitive Ability",
scale == "NAB Executive Functions Index" ~ "General Cognitive Ability",
TRUE ~ as.character(domain)
)
)
# table6 <-
# table6 |>
# dplyr::mutate(
# domain = dplyr::case_when(
# scale == "Word Generation" ~ "Verbal/Language",
# TRUE ~ as.character(domain)
# )
# )
Subdomains
table1 <-
table1 |>
dplyr::mutate(
subdomain = dplyr::case_when(
scale == "NAB Attention Index" ~ "Neuropsychological Functioning",
scale == "NAB Language Index" ~ "Neuropsychological Functioning",
scale == "NAB Memory Index" ~ "Neuropsychological Functioning",
scale == "NAB Spatial Index" ~ "Neuropsychological Functioning",
scale == "NAB Executive Functions Index" ~ "Neuropsychological Functioning",
scale == "NAB Total Index" ~ "Neuropsychological Functioning",
TRUE ~ as.character(subdomain)
)
)
orientation <- c(
"Orientation",
"Orientation to Self",
"Orientation to Time",
"Orientation to Place",
"Orientation to Situation"
)
dsf <- c(
"Digits Forward",
"Digits Forward Longest Span"
)
dsb <- c(
"Digits Backward",
"Digits Backward Longest Span"
)
nlt <- c(
"Numbers & Letters Part A Speed",
"Numbers & Letters Part A Efficiency",
"Numbers & Letters Part B Efficiency"
)
nle <- c(
"Numbers & Letters Part A Errors"
)
shl <- c(
"Shape Learning Immediate Recognition",
"Shape Learning Delayed Recognition",
"Shape Learning Percent Retention"
)
stl <- c(
"Story Learning Immediate Recall",
"Story Learning Delayed Recall",
"Story Learning Percent Retention"
)
table2 <-
table2 |>
dplyr::mutate(
subdomain = dplyr::case_when(
scale %in% orientation ~ "Attention",
scale %in% dsf ~ "Attention",
scale %in% dsb ~ "Working Memory",
scale == "Numbers & Letters Part A Speed" ~ "Processing Speed",
scale == "Numbers & Letters Part A Errors" ~ "Attention",
scale == "Numbers & Letters Part A Efficiency" ~ "Processing Speed",
scale == "Numbers & Letters Part B Efficiency" ~ "Attention",
TRUE ~ as.character(subdomain)
)
)
table3 <-
table3 |>
dplyr::mutate(
subdomain = dplyr::case_when(
scale %in% c("Auditory Comprehension") ~ "Listening Ability",
scale %in% c("Naming") ~ "Word Retrieval",
TRUE ~ as.character(subdomain)
)
)
Learning Efficiency
table4 <-
table4 |>
dplyr::mutate(
subdomain = dplyr::case_when(
scale ==
"Shape Learning Immediate Recognition" ~ "Learning Efficiency",
scale ==
"Shape Learning Delayed Recognition" ~ "Delayed Recall",
scale ==
"Shape Learning Percent Retention" ~ "Delayed Recall",
scale ==
"Story Learning Immediate Recall" ~ "Learning Efficiency",
scale ==
"Story Learning Delayed Recall" ~ "Delayed Recall",
scale ==
"Story Learning Percent Retention" ~ "Delayed Recall",
TRUE ~ as.character(subdomain)
)
)
table5 <-
table5 |>
dplyr::mutate(
subdomain = dplyr::case_when(
scale == "Visual Discrimination" ~ "Perception",
scale == "Design Construction" ~ "Construction",
TRUE ~ as.character(subdomain)
)
)
table6 <-
table6 |>
dplyr::mutate(
subdomain = dplyr::case_when(
scale == "Mazes" ~ "Executive Functioning",
scale == "Word Generation" ~ "Executive Functioning",
scale == "Word Generation Perseverations" ~ "Attention",
TRUE ~ as.character(subdomain)
)
)
Narrow subdomains
table1 <-
table1 |>
dplyr::mutate(
narrow = dplyr::case_when(
scale == "NAB Total Index" ~ "NAB Total Index",
scale == "NAB Attention Index" ~ "NAB Attention Index",
scale == "NAB Language Index" ~ "NAB Language Index",
scale == "NAB Memory Index" ~ "NAB Memory Index",
scale == "NAB Spatial Index" ~ "NAB Spatial Index",
scale == "NAB Executive Functions Index" ~ "NAB Executive Functions Index",
TRUE ~ as.character(narrow)
)
)
table2 <-
table2 |>
dplyr::mutate(
narrow = dplyr::case_when(
scale %in% orientation ~ "Orientation",
scale %in% dsf ~ "Attention Span",
scale %in% dsb ~ "Working Memory Capacity",
scale == "Numbers & Letters Part A Speed" ~ "Psychomotor Speed",
scale == "Numbers & Letters Part A Errors" ~ "Response Monitoring",
scale == "Numbers & Letters Part A Efficiency" ~ "Cognitive Efficiency",
scale == "Numbers & Letters Part B Efficiency" ~ "Attentional Fluency",
TRUE ~ as.character(narrow)
)
)
table3 <-
table3 |>
dplyr::mutate(
narrow = dplyr::case_when(
scale == "Auditory Comprehension" ~ "Auditory Comprehension",
scale == "Naming" ~ "Naming",
TRUE ~ as.character(narrow)
)
)
table4 <-
table4 |>
dplyr::mutate(
narrow = dplyr::case_when(
scale %in% shl ~ "Visual Memory",
scale %in% stl ~ "Story Memory",
TRUE ~ as.character(narrow)
)
)
table5 <-
table5 |>
dplyr::mutate(
narrow = dplyr::case_when(
scale == "Visual Discrimination" ~ "Perception",
scale == "Design Construction" ~ "Construction",
TRUE ~ as.character(narrow)
)
)
table6 <-
table6 |>
dplyr::mutate(
narrow = dplyr::case_when(
scale == "Mazes" ~ "Planning",
scale == "Word Generation" ~ "Generativity",
scale == "Word Generation Perseverations" ~ "Response Monitoring",
TRUE ~ as.character(narrow)
)
)
PASS
table1 <-
table1 |>
dplyr::mutate(
pass = dplyr::case_when(
scale == "NAB Attention Index" ~ "Attention",
scale == "NAB Language Index" ~ "",
scale == "NAB Memory Index" ~ "",
scale == "NAB Spatial Index" ~ "Simultaneous",
scale == "NAB Executive Functions Index" ~ "Planning",
scale == "NAB Total Index" ~ "",
TRUE ~ as.character(pass)
)
)
table2 <-
table2 |>
dplyr::mutate(
pass = dplyr::case_when(
scale %in% orientation ~ "Attention",
scale %in% dsf ~ "Sequential",
scale %in% dsb ~ "Attention",
scale %in% nlt ~ "Attention",
scale %in% nle ~ "Attention",
TRUE ~ as.character(pass)
)
)
table3 <-
table3 |>
dplyr::mutate(
pass = dplyr::case_when(
scale == "Auditory Comprehension" ~ "Sequential",
scale == "Naming" ~ "Knowledge",
TRUE ~ as.character(pass)
)
)
table4 <-
table4 |>
dplyr::mutate(
pass = dplyr::case_when(
scale %in% shl ~ "Simultaneous",
scale %in% stl ~ "Sequential",
TRUE ~ as.character(pass)
)
)
table5 <-
table5 |>
dplyr::mutate(
pass = dplyr::case_when(
scale == "Visual Discrimination" ~ "Simultaneous",
scale == "Design Construction" ~ "Simultaneous",
TRUE ~ as.character(pass)
)
)
table6 <-
table6 |>
dplyr::mutate(
pass = dplyr::case_when(
scale == "Mazes" ~ "Planning",
scale == "Word Generation" ~ "Sequential",
scale == "Word Generation Perseverations" ~ "Attention",
TRUE ~ as.character(pass)
)
)
Verbal vs Nonverbal
table1 <-
table1 |>
dplyr::mutate(
verbal = dplyr::case_when(
scale == "NAB Attention Index" ~ "",
scale == "NAB Language Index" ~ "Verbal",
scale == "NAB Memory Index" ~ "",
scale == "NAB Spatial Index" ~ "Nonverbal",
scale == "NAB Executive Functions Index" ~ "",
scale == "NAB Total Index" ~ "",
TRUE ~ as.character(verbal)
)
)
table2 <-
table2 |>
dplyr::mutate(
verbal = dplyr::case_when(
scale %in% orientation ~ "Verbal",
scale %in% dsf ~ "Verbal",
scale %in% dsb ~ "Verbal",
scale %in% nlt ~ "Nonverbal",
scale %in% nle ~ "Nonverbal",
TRUE ~ as.character(verbal)
)
)
table4 <-
table4 |>
dplyr::mutate(
verbal = dplyr::case_when(
scale %in% shl ~ "Nonverbal",
scale %in% stl ~ "Verbal",
TRUE ~ as.character(verbal)
)
)
table6 <-
table6 |>
dplyr::mutate(
verbal = dplyr::case_when(
scale == "Mazes" ~ "Nonverbal",
scale == "Word Generation" ~ "Verbal",
scale == "Word Generation Perseverations" ~ "Verbal",
TRUE ~ as.character(verbal)
)
)
Timed vs Untimed
table1 <-
table1 |>
dplyr::mutate(
timed = dplyr::case_when(
scale == "NAB Attention Index" ~ "",
scale == "NAB Language Index" ~ "Untimed",
scale == "NAB Memory Index" ~ "",
scale == "NAB Spatial Index" ~ "",
scale == "NAB Executive Functions Index" ~ "Timed",
scale == "NAB Total Index" ~ "",
TRUE ~ as.character(timed)
)
)
table2 <-
table2 |>
dplyr::mutate(
timed = dplyr::case_when(
scale %in% orientation ~ "Untimed",
scale %in% dsf ~ "Untimed",
scale %in% dsb ~ "Untimed",
scale %in% nlt ~ "Timed",
scale %in% nle ~ "Timed",
TRUE ~ as.character(timed)
)
)
table3 <-
table3 |>
dplyr::mutate(
timed = dplyr::case_when(
scale == "Auditory Comprehension" ~ "Untimed",
scale == "Naming" ~ "Untimed",
TRUE ~ as.character(timed)
)
)
table4 <-
table4 |>
dplyr::mutate(
timed = dplyr::case_when(
scale %in% shl ~ "Untimed",
scale %in% stl ~ "Untimed",
TRUE ~ as.character(timed)
)
)
table5 <-
table5 |>
dplyr::mutate(
timed = dplyr::case_when(
scale == "Visual Discrimination" ~ "Untimed",
scale == "Design Construction" ~ "Timed",
TRUE ~ as.character(timed)
)
)
table6 <-
table6 |>
dplyr::mutate(
timed = dplyr::case_when(
scale == "Mazes" ~ "Timed",
scale == "Word Generation" ~ "Timed",
scale == "Word Generation Perseverations" ~ "Timed",
TRUE ~ as.character(timed)
)
)
Score type
table2 <-
table2 |>
dplyr::mutate(
score_type = dplyr::case_when(
scale == "Orientation" ~ "percentile",
scale == "Orientation to Self" ~ "base_rate",
scale == "Orientation to Time" ~ "base_rate",
scale == "Orientation to Place" ~ "base_rate",
scale == "Orientation to Situation" ~ "base_rate",
scale == "Digits Forward Longest Span" ~ "raw_score",
scale == "Digits Backward Longest Span" ~ "raw_score",
TRUE ~ as.character(score_type)
)
)
table3 <-
table3 |>
dplyr::mutate(
score_type = dplyr::case_when(
scale == "Auditory Comprehension Colors" ~ "base_rate",
scale == "Auditory Comprehension Shapes" ~ "base_rate",
scale == "Auditory Comprehension Colors/Shapes/Numbers" ~ "base_rate",
scale == "Naming Semantic Cuing" ~ "base_rate",
scale == "Naming Phonemic Cuing" ~ "base_rate",
TRUE ~ as.character(score_type)
)
)
table4 <-
table4 |>
dplyr::mutate(
score_type = dplyr::case_when(
scale == "Shape Learning Percent Retention" ~ "percentile",
scale == "Story Learning Percent Retention" ~ "percentile",
TRUE ~ as.character(score_type)
)
)
table6 <-
table6 |>
dplyr::mutate(
score_type = dplyr::case_when(
scale == "Word Generation Perseverations" ~ "percentile",
TRUE ~ as.character(score_type)
)
)
Scale descriptions
table1 <-
table1 |>
dplyr::mutate(
description = dplyr::case_when(
scale ==
"NAB Total Index" ~ "A comprehensive measure of neuropsychological functioning (independent of general intelligence) in the domains of attentional and executive functioning, language, spatial processing, and memory",
scale ==
"NAB Attention Index" ~ "An overall screening measure of the examinee's attentional functioning",
scale ==
"NAB Language Index" ~ "A composite screening measure of language comprehension and word-finding abilities",
scale ==
"NAB Memory Index" ~ "A composite measure of the examinee's verbal and visual memory functioning",
scale ==
"NAB Spatial Index" ~ "A composite screening measure of visuoperceptual skills, attention to detail, and visuoconstructional skills",
scale ==
"NAB Executive Functions Index" ~ "A composite measure of executive skills involving planning, inhibition, speed/fluency, and generativity",
TRUE ~ as.character(description)
)
)
table2 <-
table2 |>
dplyr::mutate(
description = dplyr::case_when(
scale ==
"Orientation" ~ "Orientation to person, place, time, and situation",
scale ==
"Digits Forward" ~ "Auditory attentional capacity, or how much information can be processed at once",
scale ==
"Digits Forward Longest Span" ~ "Auditory attentional capacity",
scale ==
"Digits Backward" ~ "A measure of both attentional capacity and working memory",
scale ==
"Digits Backward Longest Span" ~ "Working memory for orally presented information",
scale ==
"Numbers & Letters Part A Speed" ~ "Psychomotor speed",
scale ==
"Numbers & Letters Part A Errors" ~ "A marker of reduced focus, or selective attention, distractibility, or reduced concentration, and diminished sustained attention",
scale ==
"Numbers & Letters Part A Efficiency" ~ "An overall measure of efficiency in performing a selective attention letter cancellation task",
scale ==
"Numbers & Letters Part B Efficiency" ~ "Performance on a complex measure of divided attention, information processing speed, and inhibition",
TRUE ~ as.character(description)
)
)
table3 <-
table3 |>
dplyr::mutate(
description = dplyr::case_when(
scale ==
"Auditory Comprehension" ~ "Auditory comprehension (i.e., the ability to receive, process, and execute oral instructions of increasing syntactic complexity)",
scale ==
"Naming" ~ "Screening of word-finding ability and retrieval fluency on a confrontation naming task",
TRUE ~ as.character(description)
)
)
table4 <-
table4 |>
dplyr::mutate(
description = dplyr::case_when(
scale ==
"Shape Learning Immediate Recognition" ~ "Learning and recognition of visual material (abstract shapes)",
scale ==
"Shape Learning Delayed Recognition" ~ "Recognition of the target visual material among nontarget distractors after a delay period",
scale ==
"Shape Learning Percent Retention" ~ "Percentage of visual detail retained over time, scaled to how much was initially learned",
scale ==
"Story Learning Immediate Recall" ~ "Performance on a more complex one-trial verbal learning and recall task (story learning)",
scale ==
"Story Learning Delayed Recall" ~ "Delayed recall of the story details over time",
scale ==
"Story Learning Percent Retention" ~ "The percentage of story detail retained over time, scaled to how much was initially learned",
TRUE ~ as.character(description)
)
)
table5 <-
table5 |>
dplyr::mutate(
description = dplyr::case_when(
scale ==
"Visual Discrimination" ~ "Perceptual processing, discrimination, and pattern matching of a series of abstract images requiring close attention to visual detail",
scale ==
"Design Construction" ~ "Constructing and recreating abstract visual designs (tangrams) from a model using flat polygons (tans) to reproduce each stimulus",
TRUE ~ as.character(description)
)
)
table6 <-
table6 |>
dplyr::mutate(
description = dplyr::case_when(
scale == "Mazes" ~ "Planning and foresight, inhibition, and psychomotor speed examined through a series of maze-tracing tasks",
scale == "Word Generation" ~ "Retrieval fluency, ideational fluency, and generativity",
scale == "Word Generation Perseverations" ~ "Self-monitoring and perseverative tendencies",
TRUE ~ as.character(description)
)
)
Glue results
table1 <-
table1 |>
dplyr::mutate(
result = dplyr::case_when(
scale ==
"NAB Total Index" ~ glue::glue(
"{description} fell in the {range} range.\n"
),
scale ==
"NAB Attention Index" ~ glue::glue(
"{description} was {range}.\n"
),
scale ==
"NAB Language Index" ~ glue::glue(
"{description} fell in the {range} classification range.\n"
),
scale ==
"NAB Memory Index" ~ glue::glue(
"{description} was {range}.\n"
),
scale ==
"NAB Spatial Index" ~ glue::glue(
"{description} fell in the {range} classification range.\n"
),
scale ==
"NAB Executive Functions Index" ~ glue::glue(
"{description} fell in the {range} range.\n"
),
TRUE ~ as.character(result)
)
)
table2 <-
table2 |>
dplyr::mutate(
result = dplyr::case_when(
scale ==
"Orientation" ~ glue::glue("{description} was intact.\n"),
scale ==
"Digits Forward" ~ glue::glue("{description} fell within the {range}.\n"),
scale ==
"Digits Forward Longest Span" ~ glue::glue("{description} was {range} ({raw_score} digits forward).\n"),
scale ==
"Digits Backward" ~ glue::glue("{description} fell within the {range}.\n"),
scale ==
"Digits Backward Longest Span" ~ glue::glue("{description} was {range} ({raw_score} digits backward).\n"),
scale ==
"Numbers & Letters Part A Efficiency" ~ glue::glue("{description} was {range}.\n"),
scale ==
"Numbers & Letters Part B Efficiency" ~ glue::glue("{description} was {range}.\n"),
scale ==
"Numbers & Letters Part A Speed" ~ glue::glue("{description} fell within the {range}.\n"),
scale ==
"Numbers & Letters Part A Errors" ~ glue::glue("{description} fell within the {range}.\n"),
TRUE ~ as.character(result)
)
)
table3 <-
table3 |>
dplyr::mutate(
result = dplyr::case_when(
scale ==
"Auditory Comprehension" ~ glue::glue("{description} was {range}.\n"),
scale ==
"Naming" ~ glue::glue("{description} was {range}, with no obvious dysfluency in conversational/informal expression.\n"),
TRUE ~ as.character(result)
)
)
table4 <-
table4 |>
dplyr::mutate(
result = dplyr::case_when(
scale == "Shape Learning Immediate Recognition" ~
glue::glue("{description} was {range}.\n"),
scale == "Shape Learning Delayed Recognition" ~
glue::glue("{description} was {range}.\n"),
scale == "Shape Learning Percent Retention" ~
glue::glue("{description} fell in the {range} range.\n"),
scale == "Story Learning Immediate Recall" ~
glue::glue("{description} was {range}.\n"),
scale == "Story Learning Delayed Recall" ~
glue::glue("{description} was {range}.\n"),
scale == "Story Learning Percent Retention" ~
glue::glue("{description} fell in the {range} range.\n"),
TRUE ~ as.character(result)
)
)
table5 <-
table5 |>
dplyr::mutate(
result = dplyr::case_when(
scale == "Visual Discrimination" ~
glue::glue("{description} was {range}.\n"),
scale == "Design Construction" ~
glue::glue("{description} fell in the {range} range.\n"),
TRUE ~ as.character(result)
)
)
table6 <-
table6 |>
dplyr::mutate(
result = dplyr::case_when(
scale == "Mazes" ~
glue::glue("{description} fell in the {range} range.\n"),
scale == "Word Generation" ~
glue::glue("{description} was {range}.\n"),
scale == "Word Generation Perseverations" ~
glue::glue("{description} was {range}.\n"),
TRUE ~ as.character(result)
)
)
Finalize and save
Relocate variables
table1 <-
table1 |>
relocate(c(raw_score, score, percentile, range, ci_95), .before = test)
table2 <-
table2 |>
relocate(c(raw_score, score, percentile, range, ci_95), .before = test)
table3 <-
table3 |>
relocate(c(raw_score, score, percentile, range, ci_95), .before = test)
table4 <-
table4 |>
relocate(c(raw_score, score, percentile, range, ci_95), .before = test)
table5 <-
table5 |>
relocate(c(raw_score, score, percentile, range, ci_95), .before = test)
table6 <-
table6 |>
relocate(c(raw_score, score, percentile, range, ci_95), .before = test)
Merge NAB tables
nabs <- dplyr::bind_rows(
table1,
table2,
table3,
table4,
table5,
table6
)
df <- nabs
Slice/Reorder table
# 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)
# nabs <-
# nabs |>
# dplyr::slice(
# index = (6),
# att = c(1, 7, 12:19),
# lan = c(2, 20, 24),
# mem = c(3, 27:32),
# spt = c(4, 33:34),
# exe = c(5, 35:37)
# )
Compute CI 95%
library(bwu)
df <- nabs
# Assuming df is your dataframe and calc_ci_95 is your function
for (i in 1:nrow(df)) {
ci_values <- calc_ci_95(
ability_score = df$score[i],
mean = 50,
standard_deviation = 10,
reliability = .85
)
df$true_score[i] <- paste0(ci_values["true_score"])
df$ci_lo[i] <- paste0(ci_values["lower_ci_95"])
df$ci_hi[i] <- paste0(ci_values["upper_ci_95"])
df$ci[i] <- paste0(ci_values["lower_ci_95"], " - ", ci_values["upper_ci_95"])
}
Write final csv table
readr::write_excel_csv(nabs, here::here("csv", "nabs.csv"), col_names = TRUE, na = "")
if (any(is.na(nabs$percentile))) {
stop("STOP!!! NA value found in percentile column. Please fill in missing values.")
}
Write g2
table <- nabs
test <- "g2"
file_path <- here::here("csv", paste0(test, ".csv"))
readr::write_excel_csv(nabs, here::here("csv", "nabs.csv"), append = TRUE, na = "")
jtrampush/npsych.data documentation built on Feb. 25, 2025, 12:30 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
NAB Screener
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(tidytable) library(bwu) library(hablar) library(here) library(magrittr) library(readr) library(rJava) library(rmarkdown) library(rmdformats) library(shiny) library(tabulapdf) library(tabulapdfjars) library(tibble) library(tidyr) library(dplyr)
Patient
patient <- params$patient
Test
test <- params$test test_name <- params$test_name
Upload/attach PDF
file <- file.path(params$file)
Pages
pages <- params$pages
writeLines(file, here::here(patient, "pre_csv", "nabs_pdf"))
file <- readLines(here::here(patient, "pre_csv", "nabs_pdf"))
Locate areas
area <- list( index = c(134, 65, 292, 543), att = c(133, 66, 468, 542), lan = c(138, 67, 354, 533), mem = c(229, 67, 387, 541), spt = c(139, 65, 194, 542), exe = c(374, 65, 456, 542) )
# if unknown file <- file.choose() area2 <- bwu::gpluck_locate_areas( file = file, pages = c(2, 5, 6, 7, 8, 8) )
saveRDS(area, here::here(patient, "pre_csv", "area_nabs.rds"))
area <- readRDS(here::here(patient, "pre_csv", "area_nabs.rds"))
Extract tables
plucked_tables <- bwu::gpluck_extract_tables( file = file, pages = pages, area = area, guess = NULL, method = "lattice", output = "matrix" )
NAB Index Score
table1 <- tibble::as_tibble(plucked_tables[[1]]) colnames(table1) <- params$column_names1 table1$raw_score <- "" to_double <- c("raw_score", "score", "percentile") table1 <- table1 |> hablar::convert(dbl(all_of(to_double))) |> dplyr::relocate(raw_score, .before = score)
table1 <- table1 %>% dplyr::mutate(absort = paste0(seq_len(nrow(table1)))) table1$absort <- as.numeric(table1$absort) table1 <- table1 |> arrange(desc(score)) |> arrange(desc(percentile)) |> slice(1:6) |> arrange(absort)
table1[1, 1] <- c("NAB Attention Index") table1[2, 1] <- c("NAB Language Index") table1[3, 1] <- c("NAB Memory Index") table1[4, 1] <- c("NAB Spatial Index") table1[5, 1] <- c("NAB Executive Functions Index") table1[6, 1] <- c("NAB Total Index")
NAB Attention
table2 <- as_tibble(plucked_tables[[2]]) colnames(table2) <- params$column_names2 to_double <- c("raw_score", "z_score", "score", "percentile") table2 <- table2 |> hablar::convert(dbl(all_of(to_double)))
table2 <- table2 |> dplyr::mutate(absort = paste0(seq_len(nrow(table2)))) table2$absort <- as.numeric(table2$absort) table2 <- table2 |> arrange(desc(raw_score)) |> arrange(desc(score)) |> arrange(desc(percentile)) |> slice(1:13) |> arrange(absort)
if (params$test == "nabs") { table2[1, 1] <- c("Orientation") table2[2, 1] <- c("Orientation to Self") table2[3, 1] <- c("Orientation to Time") table2[4, 1] <- c("Orientation to Place") table2[5, 1] <- c("Orientation to Situation") table2[6, 1] <- c("Digits Forward") table2[7, 1] <- c("Digits Forward Longest Span") table2[8, 1] <- c("Digits Backward") table2[9, 1] <- c("Digits Backward Longest Span") table2[10, 1] <- c("Numbers & Letters Part A Speed") table2[11, 1] <- c("Numbers & Letters Part A Errors") table2[12, 1] <- c("Numbers & Letters Part A Efficiency") table2[13, 1] <- c("Numbers & Letters Part B Efficiency") } else if (params$test == "nab") { table2[1, 1] <- c("Digits Forward") table2[2, 1] <- c("Digits Backward") table2[3, 1] <- c("Dots") table2[4, 1] <- c("Numbers & Letters Part A Efficiency") table2[5, 1] <- c("Numbers & Letters Part B Efficiency") table2[6, 1] <- c("Numbers & Letters Part C Efficiency") table2[7, 1] <- c("Numbers & Letters Part D Efficiency") table2[8, 1] <- c("Driving Scenes") } table2[10, 5] <- 1 table2[12, 5] <- 1 table2[13, 5] <- 1
NAB Language
table3 <- as_tibble(plucked_tables[[3]]) colnames(table3) <- params$column_names2 to_double <- c("raw_score", "z_score", "score", "percentile") table3 <- table3 |> hablar::convert(dbl(all_of(to_double))) %>% slice(2, 5, 8, 11, 14, 16, 19)
if (params$test == "nabs") { table3[1, 1] <- c("Auditory Comprehension") table3[2, 1] <- c("Auditory Comprehension Colors") table3[3, 1] <- c("Auditory Comprehension Shapes") table3[4, 1] <- c("Auditory Comprehension Colors/Shapes/Numbers") table3[5, 1] <- c("Naming") table3[6, 1] <- c("Naming Semantic Cuing") table3[7, 1] <- c("Naming Phonemic Cuing") } else if (params$test == "nab") { table3[1, 1] <- c("Oral Production") table3[2, 1] <- c("Auditory Comprehension") table3[3, 1] <- c("Naming") table3[4, 1] <- c("Writing") table3[5, 1] <- c("Bill Payment") } table3[1, 5] <- 1
NAB Memory
table4 <- as_tibble(plucked_tables[[4]]) colnames(table4) <- params$column_names3 to_double <- c("raw_score", "z_score", "score", "percentile") table4 <- table4 |> hablar::convert(dbl(all_of(to_double)))
table4 <- table4 |> dplyr::mutate(absort = paste0(seq_len(nrow(table4)))) table4$absort <- as.numeric(table4$absort) table4 <- table4 |> arrange(desc(raw_score)) |> arrange(desc(score)) |> arrange(desc(percentile)) |> slice(1:6) |> arrange(absort)
if (params$test == "nabs") { table4[1, 1] <- c("Shape Learning Immediate Recognition") table4[2, 1] <- c("Shape Learning Delayed Recognition") table4[3, 1] <- c("Shape Learning Percent Retention") table4[4, 1] <- c("Story Learning Immediate Recall") table4[5, 1] <- c("Story Learning Delayed Recall") table4[6, 1] <- c("Story Learning Percent Retention") } else if (params$test == "nab") { table4[1, 1] <- c("List Learning Immediate Recall") table4[2, 1] <- c("List Learning Short Delayed Recall") table4[3, 1] <- c("List Learning Long Delayed Recall") } else if (params$test == "nab") { table4[1, 1] <- c("List Learning Immediate Recall") table4[2, 1] <- c("List Learning Short Delayed Recall") table4[3, 1] <- c("List Learning Long Delayed Recall") table4[4, 1] <- c("Story Learning Immediate Recall") table4[5, 1] <- c("Story Learning Short Delayed Recall") table4[6, 1] <- c("Story Learning Long Delayed Recall") }
NAB Spatial
table5 <- as_tibble(plucked_tables[[5]]) colnames(table5) <- params$column_names3 to_double <- c("raw_score", "z_score", "score", "percentile") table5 <- table5 |> hablar::convert(dbl(all_of(to_double)))
table5 <- table5 |> dplyr::mutate(absort = paste0(seq_len(nrow(table5)))) table5$absort <- as.numeric(table5$absort) table5 <- table5 |> arrange(desc(raw_score)) |> arrange(desc(score)) |> arrange(desc(percentile)) |> slice(1:2) |> arrange(absort)
table5[1, 1] <- c("Visual Discrimination") table5[2, 1] <- c("Design Construction") # table5[1, 5] <- 1
NAB Executive Functions
table6 <- as_tibble(plucked_tables[[6]]) colnames(table6) <- params$column_names3 to_double <- c("raw_score", "z_score", "score", "percentile") table6 <- table6 |> hablar::convert(dbl(all_of(to_double)))
table6 <- table6 |> dplyr::mutate(absort = paste0(seq_len(nrow(table6)))) table6$absort <- as.numeric(table6$absort) table6 <- table6 |> arrange(desc(raw_score)) |> arrange(desc(score)) |> arrange(desc(percentile)) |> slice(1:3) |> arrange(absort)
table6[1, 1] <- c("Mazes") table6[2, 1] <- c("Word Generation") table6[3, 1] <- c("Word Generation Perseverations") # table6[1, 5] <- 1
Select variables to keep
table1 <- table1 |> dplyr::select(all_of(params$keep1)) table2 <- table2 |> dplyr::select(all_of(params$keep2)) table3 <- table3 |> dplyr::select(all_of(params$keep2)) table4 <- table4 |> dplyr::select(all_of(params$keep2)) table5 <- table5 |> dplyr::select(all_of(params$keep2)) table6 <- table6 |> dplyr::select(all_of(params$keep2))
Mutate/Format Tables
table1 <- bwu::gpluck_make_columns( table1, range = "", test = params$test, test_name = params$test_name, domain = "", subdomain = "", narrow = "", pass = "", verbal = "", timed = "", test_type = "npsych_test", score_type = "standard_score", absort = "", description = "", result = "" )
table2 <- bwu::gpluck_make_columns( table2, range = "", ci_95 = "", test = params$test, test_name = params$test_name, domain = "Attention/Executive", subdomain = "", narrow = "", timed = "", verbal = "", pass = "Attention", test_type = "npsych_test", score_type = "t_score", absort = "", description = "", result = "" )
table3 <- bwu::gpluck_make_columns( table3, 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 = "t_score", description = "", result = "" )
table4 <- bwu::gpluck_make_columns( table4, range = "", ci_95 = "", test = params$test, test_name = params$test_name, domain = "Memory", subdomain = "", narrow = "", pass = "", verbal = "", timed = "Untimed", test_type = "npsych_test", score_type = "t_score", description = "", result = "" )
table5 <- bwu::gpluck_make_columns( table5, 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 = "t_score", absort = "", description = "", result = "" )
table6 <- bwu::gpluck_make_columns( table6, range = "", ci_95 = "", test = params$test, test_name = params$test_name, domain = "Attention/Executive", subdomain = "", narrow = "", timed = "Timed", verbal = "", pass = "", test_type = "npsych_test", score_type = "t_score", absort = "", description = "", result = "" )
Test score ranges
table1 <- bwu::gpluck_make_score_ranges(table = table1, test_type = "npsych_test") table2 <- bwu::gpluck_make_score_ranges(table = table2, test_type = "npsych_test") table3 <- bwu::gpluck_make_score_ranges(table = table3, test_type = "npsych_test") table4 <- bwu::gpluck_make_score_ranges(table = table4, test_type = "npsych_test") table5 <- bwu::gpluck_make_score_ranges(table = table5, test_type = "npsych_test") table6 <- bwu::gpluck_make_score_ranges(table = table6, test_type = "npsych_test")
Domains
table1 <- table1 |> dplyr::mutate( domain = dplyr::case_when( scale == "NAB Total Index" ~ "General Cognitive Ability", scale == "NAB Attention Index" ~ "General Cognitive Ability", scale == "NAB Language Index" ~ "General Cognitive Ability", scale == "NAB Memory Index" ~ "General Cognitive Ability", scale == "NAB Spatial Index" ~ "General Cognitive Ability", scale == "NAB Executive Functions Index" ~ "General Cognitive Ability", TRUE ~ as.character(domain) ) ) # table6 <- # table6 |> # dplyr::mutate( # domain = dplyr::case_when( # scale == "Word Generation" ~ "Verbal/Language", # TRUE ~ as.character(domain) # ) # )
Subdomains
table1 <- table1 |> dplyr::mutate( subdomain = dplyr::case_when( scale == "NAB Attention Index" ~ "Neuropsychological Functioning", scale == "NAB Language Index" ~ "Neuropsychological Functioning", scale == "NAB Memory Index" ~ "Neuropsychological Functioning", scale == "NAB Spatial Index" ~ "Neuropsychological Functioning", scale == "NAB Executive Functions Index" ~ "Neuropsychological Functioning", scale == "NAB Total Index" ~ "Neuropsychological Functioning", TRUE ~ as.character(subdomain) ) )
orientation <- c( "Orientation", "Orientation to Self", "Orientation to Time", "Orientation to Place", "Orientation to Situation" ) dsf <- c( "Digits Forward", "Digits Forward Longest Span" ) dsb <- c( "Digits Backward", "Digits Backward Longest Span" ) nlt <- c( "Numbers & Letters Part A Speed", "Numbers & Letters Part A Efficiency", "Numbers & Letters Part B Efficiency" ) nle <- c( "Numbers & Letters Part A Errors" ) shl <- c( "Shape Learning Immediate Recognition", "Shape Learning Delayed Recognition", "Shape Learning Percent Retention" ) stl <- c( "Story Learning Immediate Recall", "Story Learning Delayed Recall", "Story Learning Percent Retention" )
table2 <- table2 |> dplyr::mutate( subdomain = dplyr::case_when( scale %in% orientation ~ "Attention", scale %in% dsf ~ "Attention", scale %in% dsb ~ "Working Memory", scale == "Numbers & Letters Part A Speed" ~ "Processing Speed", scale == "Numbers & Letters Part A Errors" ~ "Attention", scale == "Numbers & Letters Part A Efficiency" ~ "Processing Speed", scale == "Numbers & Letters Part B Efficiency" ~ "Attention", TRUE ~ as.character(subdomain) ) )
table3 <- table3 |> dplyr::mutate( subdomain = dplyr::case_when( scale %in% c("Auditory Comprehension") ~ "Listening Ability", scale %in% c("Naming") ~ "Word Retrieval", TRUE ~ as.character(subdomain) ) )
Learning Efficiency
table4 <- table4 |> dplyr::mutate( subdomain = dplyr::case_when( scale == "Shape Learning Immediate Recognition" ~ "Learning Efficiency", scale == "Shape Learning Delayed Recognition" ~ "Delayed Recall", scale == "Shape Learning Percent Retention" ~ "Delayed Recall", scale == "Story Learning Immediate Recall" ~ "Learning Efficiency", scale == "Story Learning Delayed Recall" ~ "Delayed Recall", scale == "Story Learning Percent Retention" ~ "Delayed Recall", TRUE ~ as.character(subdomain) ) )
table5 <- table5 |> dplyr::mutate( subdomain = dplyr::case_when( scale == "Visual Discrimination" ~ "Perception", scale == "Design Construction" ~ "Construction", TRUE ~ as.character(subdomain) ) )
table6 <- table6 |> dplyr::mutate( subdomain = dplyr::case_when( scale == "Mazes" ~ "Executive Functioning", scale == "Word Generation" ~ "Executive Functioning", scale == "Word Generation Perseverations" ~ "Attention", TRUE ~ as.character(subdomain) ) )
Narrow subdomains
table1 <- table1 |> dplyr::mutate( narrow = dplyr::case_when( scale == "NAB Total Index" ~ "NAB Total Index", scale == "NAB Attention Index" ~ "NAB Attention Index", scale == "NAB Language Index" ~ "NAB Language Index", scale == "NAB Memory Index" ~ "NAB Memory Index", scale == "NAB Spatial Index" ~ "NAB Spatial Index", scale == "NAB Executive Functions Index" ~ "NAB Executive Functions Index", TRUE ~ as.character(narrow) ) )
table2 <- table2 |> dplyr::mutate( narrow = dplyr::case_when( scale %in% orientation ~ "Orientation", scale %in% dsf ~ "Attention Span", scale %in% dsb ~ "Working Memory Capacity", scale == "Numbers & Letters Part A Speed" ~ "Psychomotor Speed", scale == "Numbers & Letters Part A Errors" ~ "Response Monitoring", scale == "Numbers & Letters Part A Efficiency" ~ "Cognitive Efficiency", scale == "Numbers & Letters Part B Efficiency" ~ "Attentional Fluency", TRUE ~ as.character(narrow) ) )
table3 <- table3 |> dplyr::mutate( narrow = dplyr::case_when( scale == "Auditory Comprehension" ~ "Auditory Comprehension", scale == "Naming" ~ "Naming", TRUE ~ as.character(narrow) ) )
table4 <- table4 |> dplyr::mutate( narrow = dplyr::case_when( scale %in% shl ~ "Visual Memory", scale %in% stl ~ "Story Memory", TRUE ~ as.character(narrow) ) )
table5 <- table5 |> dplyr::mutate( narrow = dplyr::case_when( scale == "Visual Discrimination" ~ "Perception", scale == "Design Construction" ~ "Construction", TRUE ~ as.character(narrow) ) )
table6 <- table6 |> dplyr::mutate( narrow = dplyr::case_when( scale == "Mazes" ~ "Planning", scale == "Word Generation" ~ "Generativity", scale == "Word Generation Perseverations" ~ "Response Monitoring", TRUE ~ as.character(narrow) ) )
PASS
table1 <- table1 |> dplyr::mutate( pass = dplyr::case_when( scale == "NAB Attention Index" ~ "Attention", scale == "NAB Language Index" ~ "", scale == "NAB Memory Index" ~ "", scale == "NAB Spatial Index" ~ "Simultaneous", scale == "NAB Executive Functions Index" ~ "Planning", scale == "NAB Total Index" ~ "", TRUE ~ as.character(pass) ) )
table2 <- table2 |> dplyr::mutate( pass = dplyr::case_when( scale %in% orientation ~ "Attention", scale %in% dsf ~ "Sequential", scale %in% dsb ~ "Attention", scale %in% nlt ~ "Attention", scale %in% nle ~ "Attention", TRUE ~ as.character(pass) ) )
table3 <- table3 |> dplyr::mutate( pass = dplyr::case_when( scale == "Auditory Comprehension" ~ "Sequential", scale == "Naming" ~ "Knowledge", TRUE ~ as.character(pass) ) )
table4 <- table4 |> dplyr::mutate( pass = dplyr::case_when( scale %in% shl ~ "Simultaneous", scale %in% stl ~ "Sequential", TRUE ~ as.character(pass) ) )
table5 <- table5 |> dplyr::mutate( pass = dplyr::case_when( scale == "Visual Discrimination" ~ "Simultaneous", scale == "Design Construction" ~ "Simultaneous", TRUE ~ as.character(pass) ) )
table6 <- table6 |> dplyr::mutate( pass = dplyr::case_when( scale == "Mazes" ~ "Planning", scale == "Word Generation" ~ "Sequential", scale == "Word Generation Perseverations" ~ "Attention", TRUE ~ as.character(pass) ) )
Verbal vs Nonverbal
table1 <- table1 |> dplyr::mutate( verbal = dplyr::case_when( scale == "NAB Attention Index" ~ "", scale == "NAB Language Index" ~ "Verbal", scale == "NAB Memory Index" ~ "", scale == "NAB Spatial Index" ~ "Nonverbal", scale == "NAB Executive Functions Index" ~ "", scale == "NAB Total Index" ~ "", TRUE ~ as.character(verbal) ) )
table2 <- table2 |> dplyr::mutate( verbal = dplyr::case_when( scale %in% orientation ~ "Verbal", scale %in% dsf ~ "Verbal", scale %in% dsb ~ "Verbal", scale %in% nlt ~ "Nonverbal", scale %in% nle ~ "Nonverbal", TRUE ~ as.character(verbal) ) )
table4 <- table4 |> dplyr::mutate( verbal = dplyr::case_when( scale %in% shl ~ "Nonverbal", scale %in% stl ~ "Verbal", TRUE ~ as.character(verbal) ) )
table6 <- table6 |> dplyr::mutate( verbal = dplyr::case_when( scale == "Mazes" ~ "Nonverbal", scale == "Word Generation" ~ "Verbal", scale == "Word Generation Perseverations" ~ "Verbal", TRUE ~ as.character(verbal) ) )
Timed vs Untimed
table1 <- table1 |> dplyr::mutate( timed = dplyr::case_when( scale == "NAB Attention Index" ~ "", scale == "NAB Language Index" ~ "Untimed", scale == "NAB Memory Index" ~ "", scale == "NAB Spatial Index" ~ "", scale == "NAB Executive Functions Index" ~ "Timed", scale == "NAB Total Index" ~ "", TRUE ~ as.character(timed) ) ) table2 <- table2 |> dplyr::mutate( timed = dplyr::case_when( scale %in% orientation ~ "Untimed", scale %in% dsf ~ "Untimed", scale %in% dsb ~ "Untimed", scale %in% nlt ~ "Timed", scale %in% nle ~ "Timed", TRUE ~ as.character(timed) ) ) table3 <- table3 |> dplyr::mutate( timed = dplyr::case_when( scale == "Auditory Comprehension" ~ "Untimed", scale == "Naming" ~ "Untimed", TRUE ~ as.character(timed) ) ) table4 <- table4 |> dplyr::mutate( timed = dplyr::case_when( scale %in% shl ~ "Untimed", scale %in% stl ~ "Untimed", TRUE ~ as.character(timed) ) ) table5 <- table5 |> dplyr::mutate( timed = dplyr::case_when( scale == "Visual Discrimination" ~ "Untimed", scale == "Design Construction" ~ "Timed", TRUE ~ as.character(timed) ) ) table6 <- table6 |> dplyr::mutate( timed = dplyr::case_when( scale == "Mazes" ~ "Timed", scale == "Word Generation" ~ "Timed", scale == "Word Generation Perseverations" ~ "Timed", TRUE ~ as.character(timed) ) )
Score type
table2 <- table2 |> dplyr::mutate( score_type = dplyr::case_when( scale == "Orientation" ~ "percentile", scale == "Orientation to Self" ~ "base_rate", scale == "Orientation to Time" ~ "base_rate", scale == "Orientation to Place" ~ "base_rate", scale == "Orientation to Situation" ~ "base_rate", scale == "Digits Forward Longest Span" ~ "raw_score", scale == "Digits Backward Longest Span" ~ "raw_score", TRUE ~ as.character(score_type) ) )
table3 <- table3 |> dplyr::mutate( score_type = dplyr::case_when( scale == "Auditory Comprehension Colors" ~ "base_rate", scale == "Auditory Comprehension Shapes" ~ "base_rate", scale == "Auditory Comprehension Colors/Shapes/Numbers" ~ "base_rate", scale == "Naming Semantic Cuing" ~ "base_rate", scale == "Naming Phonemic Cuing" ~ "base_rate", TRUE ~ as.character(score_type) ) )
table4 <- table4 |> dplyr::mutate( score_type = dplyr::case_when( scale == "Shape Learning Percent Retention" ~ "percentile", scale == "Story Learning Percent Retention" ~ "percentile", TRUE ~ as.character(score_type) ) )
table6 <- table6 |> dplyr::mutate( score_type = dplyr::case_when( scale == "Word Generation Perseverations" ~ "percentile", TRUE ~ as.character(score_type) ) )
Scale descriptions
table1 <- table1 |> dplyr::mutate( description = dplyr::case_when( scale == "NAB Total Index" ~ "A comprehensive measure of neuropsychological functioning (independent of general intelligence) in the domains of attentional and executive functioning, language, spatial processing, and memory", scale == "NAB Attention Index" ~ "An overall screening measure of the examinee's attentional functioning", scale == "NAB Language Index" ~ "A composite screening measure of language comprehension and word-finding abilities", scale == "NAB Memory Index" ~ "A composite measure of the examinee's verbal and visual memory functioning", scale == "NAB Spatial Index" ~ "A composite screening measure of visuoperceptual skills, attention to detail, and visuoconstructional skills", scale == "NAB Executive Functions Index" ~ "A composite measure of executive skills involving planning, inhibition, speed/fluency, and generativity", TRUE ~ as.character(description) ) )
table2 <- table2 |> dplyr::mutate( description = dplyr::case_when( scale == "Orientation" ~ "Orientation to person, place, time, and situation", scale == "Digits Forward" ~ "Auditory attentional capacity, or how much information can be processed at once", scale == "Digits Forward Longest Span" ~ "Auditory attentional capacity", scale == "Digits Backward" ~ "A measure of both attentional capacity and working memory", scale == "Digits Backward Longest Span" ~ "Working memory for orally presented information", scale == "Numbers & Letters Part A Speed" ~ "Psychomotor speed", scale == "Numbers & Letters Part A Errors" ~ "A marker of reduced focus, or selective attention, distractibility, or reduced concentration, and diminished sustained attention", scale == "Numbers & Letters Part A Efficiency" ~ "An overall measure of efficiency in performing a selective attention letter cancellation task", scale == "Numbers & Letters Part B Efficiency" ~ "Performance on a complex measure of divided attention, information processing speed, and inhibition", TRUE ~ as.character(description) ) )
table3 <- table3 |> dplyr::mutate( description = dplyr::case_when( scale == "Auditory Comprehension" ~ "Auditory comprehension (i.e., the ability to receive, process, and execute oral instructions of increasing syntactic complexity)", scale == "Naming" ~ "Screening of word-finding ability and retrieval fluency on a confrontation naming task", TRUE ~ as.character(description) ) )
table4 <- table4 |> dplyr::mutate( description = dplyr::case_when( scale == "Shape Learning Immediate Recognition" ~ "Learning and recognition of visual material (abstract shapes)", scale == "Shape Learning Delayed Recognition" ~ "Recognition of the target visual material among nontarget distractors after a delay period", scale == "Shape Learning Percent Retention" ~ "Percentage of visual detail retained over time, scaled to how much was initially learned", scale == "Story Learning Immediate Recall" ~ "Performance on a more complex one-trial verbal learning and recall task (story learning)", scale == "Story Learning Delayed Recall" ~ "Delayed recall of the story details over time", scale == "Story Learning Percent Retention" ~ "The percentage of story detail retained over time, scaled to how much was initially learned", TRUE ~ as.character(description) ) )
table5 <- table5 |> dplyr::mutate( description = dplyr::case_when( scale == "Visual Discrimination" ~ "Perceptual processing, discrimination, and pattern matching of a series of abstract images requiring close attention to visual detail", scale == "Design Construction" ~ "Constructing and recreating abstract visual designs (tangrams) from a model using flat polygons (tans) to reproduce each stimulus", TRUE ~ as.character(description) ) )
table6 <- table6 |> dplyr::mutate( description = dplyr::case_when( scale == "Mazes" ~ "Planning and foresight, inhibition, and psychomotor speed examined through a series of maze-tracing tasks", scale == "Word Generation" ~ "Retrieval fluency, ideational fluency, and generativity", scale == "Word Generation Perseverations" ~ "Self-monitoring and perseverative tendencies", TRUE ~ as.character(description) ) )
Glue results
table1 <- table1 |> dplyr::mutate( result = dplyr::case_when( scale == "NAB Total Index" ~ glue::glue( "{description} fell in the {range} range.\n" ), scale == "NAB Attention Index" ~ glue::glue( "{description} was {range}.\n" ), scale == "NAB Language Index" ~ glue::glue( "{description} fell in the {range} classification range.\n" ), scale == "NAB Memory Index" ~ glue::glue( "{description} was {range}.\n" ), scale == "NAB Spatial Index" ~ glue::glue( "{description} fell in the {range} classification range.\n" ), scale == "NAB Executive Functions Index" ~ glue::glue( "{description} fell in the {range} range.\n" ), TRUE ~ as.character(result) ) )
table2 <- table2 |> dplyr::mutate( result = dplyr::case_when( scale == "Orientation" ~ glue::glue("{description} was intact.\n"), scale == "Digits Forward" ~ glue::glue("{description} fell within the {range}.\n"), scale == "Digits Forward Longest Span" ~ glue::glue("{description} was {range} ({raw_score} digits forward).\n"), scale == "Digits Backward" ~ glue::glue("{description} fell within the {range}.\n"), scale == "Digits Backward Longest Span" ~ glue::glue("{description} was {range} ({raw_score} digits backward).\n"), scale == "Numbers & Letters Part A Efficiency" ~ glue::glue("{description} was {range}.\n"), scale == "Numbers & Letters Part B Efficiency" ~ glue::glue("{description} was {range}.\n"), scale == "Numbers & Letters Part A Speed" ~ glue::glue("{description} fell within the {range}.\n"), scale == "Numbers & Letters Part A Errors" ~ glue::glue("{description} fell within the {range}.\n"), TRUE ~ as.character(result) ) )
table3 <- table3 |> dplyr::mutate( result = dplyr::case_when( scale == "Auditory Comprehension" ~ glue::glue("{description} was {range}.\n"), scale == "Naming" ~ glue::glue("{description} was {range}, with no obvious dysfluency in conversational/informal expression.\n"), TRUE ~ as.character(result) ) )
table4 <- table4 |> dplyr::mutate( result = dplyr::case_when( scale == "Shape Learning Immediate Recognition" ~ glue::glue("{description} was {range}.\n"), scale == "Shape Learning Delayed Recognition" ~ glue::glue("{description} was {range}.\n"), scale == "Shape Learning Percent Retention" ~ glue::glue("{description} fell in the {range} range.\n"), scale == "Story Learning Immediate Recall" ~ glue::glue("{description} was {range}.\n"), scale == "Story Learning Delayed Recall" ~ glue::glue("{description} was {range}.\n"), scale == "Story Learning Percent Retention" ~ glue::glue("{description} fell in the {range} range.\n"), TRUE ~ as.character(result) ) )
table5 <- table5 |> dplyr::mutate( result = dplyr::case_when( scale == "Visual Discrimination" ~ glue::glue("{description} was {range}.\n"), scale == "Design Construction" ~ glue::glue("{description} fell in the {range} range.\n"), TRUE ~ as.character(result) ) )
table6 <- table6 |> dplyr::mutate( result = dplyr::case_when( scale == "Mazes" ~ glue::glue("{description} fell in the {range} range.\n"), scale == "Word Generation" ~ glue::glue("{description} was {range}.\n"), scale == "Word Generation Perseverations" ~ glue::glue("{description} was {range}.\n"), TRUE ~ as.character(result) ) )
Finalize and save
Relocate variables
table1 <- table1 |> relocate(c(raw_score, score, percentile, range, ci_95), .before = test) table2 <- table2 |> relocate(c(raw_score, score, percentile, range, ci_95), .before = test) table3 <- table3 |> relocate(c(raw_score, score, percentile, range, ci_95), .before = test) table4 <- table4 |> relocate(c(raw_score, score, percentile, range, ci_95), .before = test) table5 <- table5 |> relocate(c(raw_score, score, percentile, range, ci_95), .before = test) table6 <- table6 |> relocate(c(raw_score, score, percentile, range, ci_95), .before = test)
Merge NAB tables
nabs <- dplyr::bind_rows( table1, table2, table3, table4, table5, table6 ) df <- nabs
Slice/Reorder table
# 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) # nabs <- # nabs |> # dplyr::slice( # index = (6), # att = c(1, 7, 12:19), # lan = c(2, 20, 24), # mem = c(3, 27:32), # spt = c(4, 33:34), # exe = c(5, 35:37) # )
Compute CI 95%
library(bwu) df <- nabs # Assuming df is your dataframe and calc_ci_95 is your function for (i in 1:nrow(df)) { ci_values <- calc_ci_95( ability_score = df$score[i], mean = 50, standard_deviation = 10, reliability = .85 ) df$true_score[i] <- paste0(ci_values["true_score"]) df$ci_lo[i] <- paste0(ci_values["lower_ci_95"]) df$ci_hi[i] <- paste0(ci_values["upper_ci_95"]) df$ci[i] <- paste0(ci_values["lower_ci_95"], " - ", ci_values["upper_ci_95"]) }
Write final csv table
readr::write_excel_csv(nabs, here::here("csv", "nabs.csv"), col_names = TRUE, na = "") if (any(is.na(nabs$percentile))) { stop("STOP!!! NA value found in percentile column. Please fill in missing values.") }
Write g2
table <- nabs test <- "g2" file_path <- here::here("csv", paste0(test, ".csv")) readr::write_excel_csv(nabs, here::here("csv", "nabs.csv"), append = TRUE, na = "")
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.