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

Setup

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(here)
library(knitr)
library(magrittr)
library(readr)
library(rmarkdown)
library(shiny)
library(miniUI)
library(vroom)
library(snakecase)
library(glue)
library(tibble)
library(tidyr)
library(dplyr)
library(purrr)
library(rlang)
library(bwu)

Patient

patient <- params$patient

Merge with lookup table

# make df
data <- data.frame()

# Read the lookup table
lookup_csv_neurocog <- vroom::vroom("data/neuropsych_lookup_table.csv")

# Add test column
data$test <- "bsra4"

# Merge the tables
data <- data |> dplyr::left_join(lookup_csv_neurocog, by = c("test", "scale"))

Make data frame

data <- data.frame(
  test = (params$test),
  # test_name = (params$test_name),
  # test_type = (params$test_type),
  scale = (params$scale),
  raw_score = as.numeric(params$raw_score),
  score = as.numeric(params$score),
  percentile = NA,
  true_score = NA,
  ci_95 = NA,
  ci_lo = NA,
  ci_hi = NA,
  range = NA,
  range_lower = NA,
  range_upper = NA,
  # score_type = (params$score_type),
  # domain = (params$domain),
  # subdomain = (params$subdomain),
  # narrow = (params$narrow),
  # pass = (params$pass),
  # verbal = (params$verbal),
  # timed = (params$timed),
  absort =
    paste0(
      tolower(params$test),
      "_", tolower(params$scale),
      "_", seq_len(1)
    ),
  # description = NA,
  result = NA
)

Scale descriptions

scale_description <- function(data, scale, description) {
  # Check if data is a data frame and contains a 'scale' column
  if (!is.data.frame(data) || !"scale" %in% names(data)) {
    stop("Input 'data' must be a data frame and contain a 'scale' column.")
  }

  # Check if 'description' is a character vector of the same length as 'data'
  if (!is.character(description) ||
    length(description) != nrow(data)) {
    stop("Input 'description' must be a character vector of the same length as 'data'.")
  }

  # Remove leading/trailing whitespace and convert to lowercase
  scale <- trimws(scale)

  # Add 'description' column to 'data'
  data <-
    data |>
    mutate(
      description = case_when(
        scale == "ROCFT Copy" ~ "Copying of a complex figure requiring visuospatial integration, planning and organization, and efficient encoding of visuospatial material",
        scale == "ROCFT Delayed Recall" ~ "Spontaneous, long-term delayed recall (20-25 min) recall and reproduction of a complex abstract figure",
        scale == "Judgment" ~ "Judgment and decision-making capabilities in situations that are likely to occur in everyday life, with answers assessed for appropriateness, safety, and practicality",
        scale == "Mazes" ~ "This subtest presents the individual with a series of seven paper-and-pencil mazes that increase in complexity and difficulty. The goal is to solve each maze as quickly as possible without making errors. This task measures planning, spatial problem-solving, visual-motor coordination, and the ability to modify a plan as needed. Timed performance also brings in an element of processing speed.",
        scale == "Categories" ~ "This task requires the individual to sort items into categories based on certain common features. The individual must form the conceptual rules for the categories and shift these rules as needed. This task evaluates executive skills such as concept formation, cognitive flexibility, and abstract reasoning.",
        scale == "Word Generation" ~ "This subtest assesses verbal fluency and generativity, critical components of executive functioning",
        scale == "Dots" ~ "This subtest assesses visual attention, working memory, and scanning ability. The participant is required to quickly locate and mark specific dot patterns on a page filled with distractor patterns, which tests their ability to focus, hold information in mind, and visually scan the page effectively.",
        scale == "Numbers & Letters Part A Efficiency" ~ "This subtest is a letter cancellation task. It assesses visual scanning, attention to detail, and processing speed. Participants are asked to cross out specific letters within a matrix of letters and numbers, requiring them to maintain focus and work efficiently.",
        scale == "Numbers & Letters Part B Efficiency" ~ "Although the name suggests 'letter counting', this task is more likely to assess sustained attention, discrimination, and visual scanning as participants are usually required to count specific numbers or letters in a grid or matrix.",
        scale == "Numbers & Letters Part C Efficiency" ~ "Part C of N&L was a series of numbers and asked to add them together in a serial manner. This measures working memory, mental flexibility, attention, and numerical processing skills.",
        scale == "Numbers & Letters Part D Efficiency" ~ "This task combines the 'letter cancellation' task from Part A and 'serial addition' task from Part C. It measures the ability to switch attention between two different tasks (task switching), sustaining attention, working memory, processing speed, and cognitive flexibility.",
        scale == "Driving Scenes" ~ "Visual attention, working memory, visual scanning, and selective attention within the context of a simulated driving scene",
        scale == "D-KEFS Color Naming" ~ "Rapid color naming",
        scale == "D-KEFS Word Reading" ~ "Rapid word reading",
        scale == "D-KEFS Inhibition" ~ "Inhibition/cognitive control",
        scale == "D-KEFS Switching" ~ "Set-shifting/cognitive flexibility",
        scale == "D-KEFS Inhibition Total Errors" ~ "Response monitoring during an inhibition task",
        scale == "D-KEFS Switching Total Errors" ~ "Response monitoring during a set-shifting task",
        scale == "Dominant Hand Time" ~ "Fine-motor dexterity (dominant hand)",
        scale == "Nondominant Hand Time" ~ "Nondominant hand dexterity",
        scale == "TOPF Standard Score" ~ "An estimate of premorbid verbal ability level",
        scale == "Unstructured Task" ~ "Strategic planning and organization aptitude to formulate an action in advance of performance or intended performance on which examinees need to plan ahead, avoid items that are strategically poor choices, and be cognizant of when a particular booklet offers diminishing returns",
        scale == "Letter Fluency" ~ "Letter/phonemic word fluency",
        scale == "Category Fluency" ~ "Categorical/semantic word fluency",
        scale == "Deviation Score" ~ "Abstract reasoning (hypothesis generation and concept formation)",
        scale == "Nonsense Word Decoding" ~ "Phonic decoding skills as assessed by reading aloud a list of pseudowords",
        scale == "Decoding Fluency" ~ "Phonic decoding fluency",
        scale == "Reading Comprehension" ~ "Reading comprehension skills at the level of the word, sentence, and passage",
        scale == "TMT, Part A" ~ "Visual search speed, scanning, speed of processing, and motor speed and coordination on Part A of the Trail Making Test",
        scale == "TMT, Part B" ~ "Performance on a measures that requires cognitive flexibility, divided attention, visual search, and the ability to shift cognitive sets between number and letter sequences",
        scale == "Symbol Span" ~ "Nonverbal working memory",
        scale == "Social Perception" ~ "General aspects of emotional intelligence and social cognition",
        scale == "Affect Naming" ~ "Identifying and naming variation in affective expression",
        scale == "Prosody-Face Matching" ~ "Linking prosody to a facial expression",
        scale == "Prosody-Pair Matching" ~ "Linking prosody to an interacting pair of people and explaining the intent of the speaker",
        scale == "Raven's 2 Index Score" ~ "Fluid reasoning",
        scale == "D-KEFS Color-Word Interference Test" ~ "Inhibition, cognitive flexibility, and word reading",
        scale == "D-KEFS Verbal Fluency Test" ~ "Verbal fluency",
        scale == "D-KEFS Trail Making Test" ~ "Set-shifting, planning, and problem-solving",
        scale == "D-KEFS Design Fluency Test" ~ "Executive functioning, generativity, and set-shifting",
        scale == "D-KEFS Card Sorting Test" ~ "Executive functioning, planning, and set-shifting",
        is.na(scale) ~ NA_character_,
        TRUE ~ as.character(description)
      )
    )

  # Return 'data'
  return(data)
}

data <- data
scale <- params$scale
data <- scale_description(
  data = data,
  scale = scale,
  description = "description"
)

Calculate z, percentile, range

compute_percentile_range <- function(data,
                                     score,
                                     score_type,
                                     percentile,
                                     range_type) {
  # Define score parameters based on score_type
  score_params <- switch(score_type,
    "z_score" = list(mean = 0, sd = 1),
    "scaled_score" = list(mean = 10, sd = 3),
    "t_score" = list(mean = 50, sd = 10),
    "standard_score" = list(mean = 100, sd = 15)
  )

  if (is.null(score_params)) {
    stop("Invalid score type")
  }

  # Calculate z, percentile, and range
  data <- data |>
    mutate(.z = (score - score_params$mean) / score_params$sd) |>
    mutate(percentile = round(stats::pnorm(.z) * 100, 1)) |>
    mutate(percentile = case_when(
      percentile < 1 ~ ceiling(percentile),
      percentile > 99 ~ floor(percentile),
      TRUE ~ round(percentile)
    )) |>
    mutate(
      range = case_when(
        percentile >= 98 ~ "Exceptionally High",
        percentile %in% 91:97 ~ "Above Average",
        percentile %in% 75:90 ~ "High Average",
        percentile %in% 25:74 ~ "Average",
        percentile %in% 9:24 ~ "Low Average",
        percentile %in% 2:8 ~ "Below Average",
        percentile < 2 ~ "Exceptionally Low",
        TRUE ~ as.character(range_type)
      )
    )

  return(data)
}

score <- as.numeric(params$score)
score_type <- params$score_type
data <- compute_percentile_range(
  data = data,
  score = score,
  score_type = score_type,
  percentile = "percentile",
  range_type = "range"
)

Glue results

glue_result <- function(data, scale, description, range, result) {
  # Simplify the dictionary
  phrase_dict <- c(
    "Dominant Hand Time" = "fell within the",
    "Nondominant Hand Time" = "was",
    "Unstructured Task" = "fell within the",
    "Letter Fluency" = "fell within the",
    "Category Fluency" = "fell within the",
    "D-KEFS Color Naming" = "was performed within the",
    "D-KEFS Word Reading" = "fell within the",
    "D-KEFS Inhibition" = "fell within the",
    "D-KEFS Switching" = "fell within the",
    "D-KEFS Inhibition Total Errors" = "was",
    "D-KEFS Switching Total Errors" = "was",
    "TMT, Part A" = "fell within the",
    "TMT, Part B" = "fell within the",
    "TOPF Standard Score" = "fell within the",
    "ROCFT Copy" = "fell within the",
    "ROCFT Delayed Recall" = "fell within the",
    "Judgment" = "fell within the",
    "Dots" = "fell within the",
    "Driving Scenes" = "fell within the",
    "Mazes" = "fell within the",
    "Word Generation" = "fell within the",
    "Numbers & Letters Part A Efficiency" = "fell within the",
    "Numbers & Letters Part B Efficiency" = "fell within the",
    "Numbers & Letters Part C Efficiency" = "fell within the",
    "Numbers & Letters Part D Efficiency" = "fell within the",
    "Affect Naming" = "fell within the",
    "Social Perception" = "was",
    "Prosody-Face Matching" = "was",
    "Prosody-Pair Matching" = "was",
    "Symbol Span" = "fell within the",
    "Nonsense Word Decoding" = "fell within the",
    "Decoding Fluency" = "fell within the",
    "Reading Comprehension" = "was",
    "Raven's 2 Index Score" = "fell within the",
    "Deviation Score" = "was",
    "School Readiness Composite (SRC)" = "fell within the"
  )

  # Check if scale is in phrase_dict
  if (!scale %in% names(phrase_dict)) {
    stop(glue::glue("Invalid scale: {scale}. Scale must be one of: {paste(names(phrase_dict), collapse = ', ')}"))
  }

  # Update the data using the dictionary
  data <-
    data |>
    dplyr::mutate(result = dplyr::case_when(
      scale %in% names(phrase_dict) ~ {
        phrase <- phrase_dict[[scale]]
        glue::glue("{description} {phrase} {range} range.\n")
      },
      TRUE ~ result
    ))

  return(data)
}

data <- data
scale <- data$scale
description <- data$description
range <- data$range
result <- data$result

data <- glue_result(
  data = data,
  scale = scale,
  description = description,
  range = range,
  result = result
)

Calculate CI 95%

scale_score <- as.numeric(params$score)
scale_mean <- as.numeric(params$mean)
scale_sd <- as.numeric(params$stdev)
scale_rel <- as.numeric(params$reliability)

ci_values <- bwu::calc_ci_95(
  ability_score = scale_score,
  mean = scale_mean,
  standard_deviation = scale_sd,
  reliability = scale_rel
)

data$true_score <- ci_values["true_score"]
data$ci_lo <- ci_values["lower_ci_95"]
data$ci_hi <- ci_values["upper_ci_95"]
data$ci_95 <- paste0(data$ci_lo, " - ", data$ci_hi)

data <- data |> dplyr::select(-.z)

Relocate variables

data <- data |> relocate(c(raw_score, score, ci_95, percentile, range, test, test_name, domain, subdomain, narrow, pass, verbal, timed, test_type, score_type, description, result, absort, true_score, ci_lo, ci_hi), .after = scale)

Write csv files

table <- data
test <- table$test
scale <- snakecase::to_snake_case(table$scale)
file_path <- here::here("pre_csv", paste0(test, "_", scale, ".csv"))
readr::write_excel_csv(
  table,
  file_path,
  append = FALSE,
  col_names = TRUE
)

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 <- data
test <- table$test
file_path <- here::here("csv", paste0(test, ".csv"))

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

table <- data
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"
)