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

WRAT-5

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(bwu)
library(hablar)
library(here)
library(knitr)
library(readr)
library(rJava)
library(rmarkdown)
library(rmdformats)
library(shiny)
library(snakecase)
library(tabulapdf)
library(tibble)
library(tidyr)
library(dplyr)

Patient

patient <- params$patient

Test

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

Pages

pages <- params$pages

Extract Areas and Tables with tabulapdf

f <- file.path("/Users/joey/reports/Biggie/pdf/ADHD Young Adult Battery 2024-210a6756-acdd-488e-86e1-1446de4cb331.pdf")

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

# Loop over the list and write each matrix to a CSV file
test <- "wrat5"
for (i in seq_along(plucked_tables_wrat5)) {
  readr::write_(plucked_tables_wrat5[[i]], file = paste0(test, "_", i, ".csv"))
}

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

Upload/attach PDF

file <- file.path(params$file)

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

WRAT-5 Score Summary Table

Pluck and tidy tables

# Assuming you have plucked_tables_wrat5 and params already defined

# Convert to data.frame
df <- data.frame(plucked_tables_wrat5[[1]])

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

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

# Names for scales
df[, 1] <- (params$table)
keep <- params$keep
df <- dplyr::select(df, all_of(keep))

Mutate columns

domain <- "Academic Skills"
timed <- "Untimed"
test <- params$test
test_name <- params$test_name

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

Test score ranges

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

Subdomains

library(dplyr)
df <-
  df |>
  mutate(
    subdomain = case_when(
      scale == "Math Computation" ~ "Math",
      scale == "Spelling" ~ "Writing",
      scale == "Word Reading" ~ "Reading",
      scale == "Sentence Comprehension" ~ "Reading",
      scale == "Reading Composite" ~ "Reading",
      TRUE ~ as.character(subdomain)
    )
  )

Narrow subdomains

df <-
  df |>
  mutate(
    narrow = case_when(
      scale == "Math Computation" ~ "Mathematical Achievement",
      scale == "Spelling" ~ "Spelling Ability",
      scale == "Word Reading" ~ "Reading Decoding",
      scale == "Sentence Comprehension" ~ "Reading Comprehension",
      scale == "Reading Composite" ~ "Reading Index",
      TRUE ~ as.character(narrow)
    )
  )

PASS model

df <-
  df |>
  mutate(
    pass = case_when(
      scale == "Math Computation" ~ "Simultaneous",
      scale == "Spelling" ~ "Sequential",
      scale == "Word Reading" ~ "Sequential",
      scale == "Sentence Comprehension" ~ "Sequential",
      scale == "Reading Composite" ~ "Sequential",
      TRUE ~ as.character(pass)
    )
  )

Verbal vs Nonverbal

df <-
  df |>
  mutate(
    verbal = case_when(
      scale == "Math Computation" ~ "Nonverbal",
      scale == "Spelling" ~ "Verbal",
      scale == "Word Reading" ~ "Verbal",
      scale == "Sentence Comprehension" ~ "Verbal",
      scale == "Reading Composite" ~ "Verbal",
      TRUE ~ as.character(verbal)
    )
  )

Timed vs Untimed

df <-
  df |>
  mutate(
    timed = case_when(
      scale == "Math Computation" ~ "Timed",
      scale == "Spelling" ~ "Untimed",
      scale == "Word Reading" ~ "Untimed",
      scale == "Sentence Comprehension" ~ "Untimed",
      scale == "Reading Composite" ~ "Untimed",
      TRUE ~ as.character(timed)
    )
  )

Scale descriptions

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

df <-
  df |>
  dplyr::mutate(
    description = dplyr::case_when(
      scale == "Word Reading" ~ "An estimate of premorbid verbal ability level",
      scale == "Math Computation" ~ "Paper-and-pencil math calculation skills, ranging from basic operations with integers to geometry, algebra, and calculus problems",
      scale == "Spelling" ~ "Written spelling from dictations",
      scale == "Sentence Comprehension" ~ "Reading comprehension skills at the level of word, sentence, and passage",
      scale == "Reading Composite" ~ "A composite score of decoding and comprehension that balances word-level and text-level reading skills",
      is.na(scale) ~ NA_character_,
      TRUE ~ as.character(description)
    )
  )

Glue result

df <-
  df |>
  dplyr::mutate(
    result = dplyr::case_when(
      scale == "Math Computation" ~ glue::glue("{description} was {range} overall.\n"),
      scale == "Spelling" ~ 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 == "Word Reading" ~ glue::glue(
        "{description} was classified as {range} and ranked at the {percentile}th percentile.\n"
      ),
      scale == "Sentence Comprehension" ~ glue::glue(
        "{description} was classified as {range} and ranked at the {percentile}th percentile.\n"
      ),
      scale == "Reading Composite" ~ glue::glue(
        "{description} fell in the {range} range.\n"
      )
    )
  )

Compute CI 95%

library(bwu)

# 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 = 100,
    standard_deviation = 15,
    reliability = .95
  )

  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"])
}

scale_score <- df$score
scale_mean <- 100
scale_sd <- 15
scale_rel <- .95

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

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

Relocate variables

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

Finalize and save csv

Write out final csv

table <- df
test <- params$test
file_path <- here::here("csv", paste0(test, ".csv"))

readr::write_excel_csv(
  table,
  file_path,
  col_names = TRUE
)

rm(file_path)

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 <- df
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 = "none"
)

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