From 1596442a001341285658642ac56ae00851455cab Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 20 Nov 2023 15:54:53 -0500
Subject: [PATCH 01/30] Updated to testthat 3 and added initial tntp_colors()
 tests

---
 DESCRIPTION                                |   3 +-
 notes/TNTP Rebrand Color Recommendations.R | 151 +++++++++++++++++++++
 tests/testthat.R                           |   8 ++
 tests/testthat/test-tntp_colors.R          |   3 +
 tests/testthat/test-tntp_style.R           |   3 +
 5 files changed, 167 insertions(+), 1 deletion(-)
 create mode 100644 tests/testthat/test-tntp_colors.R
 create mode 100644 tests/testthat/test-tntp_style.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 62f5d65..1d63cf8 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -39,7 +39,7 @@ Suggests:
     devtools,
     knitr,
     rmarkdown,
-    testthat,
+    testthat (>= 3.0.0),
     usethis,
     ggridges,
     ggalt,
@@ -49,3 +49,4 @@ VignetteBuilder:
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.2.3
+Config/testthat/edition: 3
diff --git a/notes/TNTP Rebrand Color Recommendations.R b/notes/TNTP Rebrand Color Recommendations.R
index d0ceea5..4e700f3 100644
--- a/notes/TNTP Rebrand Color Recommendations.R	
+++ b/notes/TNTP Rebrand Color Recommendations.R	
@@ -40,3 +40,154 @@ scales::show_col(c(dark_red, light_red, light_gray, light_green, dark_green), nc
 
 # 6pt likert
 scales::show_col(c(dark_red, medium_red, light_red, light_green, medium_green, dark_green), ncol = 6)
+
+
+
+# Example bar graph -------------------------------------------------------
+
+
+
+county_data <- tntpr::fake_county |>
+  filter(t_salary > 0)
+
+school_salary <- county_data |>
+  filter(t_salary != 0) |>
+  group_by(school_year, school_name) |>
+  summarize(avg_salary = mean(t_salary, na.rm = TRUE), .groups = "drop")
+
+# create list of school names so we can easily filter data set for the number of schools we want
+school_names <- unique(school_salary$school_name)
+
+# only plot two schools
+line_plot_schools <- school_salary |>
+  filter(school_name %in% school_names[1:2])
+
+bar_df <- school_salary |>
+  filter(
+    school_year == 2015,
+    school_name %in% school_names[1:5]
+  ) |>
+  # add line breaks for better plotting
+  mutate(school_name = str_wrap(school_name, 7))
+
+ggplot(bar_df, aes(x = school_name, y = avg_salary)) +
+  geom_bar(stat ="identity",
+           position="identity",
+           fill = if_else(bar_df$school_name == 'Acacia\nMiddle', tntp_colors('yellow'), tntp_colors('dark_green'))) +
+  scale_y_continuous(labels = scales::dollar, limits = c(0, 5000)) +
+  labs(
+    title="Acacia had higher average salaries in 2015",
+    subtitle = "Average teacher salaries in 2015 by school"
+  ) +
+  tntp_style(base_size = 16)
+
+bar_df$school_name
+
+
+# Likert ------------------------------------------------------------------
+
+# the y-axis will contain text of an entire survey question
+# we want to place line breaks in this text so plots look better
+axis_line_breaks <- 40
+
+# scales in HE questions, in order starting with the strongest
+agree_disagree_scale <- rev(c("Strongly Agree", "Agree", "Somewhat Agree", "Somewhat Disagree", "Disagree", "Strongly Disagree"))
+
+# put survey into long form and clean up question names
+teacher_survey_he <- teacher_survey |>
+  select(-timing) |>
+  pivot_longer(cols = everything(), names_to = 'question', values_to = 'response')
+
+# calculate percentage of responses to each high expectations question
+teacher_survey_he_perc <- teacher_survey_he |>
+  drop_na("response") |>
+  # calculate the number of responses for each response option
+  count(question, response, name = 'n_response') |>
+  # calculate the number of responses for each question
+  group_by(question) |>
+  mutate(n_question = sum(n_response)) |>
+  ungroup() |>
+  # calculate percentages
+  mutate(
+    # calculate percentages
+    percent = n_response / n_question,
+    # make a column that is text of the percent for plotting
+    percent_pretty = scales::percent(percent, accuracy = 1)
+  )
+
+# calculate percentage of strongly agree and agree
+teacher_survey_he_perc <- teacher_survey_he_perc |>
+  mutate(scale_strength = ifelse(response %in% !!agree_disagree_scale[c(5,6)], 'Strong response', 'Weak response')) |>
+  group_by(question, scale_strength) |>
+  mutate(strong_response_percent = sum(percent)) |>
+  ungroup() |>
+  mutate(
+    strong_response_percent = ifelse(response == 'Agree', strong_response_percent, NA),
+    # create line breaks for questions ,which will make plots look better
+    question = str_wrap(question, axis_line_breaks),
+    response = factor(response, levels = agree_disagree_scale)
+  )
+
+# colors to use
+div_scale_colors <- tntp_palette('likert_6', reverse = TRUE)
+
+# mapping of colors and responses for plot
+div_color_pal <- div_scale_colors |>
+  set_names(agree_disagree_scale)
+
+legend_order <- c(agree_disagree_scale[c(1,2,3)], agree_disagree_scale[c(6,5,4)])
+
+teacher_survey_div <- teacher_survey_he_perc |>
+  mutate(
+    perc_diverge = ifelse(str_detect(response, '[D|d]isagree'), percent * -1, percent),
+    response = factor(response, levels = legend_order)
+  )
+
+ggplot(teacher_survey_div, aes(x = perc_diverge, y = question, fill = response)) +
+  geom_col() +
+  scale_fill_manual(
+    values = div_color_pal, drop = FALSE,
+    breaks = agree_disagree_scale,
+    labels = agree_disagree_scale
+  ) +
+  geom_vline(aes(xintercept = 0), linetype = 1, linewidth = 1.2, alpha = .7) +
+  scale_x_continuous(limits = c(-1, 1), breaks = seq(-1, 1, .25), labels = function(x) scales::percent(abs(x))) +
+  labs(
+    title = "High Expectations Survey Responses",
+    x = NULL,
+    y = NULL
+  ) +
+  tntp_style(base_size = 16)
+
+
+# Multiple Lines ----------------------------------------------------------
+
+
+#Prepare data
+school_salary <- county_data |>
+  filter(t_salary != 0) |>
+  group_by(school_year, school_name) |>
+  summarize(avg_salary = mean(t_salary, na.rm = TRUE), .groups = "drop")
+
+# create list of school names so we can easily filter data set for the number of schools we want
+school_names <- unique(school_salary$school_name)
+
+# only plot two schools
+line_plot_schools <- school_salary |>
+  filter(school_name %in% school_names[1:4])
+
+line_colors <- tntp_colors('dark_green', 'medium_blue', 'dark_red', 'yellow')
+
+ggplot(line_plot_schools, aes(x = school_year, y = avg_salary, color = school_name)) +
+  geom_line(linewidth = 2) +
+  scale_y_continuous(labels = scales::dollar, limits = c(0, 5000)) +
+  scale_colour_manual(values = line_colors) +
+  labs(
+    title="Average Teacher Salaries",
+    subtitle = "Relatively constant from 2012 to 2015",
+    x = NULL,
+    y = 'Average teacher salary'
+  ) +
+  tntp_style() +
+  guides(color = guide_legend(nrow = 2))
+
diff --git a/tests/testthat.R b/tests/testthat.R
index 70155ec..8b51b8a 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,3 +1,11 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
 library(testthat)
 library(tntpr)
 
diff --git a/tests/testthat/test-tntp_colors.R b/tests/testthat/test-tntp_colors.R
new file mode 100644
index 0000000..8849056
--- /dev/null
+++ b/tests/testthat/test-tntp_colors.R
@@ -0,0 +1,3 @@
+test_that("multiplication works", {
+  expect_equal(2 * 2, 4)
+})
diff --git a/tests/testthat/test-tntp_style.R b/tests/testthat/test-tntp_style.R
new file mode 100644
index 0000000..8849056
--- /dev/null
+++ b/tests/testthat/test-tntp_style.R
@@ -0,0 +1,3 @@
+test_that("multiplication works", {
+  expect_equal(2 * 2, 4)
+})

From 79da363cb776699f5228103e20c1f00ff1802528 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 20 Nov 2023 16:34:01 -0500
Subject: [PATCH 02/30] Initial tntp_colors() tests

---
 tests/testthat/test-tntp_colors.R | 26 ++++++++++++++++++++++++--
 1 file changed, 24 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-tntp_colors.R b/tests/testthat/test-tntp_colors.R
index 8849056..f9ddb68 100644
--- a/tests/testthat/test-tntp_colors.R
+++ b/tests/testthat/test-tntp_colors.R
@@ -1,3 +1,25 @@
-test_that("multiplication works", {
-  expect_equal(2 * 2, 4)
+test_that("returns duplicated colors", {
+  expect_equal(tntp_colors("navy", "navy"), c(tntp_colors("navy"), tntp_colors("navy")))
+})
+
+test_that("returns colors in the correct order", {
+  expect_equal(tntp_colors("navy", "mint"), rev(tntp_colors("mint", "navy")))
+})
+
+test_that("returned vector is unnamed when run with arguments", {
+  expect_equal(tntp_colors("navy"), tntp_colors("navy") |> unname())
+  expect_equal(tntp_colors("navy", "mint"), tntp_colors("navy", "mint") |> unname())
+  expect_equal(tntp_palette("likert_4"), tntp_palette("likert_4") |> unname())
+})
+
+test_that("returns named vector when run empty", {
+  expect_equal(length(names(tntp_colors())), length(tntp_colors()))
+})
+
+test_that("returns no duplicates when run empty", {
+  expect_equal(unname(tntp_colors()), unique(tntp_colors()))
+})
+
+test_that("raises an error for unmatched colors", {
+  expect_error(tntp_colors("notacolor"), "No match for the following color name")
 })

From 243d04f3ebaa3e82e03b4c9ef77552cdeb9b242d Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 21 Nov 2023 09:35:55 -0500
Subject: [PATCH 03/30] tntp_style and tntp_colors tests

---
 tests/testthat/test-tntp_colors.R | 40 +++++++++++++++++++++++++------
 tests/testthat/test-tntp_style.R  | 35 +++++++++++++++++++++++++--
 2 files changed, 66 insertions(+), 9 deletions(-)

diff --git a/tests/testthat/test-tntp_colors.R b/tests/testthat/test-tntp_colors.R
index f9ddb68..c5645d2 100644
--- a/tests/testthat/test-tntp_colors.R
+++ b/tests/testthat/test-tntp_colors.R
@@ -1,25 +1,51 @@
-test_that("returns duplicated colors", {
+test_that("tntp_colors returns duplicated colors", {
   expect_equal(tntp_colors("navy", "navy"), c(tntp_colors("navy"), tntp_colors("navy")))
 })
 
-test_that("returns colors in the correct order", {
+test_that("tntp_colors returns colors in the correct order", {
   expect_equal(tntp_colors("navy", "mint"), rev(tntp_colors("mint", "navy")))
 })
 
-test_that("returned vector is unnamed when run with arguments", {
+test_that("tntp_colors and tntp_palette return an unnamed vector when run with arguments", {
   expect_equal(tntp_colors("navy"), tntp_colors("navy") |> unname())
   expect_equal(tntp_colors("navy", "mint"), tntp_colors("navy", "mint") |> unname())
   expect_equal(tntp_palette("likert_4"), tntp_palette("likert_4") |> unname())
 })
 
-test_that("returns named vector when run empty", {
+test_that("tntp_colors returns named vector when run empty", {
   expect_equal(length(names(tntp_colors())), length(tntp_colors()))
 })
 
-test_that("returns no duplicates when run empty", {
+test_that("tntp_colors returns no duplicates when run empty", {
   expect_equal(unname(tntp_colors()), unique(tntp_colors()))
 })
 
-test_that("raises an error for unmatched colors", {
-  expect_error(tntp_colors("notacolor"), "No match for the following color name")
+test_that("tntp_colors and tntp_palette raise an error for unmatched colors or palettes", {
+  expect_error(tntp_colors("notacolor"), "No match")
+  expect_error(show_tntp_colors("notacolor"), "No match")
+  expect_error(tntp_palette("notapalette"), "No TNTP palette found")
+  expect_error(show_tntp_palette("notapalette"), "No match")
+})
+
+test_that("choose_text_color works as expected for very light and dark colors", {
+  expect_equal(choose_text_color("#111111"), "white")
+  expect_equal(choose_text_color("#EEEEEE"), "black")
+})
+
+test_that("is_color recognizes common words and hex values", {
+  expect_equal(is_color("blue"), TRUE)
+  expect_equal(is_color("#FFFFFF"), TRUE)
+  expect_equal(is_color("notacolor"), FALSE)
+  expect_equal(is_color("#BAD10"), FALSE)
+})
+
+test_that("tntp_palette reverse works as expected", {
+  expect_equal(rev(tntp_palette()), tntp_palette(reverse = TRUE))
+})
+
+test_that("show_tntp_colors and show_tntp_palette parameter validation is working", {
+  expect_warning(show_tntp_colors(labels = "yes"), "Invalid")
+  expect_warning(show_tntp_colors(borders = "notacolor"), "Invalid")
+  expect_error(show_tntp_palette(pattern = FALSE), "No palettes")
+  expect_error(show_tntp_colors(pattern = FALSE), "No colors")
 })
diff --git a/tests/testthat/test-tntp_style.R b/tests/testthat/test-tntp_style.R
index 8849056..c431d6a 100644
--- a/tests/testthat/test-tntp_style.R
+++ b/tests/testthat/test-tntp_style.R
@@ -1,3 +1,34 @@
-test_that("multiplication works", {
-  expect_equal(2 * 2, 4)
+
+
+test_that("tntp_style parameter validation is working", {
+  expect_warning(tntp_style(base_size = 5), "not recommended")
+
+  expect_error(tntp_style(base_size = FALSE), "Invalid")
+})
+
+test_that("tntp_style font validation works", {
+  thm <- expect_warning(tntp_style(family = "notafamily"), "not registered")
+  expect_warning(tntp_style(header_family = "notafamily"), "not registered")
+
+  thm <- suppressWarnings(tntp_style(family = "notafamily"))
+  families <- unique(c(thm$axis.text$family,
+                       thm$legend.text$family,
+                       thm$plot.title$family,
+                       thm$plot.subtitle$family,
+                       thm$plot.caption$family,
+                       thm$strip.text$family))
+  expect_equal(families, "sans")
+
+  thm <- suppressWarnings(tntp_style(family = "serif"))
+  families <- unique(c(thm$axis.text$family,
+                       thm$legend.text$family,
+                       thm$plot.title$family,
+                       thm$plot.subtitle$family,
+                       thm$plot.caption$family,
+                       thm$strip.text$family))
+  expect_equal(families, "serif")
+})
+
+test_that("tntp_style is a theme", {
+  expect_s3_class(tntp_style(), "theme")
 })

From bfec2d6aeb5a837c04a8af7c467daccd535c2cce Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 21 Nov 2023 11:11:34 -0500
Subject: [PATCH 04/30] Factored out get_usable_family()

---
 R/tntp_style.R | 82 ++++++++++++++++++++++++--------------------------
 1 file changed, 39 insertions(+), 43 deletions(-)

diff --git a/R/tntp_style.R b/R/tntp_style.R
index 441babd..68b64b3 100644
--- a/R/tntp_style.R
+++ b/R/tntp_style.R
@@ -1,25 +1,41 @@
-# Changes from BBC Style:
-# - added options for title presence (legend, axis)
-# - added options for title / legend / caption alignment (and defaults)
-# - added options for grid lines
-# - added options for font
-# - added caption and legend/axis title styling (originally empty)
-# - adjusted facet-title styling
 
-# Unresolved:
-# - font management (2018)?
 
-# Questions:
-# - do we add all the parameters with proper defaults? OR use + theme()
-#   - Include "most used" parameters, don't include others.
-#   - Add base_size to scale all text sizes
-# - function name: keep as tntp_style() or match tntp_theme_xxxx() or theme_tntp()
+# Helper function. Checks if a given family value is available, and if not returns
+# the default font family ("sans" or user provided)
+get_usable_family <- function(family, silent = FALSE, default_family = "sans") {
 
-# Next steps - get to polished draft stage, then get feedback from folks.
-# - We start using / testing. Think through questions above
-# - Sam adds / drafts documentation
-# - Finalize next meeting, then roll out to data team.
+  # Get a platform-independent list of usable fonts
+  if (.Platform$OS.type == "windows") {
+    font_list <- names(grDevices::windowsFonts())
+  } else {
+    font_list <- names(grDevices::quartzFonts())
+  }
 
+  # Make sure the default family is available
+  if(!default_family %in% font_list) {
+    cli::cli_abort(c(
+      "x" = "Default family {.val {default_family}} is not registered in the font table.",
+      "i" = "Run {.code extrafont::loadfonts()} to register non-core fonts (needs to be done once each session)",
+      "i" = "If you've never imported your fonts before, run {.code extrafont::font_import()} first, then {.code extrafont::loadfonts()}"
+    ))
+  }
+
+  # Check to see if the provided family is available
+  if (!family %in% font_list) {
+    if(!silent) {
+      cli::cli_warn(c(
+        "x" = "Family {.val {family}} is not registered in the font table.",
+        "v" = "Using standard {.val sans} font instead",
+        "i" = "Run {.code extrafont::loadfonts()} to register non-core fonts (needs to be done once each session)",
+        "i" = "If you've never imported your fonts before, run {.code extrafont::font_import()} first, then {.code extrafont::loadfonts()}"
+      ))
+    }
+
+    default_family
+  } else {
+    family
+  }
+}
 
 
 #' Create TNTP themed [ggplot2] charts
@@ -186,33 +202,13 @@ tntp_style <- function(family = "Halyard Display",
   }
 
   # Check that specified font(s) are available for use
-  if (.Platform$OS.type == "windows") {
-    font_list <- names(grDevices::windowsFonts())
+  if(header_family != family) {
+    family        <- get_usable_family(family)
+    header_family <- get_usable_family(header_family)
   } else {
-    font_list <- names(grDevices::quartzFonts())
-  }
-  if (!header_family %in% font_list && header_family != family) {
-    cli::cli_warn(c(
-      "x" = "Family {.val {header_family}} is not registered in the font table.",
-      "v" = "Using standard {.val sans} font instead",
-      "i" = "Run {.code extrafont::loadfonts()} to register non-core fonts (needs to be done once each session)",
-      "i" = "If you've never imported your fonts before, run {.code extrafont::font_import()} first, then {.code extrafont::loadfonts()}"
-    ))
-    header_family <- "sans"
+    family        <- get_usable_family(family)
+    header_family <- family
   }
-  if (!family %in% font_list) {
-    cli::cli_warn(c(
-      "x" = "Family {.val {family}} is not registered in the font table.",
-      "v" = "Using standard {.val sans} font instead",
-      "i" = "Run {.code extrafont::loadfonts()} to register non-core fonts (needs to be done once each session)",
-      "i" = "If you've never imported your fonts before, run {.code extrafont::font_import()} first, then {.code extrafont::loadfonts()}"
-    ))
-
-    if(header_family == family) header_family <- "sans"
-    family <- "sans"
-
-  }
-
 
   # Convert text position to a numeric value to supply
   title_h_just <- switch(title_align,

From 42c3fd10e79cee2eccda63924f1cd3c719a83f19 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 21 Nov 2023 11:12:35 -0500
Subject: [PATCH 05/30] Updated to tntp_colors()/tntp_style() Fixed example
 issues Updated documentation

---
 DESCRIPTION             |   2 -
 R/bar_chart_counts.R    | 190 ++++++++++++++++------------------------
 man/bar_chart_counts.Rd |  58 ++++++------
 3 files changed, 108 insertions(+), 142 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 1d63cf8..6b31694 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -23,10 +23,8 @@ Imports:
     grid,
     janitor,
     labelled,
-    lazyeval,
     lubridate (>= 1.7.4),
     magrittr (>= 1.5),
-    plyr,
     purrr (>= 0.3.3),
     readr,
     rlang,
diff --git a/R/bar_chart_counts.R b/R/bar_chart_counts.R
index bc5898e..71c6054 100644
--- a/R/bar_chart_counts.R
+++ b/R/bar_chart_counts.R
@@ -7,7 +7,7 @@
 #' @param var unquoted column name for variable to count
 #' @param group_var (optional) unquoted column name for group variable.  If this is specified, you get a 2-variable clustered bar chart.  If left blank, a single variable bar chart.
 #' @param labels should labels show the count (\code{"n"}) or the percentage (\code{"pct"})?
-#' @param var_color color for non-grouped charts; set to medium_blue by default. For both this and \code{group_colors}, strings will be tried in \code{palette_tntp} automatically.  So \code{c("orange", "dark_blue")} will get you the official TNTP colors, while \code{c("orange", "blue")} will get you TNTP orange but generic blue.
+#' @param var_color color for non-grouped charts; set to TNTP green by default. For both this and \code{group_colors}, strings will be tried in \code{tntp_colors} automatically.  So \code{c("red", "green")} will get you the official TNTP colors, while \code{c("red", "brown")} will get you base R red and blue.
 #' @param group_colors character vector of group colors, if a specific palette is desired
 #' @param title main chart title
 #' @param var_label label for x-axis
@@ -17,40 +17,45 @@
 #' @export
 #' @examples
 #'
-#' # all examples not run b/c of Travis CI failures
-#' # failure due to not having Segoe UI font imported
-#' # library(dplyr) # for %>% pipe
-#' # # An N bar chart by default
-#' # mtcars %>%
-#' #   bar_chart_counts(var     = cyl,
-#' #                    title   = "Number of mtcars by cylinder")
-#' #
-#' # # Use a grouping variable
-#' # mtcars %>%
-#' #   bar_chart_counts(var          = cyl,
-#' #                    group_var    = vs,
-#' #                    labels        = "pct",
-#' #                    title        = "Percentage of V vs. Straight engines by # of cylinders")
-#' #
-#' # # Change default color
-#' # mtcars %>%
-#' #   bar_chart_counts(var       = cyl,
-#' #                    var_color = "orange",
-#' #                    title     = "Number of mtcars by cylinder")
-#' # # Specify color by group
-#' #   bar_chart_counts(mtcars, am, cyl,
-#' #                    group_colors = c("orange", "green", "dark_blue"),
-#' #                    labels = "pct")
+#' # An N bar chart by default
+#' # All examples use font = "sans" to avoid triggering font warnings
+#' mtcars |>
+#'   bar_chart_counts(var   = cyl,
+#'                    title = "Number of mtcars by cylinder",
+#'                    font  = "sans")
+#'
+#' # Use a grouping variable
+#' mtcars |>
+#'   bar_chart_counts(var       = cyl,
+#'                    group_var = vs,
+#'                    labels    = "pct",
+#'                    title     = "Percentage of V vs. Straight engines by # of cylinders",
+#'                    font  = "sans")
+#'
+#' # Change default color
+#' mtcars |>
+#'   bar_chart_counts(var       = cyl,
+#'                    var_color = "orange",
+#'                    title     = "Number of mtcars by cylinder",
+#'                    font  = "sans")
+#'
+#' # Specify color by group
+#' mtcars |>
+#'   bar_chart_counts(am, cyl,
+#'                    group_colors = c("orange", "green", "navy"),
+#'                    labels = "pct",
+#'                    font  = "sans")
+
 bar_chart_counts <- function(df,
                              var,
                              group_var,
                              labels = "n",
-                             var_color = "medium_blue",
+                             var_color = "green",
                              group_colors,
                              title = NULL,
                              var_label,
                              digits = 1,
-                             font = "Segoe UI",
+                             font = "Halyard Display",
                              font_size = 12) {
   # QC: Throw an error if object supplied to df is not a data.frame -----------
   if (!is.data.frame(df)) {
@@ -62,33 +67,33 @@ bar_chart_counts <- function(df,
     stop("You must supply a column name to the var argument")
   }
 
+  # Ensure the specified font is valid
+  font <- get_usable_family(font)
 
   # Create a plot_data object -------------------------------------------------
   # plot_data should contain user specified column and its factor equivalent
 
   # Check if a grouping variable was specified
   if (missing(group_var)) {
-    plot_data <- df %>%
-      dplyr::select_(.dots = list(vec = lazyeval::lazy(var))) %>%
-      dplyr::mutate(vec.factor = as.factor(vec)) %>%
-      dplyr::group_by(vec.factor) %>%
-      dplyr::tally() %>%
+    plot_data <- df |>
+      dplyr::select(vec = {{var}}) |>
+      dplyr::mutate(vec.factor = as.factor(vec)) |>
+      dplyr::group_by(vec.factor) |>
+      dplyr::tally() |>
       dplyr::mutate(perc = n / sum(n))
   } else {
-    plot_data <- df %>%
-      dplyr::select_(.dots = list(
-        vec = lazyeval::lazy(var),
-        group.vec = lazyeval::lazy(group_var)
-      )) %>%
+    plot_data <- df |>
+      dplyr::select(vec = {{var}},
+                    group.vec = {{group_var}}) |>
       dplyr::mutate(
         vec.factor = as.factor(vec),
         group.factor = as.factor(group.vec)
-      ) %>%
-      dplyr::group_by(vec.factor, group.factor) %>%
-      dplyr::tally() %>%
-      dplyr::group_by(vec.factor) %>%
-      dplyr::mutate(perc = n / sum(n)) %>%
-      dplyr::ungroup() %>%
+      ) |>
+      dplyr::group_by(vec.factor, group.factor) |>
+      dplyr::tally() |>
+      dplyr::group_by(vec.factor) |>
+      dplyr::mutate(perc = n / sum(n)) |>
+      dplyr::ungroup() |>
       tidyr::complete(vec.factor, group.factor, fill = list(n = NA, perc = NA))
   }
 
@@ -102,33 +107,31 @@ bar_chart_counts <- function(df,
 
       # Select a color for each level of the factor-ed grouping variable. Must
       # be less than or equal to 11 (because we only have 11 TNTP colors)
-      num_groups <- plot_data$group.factor %>%
-        levels() %>%
+      num_groups <- plot_data$group.factor |>
+        levels() |>
         length()
 
-      if (num_groups > 11) {
-        stop("The maximum number of levels allowed in group_var is 11")
+      if (num_groups > 7) {
+        stop("The maximum number of levels in group_var with the default color palette is 7")
       }
 
-      tntp_col_pal <- palette_tntp(
-        "dark_blue", "medium_blue", "light_blue",
-        "orange", "gold", "green", "dark_grey",
-        "medium_grey", "light_grey", "white",
-        "black"
-      )[1:num_groups]
+      # Use the new colorful palette by default
+      tntp_col_pal <- tntp_palette('colorful')
+
     } else {
       # QC: Throw an error if the number of levels in supplied group_var does
       # not equal the number of group_colors
-      num_group_var <- plot_data$group.factor %>%
-        levels() %>%
+      num_group_var <- plot_data$group.factor |>
+        levels() |>
         length()
-      num_group_col <- group_colors %>% length()
+      num_group_col <- group_colors |> length()
 
       if (num_group_var != num_group_col) {
         stop("The number of group_colors must equal
                                  the number of levels supplied to group_var")
       }
-      # Switch color name strings to the HEX codes
+
+      # Match provided color names to either TNTP or base R colors
       tntp_col_pal <- swap_colors(group_colors)
     }
   }
@@ -200,7 +203,7 @@ bar_chart_counts <- function(df,
 
   # Polish the plot to presentation standards ---------------------------------
 
-  # so labels don't get cropped, set the y scale 5% higher than the highest bar
+  # so labels don't get cropped, set the y scale 10% higher than the highest bar
   max_height <- dplyr::if_else(labels == "pct",
     max(plot_data$perc, na.rm = TRUE) * 1.1,
     max(plot_data$n, na.rm = TRUE) * 1.1
@@ -211,64 +214,25 @@ bar_chart_counts <- function(df,
       limits = c(0, max_height)
     ) +
     ggplot2::labs(title = title, x = var_label) +
-    ggplot2::theme(
-      axis.line.y = ggplot2::element_blank(),
-      axis.line.x = ggplot2::element_line(
-        color = "grey70",
-        size = 0.20
-      ),
-      axis.text.y = ggplot2::element_blank(),
-      axis.text.x = ggplot2::element_text(
-        family = font,
-        size = font_size
-      ),
-      axis.ticks = ggplot2::element_blank(),
-      axis.title.x = ggplot2::element_text(
-        family = font,
-        size = font_size
-      ),
-      axis.title.y = ggplot2::element_blank(),
-      legend.key = ggplot2::element_blank(),
-      legend.position = "bottom",
-      legend.text = ggplot2::element_text(
-        family = font,
-        size = font_size
-      ),
-      legend.title = ggplot2::element_blank(),
-      panel.background = ggplot2::element_blank(),
-      panel.grid.major = ggplot2::element_blank(),
-      panel.grid.minor = ggplot2::element_blank(),
-      plot.title = ggplot2::element_text(
-        family = font,
-        face = "bold",
-        size = font_size
-      )
-    )
+    tntp_style(family = font) +
+    ggplot2::theme(axis.text.y = ggplot2::element_blank())
   nbc
 }
 
 # function to swap in custom TNTP colors
-
 swap_colors <- function(x) {
-  plyr::mapvalues(x,
-    from = c(
-      "dark_blue", "medium_blue",
-      "light_blue", "green",
-      "orange", "gold",
-      "dark_grey", "dark_gray",
-      "medium_grey", "medium_gray",
-      "light_grey", "light_gray",
-      "white", "black"
-    ),
-    to = c(
-      "#034772", "#2888BC",
-      "#73B7CE", "#699D46",
-      "#EA8936", "#F9C347",
-      "#58595B", "#58595B",
-      "#7D7E81", "#7D7E81",
-      "#C1C2C4", "#C1C2C4",
-      "#FFFFFF", "#000000"
-    ),
-    warn_missing = FALSE
-  )
+  # Attempt to match to TNTP colors first
+  tryCatch(tntp_colors(x),
+           error = \(e) {
+             # Attempt to test all values as R colors next
+             if(is_color(x)) {
+               cli::cli_inform(c("i" = "Unable to map some colors from {.val {x}} to TNTP colors. Using base R colors instead."))
+               x
+             } else {
+               cli::cli_warn(c("!" = "Unable to map some colors from {.val {x}} to either TNTP colors or base R colors.",
+                               "i" = "Using values from {.code tntp_palette('colorful')} instead."))
+               tntp_palette('colorful')
+             }
+
+           })
 }
diff --git a/man/bar_chart_counts.Rd b/man/bar_chart_counts.Rd
index a7f4959..6cfdf5e 100644
--- a/man/bar_chart_counts.Rd
+++ b/man/bar_chart_counts.Rd
@@ -9,12 +9,12 @@ bar_chart_counts(
   var,
   group_var,
   labels = "n",
-  var_color = "medium_blue",
+  var_color = "green",
   group_colors,
   title = NULL,
   var_label,
   digits = 1,
-  font = "Segoe UI",
+  font = "Halyard Display",
   font_size = 12
 )
 }
@@ -27,7 +27,7 @@ bar_chart_counts(
 
 \item{labels}{should labels show the count (\code{"n"}) or the percentage (\code{"pct"})?}
 
-\item{var_color}{color for non-grouped charts; set to medium_blue by default. For both this and \code{group_colors}, strings will be tried in \code{palette_tntp} automatically.  So \code{c("orange", "dark_blue")} will get you the official TNTP colors, while \code{c("orange", "blue")} will get you TNTP orange but generic blue.}
+\item{var_color}{color for non-grouped charts; set to TNTP green by default. For both this and \code{group_colors}, strings will be tried in \code{tntp_colors} automatically.  So \code{c("red", "green")} will get you the official TNTP colors, while \code{c("red", "brown")} will get you base R red and blue.}
 
 \item{group_colors}{character vector of group colors, if a specific palette is desired}
 
@@ -47,28 +47,32 @@ an N bar chart (uses position dodge from ggplot2).
 }
 \examples{
 
-# all examples not run b/c of Travis CI failures
-# failure due to not having Segoe UI font imported
-# library(dplyr) # for \%>\% pipe
-# # An N bar chart by default
-# mtcars \%>\%
-#   bar_chart_counts(var     = cyl,
-#                    title   = "Number of mtcars by cylinder")
-#
-# # Use a grouping variable
-# mtcars \%>\%
-#   bar_chart_counts(var          = cyl,
-#                    group_var    = vs,
-#                    labels        = "pct",
-#                    title        = "Percentage of V vs. Straight engines by # of cylinders")
-#
-# # Change default color
-# mtcars \%>\%
-#   bar_chart_counts(var       = cyl,
-#                    var_color = "orange",
-#                    title     = "Number of mtcars by cylinder")
-# # Specify color by group
-#   bar_chart_counts(mtcars, am, cyl,
-#                    group_colors = c("orange", "green", "dark_blue"),
-#                    labels = "pct")
+# An N bar chart by default
+# All examples use font = "sans" to avoid triggering font warnings
+mtcars |>
+  bar_chart_counts(var   = cyl,
+                   title = "Number of mtcars by cylinder",
+                   font  = "sans")
+
+# Use a grouping variable
+mtcars |>
+  bar_chart_counts(var       = cyl,
+                   group_var = vs,
+                   labels    = "pct",
+                   title     = "Percentage of V vs. Straight engines by # of cylinders",
+                   font  = "sans")
+
+# Change default color
+mtcars |>
+  bar_chart_counts(var       = cyl,
+                   var_color = "orange",
+                   title     = "Number of mtcars by cylinder",
+                   font  = "sans")
+
+# Specify color by group
+mtcars |>
+  bar_chart_counts(am, cyl,
+                   group_colors = c("orange", "green", "navy"),
+                   labels = "pct",
+                   font  = "sans")
 }

From 1f9c70a7ffbf7fc8e9005010e545fab1ee2a4966 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 21 Nov 2023 12:11:33 -0500
Subject: [PATCH 06/30] Provided defaults of NULL for optional parameters

---
 R/bar_chart_counts.R    | 21 ++++++++++++---------
 man/bar_chart_counts.Rd |  8 ++++----
 2 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/R/bar_chart_counts.R b/R/bar_chart_counts.R
index 71c6054..bfe9470 100644
--- a/R/bar_chart_counts.R
+++ b/R/bar_chart_counts.R
@@ -29,7 +29,7 @@
 #'   bar_chart_counts(var       = cyl,
 #'                    group_var = vs,
 #'                    labels    = "pct",
-#'                    title     = "Percentage of V vs. Straight engines by # of cylinders",
+#'                    title     = "% of V vs. Straight engines by # of cylinders",
 #'                    font  = "sans")
 #'
 #' # Change default color
@@ -48,12 +48,12 @@
 
 bar_chart_counts <- function(df,
                              var,
-                             group_var,
+                             group_var = NULL,
                              labels = "n",
                              var_color = "green",
-                             group_colors,
+                             group_colors = NULL,
                              title = NULL,
-                             var_label,
+                             var_label = NULL,
                              digits = 1,
                              font = "Halyard Display",
                              font_size = 12) {
@@ -70,11 +70,14 @@ bar_chart_counts <- function(df,
   # Ensure the specified font is valid
   font <- get_usable_family(font)
 
+  # Store whether there is a grouping variable
+  grouped <- !rlang::quo_is_null(rlang::enquo(group_var))
+
   # Create a plot_data object -------------------------------------------------
   # plot_data should contain user specified column and its factor equivalent
 
   # Check if a grouping variable was specified
-  if (missing(group_var)) {
+  if (!grouped) {
     plot_data <- df |>
       dplyr::select(vec = {{var}}) |>
       dplyr::mutate(vec.factor = as.factor(vec)) |>
@@ -100,8 +103,8 @@ bar_chart_counts <- function(df,
   # Create a color palette ----------------------------------------------------
 
   # Check if group_var is supplied
-  if (!missing(group_var)) {
-    if (missing(group_colors)) {
+  if (grouped) {
+    if (is.null(group_colors)) {
       # QC: If group_var is supplied, but no colors, create a color palette
       #     while also making sure there are enough colors for each group
 
@@ -137,14 +140,14 @@ bar_chart_counts <- function(df,
   }
 
   # Check whether user specified an x axis label ------------------------------
-  if (missing(var_label)) {
+  if (is.null(var_label)) {
     var_label <- deparse(substitute(var))
   }
 
   # Build the N bar chart -----------------------------------------------------
   # Condition on presence of group_var
 
-  if (missing(group_var)) {
+  if (!grouped) {
     if (labels == "pct") {
       nbc <- ggplot2::ggplot(data = plot_data, ggplot2::aes(x = vec.factor, y = perc)) +
         ggplot2::geom_bar(fill = swap_colors(var_color), stat = "identity") +
diff --git a/man/bar_chart_counts.Rd b/man/bar_chart_counts.Rd
index 6cfdf5e..34d06ce 100644
--- a/man/bar_chart_counts.Rd
+++ b/man/bar_chart_counts.Rd
@@ -7,12 +7,12 @@
 bar_chart_counts(
   df,
   var,
-  group_var,
+  group_var = NULL,
   labels = "n",
   var_color = "green",
-  group_colors,
+  group_colors = NULL,
   title = NULL,
-  var_label,
+  var_label = NULL,
   digits = 1,
   font = "Halyard Display",
   font_size = 12
@@ -59,7 +59,7 @@ mtcars |>
   bar_chart_counts(var       = cyl,
                    group_var = vs,
                    labels    = "pct",
-                   title     = "Percentage of V vs. Straight engines by # of cylinders",
+                   title     = "\% of V vs. Straight engines by # of cylinders",
                    font  = "sans")
 
 # Change default color

From a5cc2131ea8d6bfcba4a630f3b5235eecc22c858 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 21 Nov 2023 12:12:00 -0500
Subject: [PATCH 07/30] get_usable_family() and bar_chart_counts() tests

---
 tests/testthat/test-bar_chart_counts.R | 30 ++++++++++++++++++++++++++
 tests/testthat/test-tntp_style.R       | 29 ++++++++++++++-----------
 2 files changed, 47 insertions(+), 12 deletions(-)
 create mode 100644 tests/testthat/test-bar_chart_counts.R

diff --git a/tests/testthat/test-bar_chart_counts.R b/tests/testthat/test-bar_chart_counts.R
new file mode 100644
index 0000000..f25ed2f
--- /dev/null
+++ b/tests/testthat/test-bar_chart_counts.R
@@ -0,0 +1,30 @@
+test_that("bar_chart_counts accurately summarizes data", {
+
+  df <- tibble::tibble(col = c("c", "d", "e", "e", "d", "c", "c"),
+                       grp = c("a", "b", "a", "b", "a", "a", "a"),
+                       val = c(1, 2, 3, 4, 5, 6, 7))
+
+  plt <- bar_chart_counts(df, col)
+  exp <- tibble::tibble(
+    vec.factor = factor(c("c", "d", "e"), levels = c("c", "d", "e")),
+    n = c(3, 2, 2),
+    perc = c(3/7, 2/7, 2/7))
+  expect_equal(plt$data, exp)
+
+})
+
+test_that("bar_chart_counts grouping variable works", {
+
+  df <- tibble::tibble(col = c("c", "d", "e", "e", "d", "c", "c"),
+                       grp = c("a", "b", "a", "b", "a", "a", "a"),
+                       val = c(1, 2, 3, 4, 5, 6, 7))
+
+  plt <- bar_chart_counts(df, col, grp)
+  exp <- tibble::tibble(
+    vec.factor = factor(rep(c("c", "d", "e"), each = 2), levels = c("c", "d", "e")),
+    group.factor = factor(rep(c("a", "b"), 3), levels = c("a", "b")),
+    n = c(3, NA, 1, 1, 1, 1),
+    perc = c(3/3, NA, 1/2, 1/2, 1/2, 1/2))
+  expect_equal(plt$data, exp)
+
+})
diff --git a/tests/testthat/test-tntp_style.R b/tests/testthat/test-tntp_style.R
index c431d6a..ba94c2d 100644
--- a/tests/testthat/test-tntp_style.R
+++ b/tests/testthat/test-tntp_style.R
@@ -1,5 +1,22 @@
 
 
+test_that("get_usable_family returns a usable family", {
+  expect_equal(get_usable_family('serif'), 'serif')
+  expect_equal(suppressWarnings(get_usable_family('notafamily')), 'sans')
+})
+
+test_that("get_usable_family errors and warnings work as expected", {
+  expect_error(get_usable_family('notafamily', default_family = 'alsonotafamily'), "not registered")
+  expect_error(get_usable_family('notafamily', default_family = 'alsonotafamily', silent = TRUE), "not registered")
+  expect_warning(get_usable_family('notafamily'), "not registered")
+  expect_no_warning(get_usable_family('notafamily', silent = TRUE))
+})
+
+test_that("get_usable_family default_family works as expected", {
+  expect_equal(suppressWarnings(get_usable_family('notafamily', default_family = 'serif')), 'serif')
+})
+
+
 test_that("tntp_style parameter validation is working", {
   expect_warning(tntp_style(base_size = 5), "not recommended")
 
@@ -7,18 +24,6 @@ test_that("tntp_style parameter validation is working", {
 })
 
 test_that("tntp_style font validation works", {
-  thm <- expect_warning(tntp_style(family = "notafamily"), "not registered")
-  expect_warning(tntp_style(header_family = "notafamily"), "not registered")
-
-  thm <- suppressWarnings(tntp_style(family = "notafamily"))
-  families <- unique(c(thm$axis.text$family,
-                       thm$legend.text$family,
-                       thm$plot.title$family,
-                       thm$plot.subtitle$family,
-                       thm$plot.caption$family,
-                       thm$strip.text$family))
-  expect_equal(families, "sans")
-
   thm <- suppressWarnings(tntp_style(family = "serif"))
   families <- unique(c(thm$axis.text$family,
                        thm$legend.text$family,

From 221aa30bea072709abaaa89daece11aa133af109 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 21 Nov 2023 12:22:54 -0500
Subject: [PATCH 08/30] swqp_colors() tests

---
 tests/testthat/test-bar_chart_counts.R | 14 ++++++++++++++
 1 file changed, 14 insertions(+)

diff --git a/tests/testthat/test-bar_chart_counts.R b/tests/testthat/test-bar_chart_counts.R
index f25ed2f..45cc177 100644
--- a/tests/testthat/test-bar_chart_counts.R
+++ b/tests/testthat/test-bar_chart_counts.R
@@ -28,3 +28,17 @@ test_that("bar_chart_counts grouping variable works", {
   expect_equal(plt$data, exp)
 
 })
+
+test_that("swap_colors provides TNTP colors if possible", {
+  expect_equal(swap_colors(c('navy', 'mint')), tntp_colors('navy', 'mint'))
+})
+
+test_that("swap_colors uses R colors if TNTP colors aren't found", {
+  expect_message(swap_colors(c("brown", "orange")), "Unable to map some colors.* to TNTP colors")
+  expect_equal(suppressMessages(swap_colors(c("brown", "orange"))), c("brown", "orange"))
+})
+
+test_that("swqp_colors raises a warning and uses the colorful TNTP palette if no mapping is found", {
+  expect_warning(swap_colors(c("blue", "notacolor")), "Unable to map some colors")
+  expect_equal(suppressWarnings(swap_colors(c("blue", "notacolor"))), tntp_palette('colorful'))
+})

From fd777cfbd3b206c18d137b8db6cd641157b2e076 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 21 Nov 2023 13:33:53 -0500
Subject: [PATCH 09/30] Added a default cut-off date of 7/1

Added parsing support for strings
---
 R/date_to_sy.R    | 43 ++++++++++++++++++++++++++++++++++++++-----
 man/date_to_sy.Rd |  6 +++---
 2 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/R/date_to_sy.R b/R/date_to_sy.R
index 198dab4..4f9f411 100644
--- a/R/date_to_sy.R
+++ b/R/date_to_sy.R
@@ -1,10 +1,12 @@
 #' @title Convert a date value into its school year.
 #'
+#' @md
+#'
 #' @description
 #' Checks to see if a date is past the user-specified cutoff point for delineating school years, then maps to the appropriate year.
 #'
-#' @param date_var the date to convert.
-#' @param last_day_of_sy the cutoff date, after which a date is considered part of the following school year.  The year of this argument does not matter.
+#' @param date_var the date to convert. Can be a `Date` object or a string in the form 'YYYY-MM-DD' or 'MM/DD/YYYY'
+#' @param last_day_of_sy the cutoff date, after which a date is considered part of the following school year. The year of this argument does not matter. Defaults (noisily) to July 1st.
 #' @return Returns a character vector in the format of "2013 - 2014"
 
 #' @examples
@@ -16,10 +18,15 @@
 ## Date to SY function
 ## Year of 2nd argument does not matter
 ## Turns 2015-10-02 into "2015-16", and 2016-04-05 into "2015-16", with cutoff day = 2010-07-01
-date_to_sy <- function(date_var, last_day_of_sy) {
-  if (!(lubridate::is.Date(date_var) & lubridate::is.Date(last_day_of_sy))) {
-    stop("`date_var` and `last_day_of_sy` must both be class Date")
+date_to_sy <- function(date_var, last_day_of_sy = NULL) {
+  if(is.null(last_day_of_sy)) {
+    last_day_of_sy <- as.Date("2000-07-01")
+    cli::cli_inform(c("!" = "No cutoff date provided. Using a default cutoff date of {.val {format(last_day_of_sy, '%B %d')}}"))
   }
+
+  date_var <- parse_date(date_var)
+  last_day_of_sy <- parse_date(last_day_of_sy)
+
   cutoff_day <- lubridate::day(last_day_of_sy)
   cutoff_month <- lubridate::month(last_day_of_sy)
   dplyr::case_when(
@@ -29,3 +36,29 @@ date_to_sy <- function(date_var, last_day_of_sy) {
     TRUE ~ paste0(lubridate::year(date_var) - 1, " - ", lubridate::year(date_var)) # prior to cutoff = SY X-1 to X
   )
 }
+
+# Helper function. Returns a date object as is, or noisily attempts to parse
+# a string in the form YYYY-MM-DD or MM/DD/YYYY
+parse_date <- function(date) {
+
+  parse_formats <- c("%Y-%m-%d",
+                     "%m/%d/%Y")
+
+  if(lubridate::is.Date(date)) {
+    date
+  } else {
+    parsed_date <- tryCatch(
+      as.Date(date, tryFormats = parse_formats),
+      error = \(e) {
+        cli::cli_abort(c("x" = "Could not parse date {.val {date}}",
+                         "i" = "Pass a {.cls Date} object or a string in the form {.val YYYY-MM-DD} or {.val MM/DD/YYYY} instead"))
+      })
+
+    # Fix two-digit years (assumes 20..)
+    yr <- lubridate::year(parsed_date)
+    lubridate::year(parsed_date) <- yr + ifelse(yr < 100, 2000, 0)
+
+    cli::cli_inform(c("i" = "Parsed {.val {date}} as {.val {format(parsed_date, '%B %d, %Y')}}"))
+    parsed_date
+  }
+}
diff --git a/man/date_to_sy.Rd b/man/date_to_sy.Rd
index 23f2dee..e425c62 100644
--- a/man/date_to_sy.Rd
+++ b/man/date_to_sy.Rd
@@ -4,12 +4,12 @@
 \alias{date_to_sy}
 \title{Convert a date value into its school year.}
 \usage{
-date_to_sy(date_var, last_day_of_sy)
+date_to_sy(date_var, last_day_of_sy = NULL)
 }
 \arguments{
-\item{date_var}{the date to convert.}
+\item{date_var}{the date to convert. Can be a \code{Date} object or a string in the form 'YYYY-MM-DD' or 'MM/DD/YYYY'}
 
-\item{last_day_of_sy}{the cutoff date, after which a date is considered part of the following school year.  The year of this argument does not matter.}
+\item{last_day_of_sy}{the cutoff date, after which a date is considered part of the following school year. The year of this argument does not matter. Defaults (noisily) to July 1st.}
 }
 \value{
 Returns a character vector in the format of "2013 - 2014"

From 1218396388ef14dfa1df07dc9d8390f33c4cc7dd Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 21 Nov 2023 14:20:42 -0500
Subject: [PATCH 10/30] date_to_sy() and parse_date() tests

---
 tests/testthat/test-date_to_sy.R | 61 ++++++++++++++++++++++++++++++++
 1 file changed, 61 insertions(+)
 create mode 100644 tests/testthat/test-date_to_sy.R

diff --git a/tests/testthat/test-date_to_sy.R b/tests/testthat/test-date_to_sy.R
new file mode 100644
index 0000000..621fb44
--- /dev/null
+++ b/tests/testthat/test-date_to_sy.R
@@ -0,0 +1,61 @@
+
+test_that("date_to_sy works", {
+
+  test_dates <- c(as.Date("2013-10-10"),
+                  as.Date("2013-10-11"),
+                  as.Date("2013-10-12"))
+
+  exp <-  c("2012 - 2013",
+            "2012 - 2013",
+            "2013 - 2014")
+
+  expect_equal(date_to_sy(test_dates, as.Date("2010-10-11")), exp)
+
+})
+
+test_that("date_to_sy defaults to a cutoff date of 7/1", {
+  test_dates <- c("6/30/19",
+                  "7/1/19",
+                  "7/2/19")
+
+  exp <- c("2018 - 2019",
+           "2018 - 2019",
+           "2019 - 2020")
+
+  expect_equal(suppressMessages(date_to_sy(test_dates)), exp)
+
+
+  expect_message(date_to_sy(as.Date("2013-01-01")), "Using a default cutoff date")
+
+})
+
+test_that("parse_date works for different date formats", {
+
+  d <- as.Date("2013-01-03")
+
+  suppressMessages({
+    expect_equal(parse_date("2013-1-3"), d)
+    expect_equal(parse_date("1/3/2013"), d)
+    expect_equal(parse_date(d), d)
+    expect_equal(parse_date("1/3/13"), d)
+    expect_equal(parse_date("13-1-3"), d)
+  })
+
+})
+
+test_that("parse_date works for character vectors", {
+
+  dates <- c("1/1/13", "1/2/13", "1/3/13")
+  exp <- as.Date(c("2013-01-01", "2013-01-02", "2013-01-03"))
+
+  expect_equal(suppressMessages(parse_date(dates)), exp)
+})
+
+test_that("parse_date is noisy when parsing, and silent when not", {
+  expect_message(parse_date("2013-1-3"), "Parsed")
+  expect_no_message(parse_date(as.Date("2013-01-013")))
+})
+
+test_that("parse_date fails with bad input", {
+  expect_error(parse_date("notadate"), "Could not parse")
+})

From 231ecf1b6d1bd2ddba6a8724621d863010942794 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Wed, 22 Nov 2023 12:57:14 -0500
Subject: [PATCH 11/30] Added documentation for internal functions

---
 R/date_to_sy.R           | 12 ++++++++++--
 R/tntp_colors.R          | 12 ++++++++++--
 R/tntp_style.R           | 12 ++++++++++--
 man/choose_text_color.Rd | 17 +++++++++++++++++
 man/get_usable_family.Rd | 22 ++++++++++++++++++++++
 man/is_color.Rd          | 17 +++++++++++++++++
 man/parse_date.Rd        | 19 +++++++++++++++++++
 7 files changed, 105 insertions(+), 6 deletions(-)
 create mode 100644 man/choose_text_color.Rd
 create mode 100644 man/get_usable_family.Rd
 create mode 100644 man/is_color.Rd
 create mode 100644 man/parse_date.Rd

diff --git a/R/date_to_sy.R b/R/date_to_sy.R
index 4f9f411..6935d7f 100644
--- a/R/date_to_sy.R
+++ b/R/date_to_sy.R
@@ -37,8 +37,16 @@ date_to_sy <- function(date_var, last_day_of_sy = NULL) {
   )
 }
 
-# Helper function. Returns a date object as is, or noisily attempts to parse
-# a string in the form YYYY-MM-DD or MM/DD/YYYY
+#' Attempt to parse a date with common formats
+#'
+#' Helper function for date_to_sy. Returns a date object as is, or noisily attempts to parse
+#' a string in the form YYYY-MM-DD or MM/DD/YYYY. If the date cannot be parsed,
+#' throws an error.
+#'
+#' @param date a character or Date vector to parse
+#'
+#' @return Date vector
+#'
 parse_date <- function(date) {
 
   parse_formats <- c("%Y-%m-%d",
diff --git a/R/tntp_colors.R b/R/tntp_colors.R
index 44e2be3..f5399df 100644
--- a/R/tntp_colors.R
+++ b/R/tntp_colors.R
@@ -136,13 +136,21 @@ tntp_colors <- function(...) {
   tntp_color_list[supplied_colors] |> unname()
 }
 
-# Validate color inputs
+#' Validate color inputs
+#'
+#' @param x a color
+#'
+#' @return TRUE if x can be interpreted as a color
 is_color <- function(x) {
   res <- try(grDevices::col2rgb(x), silent = TRUE)
   return(!"try-error" %in% class(res))
 }
 
-# Choose a text color given a background color
+#' Choose a text color given a background color
+#'
+#' @param bg_color a color
+#'
+#' @return "black" or "white"
 choose_text_color <- function(bg_color) {
   stopifnot(is_color(bg_color))
   ifelse(colSums(grDevices::col2rgb(bg_color) * c(.299, .587, .114)) > 150,
diff --git a/R/tntp_style.R b/R/tntp_style.R
index 68b64b3..3c78378 100644
--- a/R/tntp_style.R
+++ b/R/tntp_style.R
@@ -1,7 +1,15 @@
 
 
-# Helper function. Checks if a given family value is available, and if not returns
-# the default font family ("sans" or user provided)
+#' Checks if a font family is usable and returns a usable font if not
+#'
+#' Helper function. Checks if a given family value is available, and if not returns
+#' the default font family ("sans" or user provided)
+#'
+#' @param family the font family to check as a character
+#' @param silent logical. If TRUE doesn't raise a warning if the font family is unavailable
+#' @param default_family defaults to "sans", but can be set to another fallback family.
+#'
+#' @return a character of a usable font family
 get_usable_family <- function(family, silent = FALSE, default_family = "sans") {
 
   # Get a platform-independent list of usable fonts
diff --git a/man/choose_text_color.Rd b/man/choose_text_color.Rd
new file mode 100644
index 0000000..6b376ca
--- /dev/null
+++ b/man/choose_text_color.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tntp_colors.R
+\name{choose_text_color}
+\alias{choose_text_color}
+\title{Choose a text color given a background color}
+\usage{
+choose_text_color(bg_color)
+}
+\arguments{
+\item{bg_color}{a color}
+}
+\value{
+"black" or "white"
+}
+\description{
+Choose a text color given a background color
+}
diff --git a/man/get_usable_family.Rd b/man/get_usable_family.Rd
new file mode 100644
index 0000000..13328c0
--- /dev/null
+++ b/man/get_usable_family.Rd
@@ -0,0 +1,22 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tntp_style.R
+\name{get_usable_family}
+\alias{get_usable_family}
+\title{Checks if a font family is usable and returns a usable font if not}
+\usage{
+get_usable_family(family, silent = FALSE, default_family = "sans")
+}
+\arguments{
+\item{family}{the font family to check as a character}
+
+\item{silent}{logical. If TRUE doesn't raise a warning if the font family is unavailable}
+
+\item{default_family}{defaults to "sans", but can be set to another fallback family.}
+}
+\value{
+a character of a usable font family
+}
+\description{
+Helper function. Checks if a given family value is available, and if not returns
+the default font family ("sans" or user provided)
+}
diff --git a/man/is_color.Rd b/man/is_color.Rd
new file mode 100644
index 0000000..26362b6
--- /dev/null
+++ b/man/is_color.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tntp_colors.R
+\name{is_color}
+\alias{is_color}
+\title{Validate color inputs}
+\usage{
+is_color(x)
+}
+\arguments{
+\item{x}{a color}
+}
+\value{
+TRUE if x can be interpreted as a color
+}
+\description{
+Validate color inputs
+}
diff --git a/man/parse_date.Rd b/man/parse_date.Rd
new file mode 100644
index 0000000..48042ea
--- /dev/null
+++ b/man/parse_date.Rd
@@ -0,0 +1,19 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/date_to_sy.R
+\name{parse_date}
+\alias{parse_date}
+\title{Attempt to parse a date with common formats}
+\usage{
+parse_date(date)
+}
+\arguments{
+\item{date}{a character or Date vector to parse}
+}
+\value{
+Date vector
+}
+\description{
+Helper function for date_to_sy. Returns a date object as is, or noisily attempts to parse
+a string in the form YYYY-MM-DD or MM/DD/YYYY. If the date cannot be parsed,
+throws an error.
+}

From 1e865314c86b3b028e12ed73e9489ab9f844029f Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Wed, 22 Nov 2023 14:15:10 -0500
Subject: [PATCH 12/30] Updated factorize_df to cli warnings. Updated examples

Updated tests to testthat 3e
---
 R/factorize.R                      | 33 +++++++++-----------
 man/factorize_df.Rd                | 15 ++++-----
 tests/testthat/test-factorize-df.R | 50 ------------------------------
 tests/testthat/test-factorize.R    | 37 ++++++++++++++++++++++
 4 files changed, 58 insertions(+), 77 deletions(-)
 delete mode 100644 tests/testthat/test-factorize-df.R
 create mode 100644 tests/testthat/test-factorize.R

diff --git a/R/factorize.R b/R/factorize.R
index c96f97b..5ecb55e 100644
--- a/R/factorize.R
+++ b/R/factorize.R
@@ -25,28 +25,25 @@ prop_matching <- function(vec, valid_strings) {
 #' @return data.frame with factorization completed in place.
 #' @export
 #' @examples
-#' library(dplyr)
-#' mtcars %>%
-#'   dplyr::mutate(agr = rep(c("Somewhat agree", "Strongly disagree"), 16)) %>%
-#'   factorize_df(lvls = c("Strongly disagree", "Somewhat disagree",
-#'                         "Somewhat agree", "Strongly agree"))
+#' teacher_survey |>
+#'   factorize_df(lvls = c("Strongly Disagree", "Disagree", "Somewhat Disagree",
+#'                         "Somewhat Agree", "Agree", "Strongly Agree"))
 #'
 #' # prints warning due to case mismatches:
-#' mtcars %>%
-#'   dplyr::mutate(agr = rep(c("Somewhat Agree", "Strongly Disagree"), 16)) %>%
-#'   factorize_df(lvls = c("Strongly disagree", "Somewhat disagree",
-#'                         "Somewhat agree", "Strongly agree"))
+#' teacher_survey |>
+#'   factorize_df(lvls = c("Strongly disagree", "Disagree", "Somewhat disagree",
+#'                         "Somewhat agree", "Agree", "Strongly agree"))
 factorize_df <- function(dat, lvls) {
-  dat_out <- dat %>%
-    dplyr::mutate_if(~ prop_matching(.x, lvls) == 1, ~ factor(., lvls))
+  dat_out <- dat |>
+    dplyr::mutate_if(~prop_matching(.x, lvls) == 1, ~factor(., lvls))
 
 
   # col types stored as list-columns to be robust to multi-part col classes, e.g., POSIX dates with two parts
   col_diffs <- cbind(
-    lapply(dat, class),
-    lapply(dat_out, class)
-  ) %>%
-    tibble::as_tibble(., rownames = "var_name") %>%
+    V1 = lapply(dat, class),
+    V2 = lapply(dat_out, class)
+  ) |>
+    tibble::as_tibble(rownames = "var_name") |>
     dplyr::mutate(match_prop = purrr::map_dbl(dat, ~ prop_matching(.x, lvls)))
 
   types_changed <- purrr::map2_lgl(col_diffs$V1, col_diffs$V2, purrr::negate(identical))
@@ -56,14 +53,14 @@ factorize_df <- function(dat, lvls) {
   # message if a match was _already_ a factor, the transformations made, or if no matches
   new_text <- ""
   if (any(col_diffs$match_prop == 1 & purrr::map_lgl(dat, inherits, "factor"))) {
-    warning("at least one matching column was already a factor, though this call will have reordered it if different levels provided.  Could be caused by overlapping sets of factor levels, e.g., \"Yes\", \"Maybe\", \"No\" and \"Yes\", \"No\".")
+    cli::cli_warn(c("!" = "At least one matching column was already a factor, though this call will have reordered it if different levels were provided. This could be caused by overlapping sets of factor levels, e.g., {.val Yes}, {.val Maybe}, {.val No} and {.val Yes}, {.val No}"))
     new_text <- "new "
   }
 
   if (length(changed_cols) > 0) {
-    message(paste("Transformed these columns: \n", paste("* ", changed_cols, collapse = ", \n")))
+    cli::cli_inform(c("i" = "Changed the following columns to factors: {.var {changed_cols}}"))
   } else {
-    warning(paste0("No ", new_text, "columns matched.  Check spelling & capitalization of your levels."))
+    cli::cli_warn(c("!" = "No {new_text}columns matched. Check spelling & capitalization of your levels."))
   }
 
   tibble::as_tibble(dat_out)
diff --git a/man/factorize_df.Rd b/man/factorize_df.Rd
index b8dfb05..068f852 100644
--- a/man/factorize_df.Rd
+++ b/man/factorize_df.Rd
@@ -20,15 +20,12 @@ This function examines each column in a data.frame; when it finds a column compo
 This is an alternative to calling \code{dplyr::mutate_at} with \code{factor()} and identifying the specific variables you want to transform, if you have several repeated sets of responses.
 }
 \examples{
-library(dplyr)
-mtcars \%>\%
-  dplyr::mutate(agr = rep(c("Somewhat agree", "Strongly disagree"), 16)) \%>\%
-  factorize_df(lvls = c("Strongly disagree", "Somewhat disagree",
-                        "Somewhat agree", "Strongly agree"))
+teacher_survey |>
+  factorize_df(lvls = c("Strongly Disagree", "Disagree", "Somewhat Disagree",
+                        "Somewhat Agree", "Agree", "Strongly Agree"))
 
 # prints warning due to case mismatches:
-mtcars \%>\%
-  dplyr::mutate(agr = rep(c("Somewhat Agree", "Strongly Disagree"), 16)) \%>\%
-  factorize_df(lvls = c("Strongly disagree", "Somewhat disagree",
-                        "Somewhat agree", "Strongly agree"))
+teacher_survey |>
+  factorize_df(lvls = c("Strongly disagree", "Disagree", "Somewhat disagree",
+                        "Somewhat agree", "Agree", "Strongly agree"))
 }
diff --git a/tests/testthat/test-factorize-df.R b/tests/testthat/test-factorize-df.R
deleted file mode 100644
index 05e185a..0000000
--- a/tests/testthat/test-factorize-df.R
+++ /dev/null
@@ -1,50 +0,0 @@
-# Tests for factorizing columns based on string matching
-
-library(tntpr)
-library(testthat)
-context("factorize_df")
-
-x <- data.frame(
-  a = c("a lot", "a little", "some", "some"),
-  b = 1:4,
-  c = rep(as.POSIXct(Sys.Date()), 4),
-  stringsAsFactors = FALSE
-)
-
-test_that("works with POSIX (two-class) columns present", {
-  y <- x
-  y$a <- factor(y$a, c("a little", "some", "a lot"))
-  expect_equal(tibble::as_tibble(y), factorize_df(x, c("a little", "some", "a lot")))
-})
-
-test_that("warning message if no matches found", {
-  expect_warning(factorize_df(x, c("bugs", "birds")),
-    "No columns matched.  Check spelling & capitalization of your levels.",
-    fixed = TRUE
-  )
-})
-
-test_that("appropriate message prints if matched but already factor", {
-  aa <- factorize_df(x, 4:1)
-  ab <- aa
-  ab$d <- 1:4
-  expect_warning(suppressMessages(factorize_df(aa, 4:1)),
-    "at least one matching column was already a factor, though this call will have reordered it if different levels provided.  Could be caused by overlapping sets of factor levels, e.g., \"Yes\", \"Maybe\", \"No\" and \"Yes\", \"No\".",
-    fixed = TRUE
-  )
-
-  expect_warning(suppressMessages(factorize_df(aa, 4:1)), # it says no NEW columns, acknowledging that there was a match but it was already a factor
-    "No new columns matched.  Check spelling & capitalization of your levels.",
-    fixed = TRUE
-  )
-
-  # the unusual case where there's a match on a non-factor and an already-present factor match
-  expect_warning(factorize_df(ab, 4:1),
-    "at least one matching column was already a factor, though this call will have reordered it if different levels provided.  Could be caused by overlapping sets of factor levels, e.g., \"Yes\", \"Maybe\", \"No\" and \"Yes\", \"No\".",
-    fixed = TRUE
-  )
-  expect_message(suppressWarnings(factorize_df(ab, 4:1)),
-    paste("Transformed these columns: \n", paste("* ", "d", collapse = ", \n")),
-    fixed = TRUE
-  )
-})
diff --git a/tests/testthat/test-factorize.R b/tests/testthat/test-factorize.R
new file mode 100644
index 0000000..9151599
--- /dev/null
+++ b/tests/testthat/test-factorize.R
@@ -0,0 +1,37 @@
+# Example data frame for testing
+x <- data.frame(
+  a = c("a lot", "a little", "some", "some"),
+  b = 1:4,
+  c = rep(as.POSIXct(Sys.Date()), 4),
+  stringsAsFactors = FALSE
+)
+
+# Tests
+test_that("works with POSIX (two-class) columns present", {
+  y <- x
+  y$a <- factor(y$a, c("a little", "some", "a lot"))
+  expect_equal(tibble::as_tibble(y), factorize_df(x, c("a little", "some", "a lot")))
+})
+
+test_that("warning message if no matches found", {
+  expect_warning(factorize_df(x, c("bugs", "birds")),
+                 "No columns matched.",
+                 fixed = TRUE
+  )
+})
+
+test_that("appropriate message prints if matched but already factor", {
+  aa <- suppressMessages(factorize_df(x, 4:1))
+  ab <- aa
+  ab$d <- 1:4
+
+  factorize_df(aa, 4:1) |>
+    suppressMessages() |>
+    expect_warning("matching column was already a factor") |>
+    expect_warning("No new columns matched.") # Includes "new " in message
+
+  # the unusual case where there's a match on a non-factor and an already-present factor match
+  factorize_df(ab, 4:1) |>
+    expect_warning("matching column was already a factor") |>
+    expect_message("Changed the following columns to factors:")
+})

From 675d60d277c913ae21d542c415ceee20ab711646 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 27 Nov 2023 08:29:45 -0500
Subject: [PATCH 13/30] Added ignore.case parameter and functionality to
 factorize_df()

---
 DESCRIPTION                     |  3 +-
 R/factorize.R                   | 63 +++++++++++++++++++++++++++++----
 man/factorize_df.Rd             |  4 ++-
 man/prop_matching.Rd            |  4 ++-
 man/update_case.Rd              | 20 +++++++++++
 tests/testthat/test-factorize.R | 45 +++++++++++++++++++++++
 6 files changed, 130 insertions(+), 9 deletions(-)
 create mode 100644 man/update_case.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index 6b31694..e52f92d 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -32,7 +32,8 @@ Imports:
     scales,
     stringr (>= 1.4.0),
     tibble (>= 2.1.3),
-    tidyr (>= 1.0.0)
+    tidyr (>= 1.0.0),
+    tidyselect
 Suggests: 
     devtools,
     knitr,
diff --git a/R/factorize.R b/R/factorize.R
index 5ecb55e..02b0b1e 100644
--- a/R/factorize.R
+++ b/R/factorize.R
@@ -2,25 +2,51 @@
 #'
 #' @param vec character vector.
 #' @param valid_strings the values that the variable can possibly take on.
+#' @param ignore.case if TRUE, ignores case in matching
 #'
 #' @return numeric proportion between 0 and 1.
-prop_matching <- function(vec, valid_strings) {
+prop_matching <- function(vec, valid_strings, ignore.case = FALSE) {
   vec <- as.character(vec)
   if (all(is.na(vec))) {
     message("Fully NA column detected; consider janitor::remove_empty()")
     return(0)
   }
+  if(ignore.case) {
+    vec <- tolower(vec)
+    valid_strings <- tolower(valid_strings)
+  }
   mean(vec[!is.na(vec)] %in% valid_strings)
 }
 
+#' Update case of a character vector
+#'
+#' Helper function for factorize_df(). Returns a vector of the same length as vec,
+#' with any values that match values in valid_strings updated to the case in valid_strings
+#'
+#' @param vec The character vector you want to update
+#' @param new_case A character vector of correctly cased strings
+#'
+#' @return a character vector the same length as vec
+#'
+update_case <- function(vec, new_case) {
+
+  names(new_case) <- tolower(new_case)
+  vec_l <- tolower(vec)
+
+  ifelse(vec_l %in% names(new_case),
+         new_case[vec_l], vec)
+}
+
 
 #' @title Convert all character vectors containing a set of values in a data.frame to factors.
 #' @description This function examines each column in a data.frame; when it finds a column composed solely of the values provided to the \code{lvls} argument it updates them to be factor variables, with levels in the order provided.
 #'
 #' This is an alternative to calling \code{dplyr::mutate_at} with \code{factor()} and identifying the specific variables you want to transform, if you have several repeated sets of responses.
 #'
+#' @md
 #' @param dat data.frame with some factor variables stored as characters.
 #' @param lvls The factor levels in your variable(s), in order.  If you have a question whose possible responses are a subset of another question's, don't use this function; manipulate the specific columns with \code{dplyr::mutate_at}.
+#' @param ignore.case Logical. If TRUE, will match without checking case, using the capitalization from the `lvls` parameter for the final output. If not provided, the function will provide a warning if it detects columns that would match without checking case but will NOT coerce them.
 #'
 #' @return data.frame with factorization completed in place.
 #' @export
@@ -33,10 +59,30 @@ prop_matching <- function(vec, valid_strings) {
 #' teacher_survey |>
 #'   factorize_df(lvls = c("Strongly disagree", "Disagree", "Somewhat disagree",
 #'                         "Somewhat agree", "Agree", "Strongly agree"))
-factorize_df <- function(dat, lvls) {
-  dat_out <- dat |>
-    dplyr::mutate_if(~prop_matching(.x, lvls) == 1, ~factor(., lvls))
+factorize_df <- function(dat, lvls, ignore.case = NULL) {
 
+  match_exact <- sapply(dat, prop_matching, lvls)
+  match_all <- sapply(dat, prop_matching, lvls, ignore.case=TRUE)
+
+  # Do any columns match without case, but not match exactly?
+  match_nocase <- (match_all == 1) & (match_exact < 1)
+
+  dat_out <- dat
+
+  if(is.null(ignore.case) || !ignore.case) {
+    transform_cols <- names(match_exact[match_exact == 1])
+
+  } else {
+    transform_cols <- names(match_all[match_all == 1])
+    # Update capitalization if ignoring case
+    dat_out <- dat_out |>
+      dplyr::mutate(dplyr::across(tidyselect::all_of(transform_cols),
+                                  ~update_case(., lvls)))
+  }
+
+  dat_out <- dat_out |>
+    dplyr::mutate(dplyr::across(tidyselect::all_of(transform_cols),
+                                ~factor(., lvls)))
 
   # col types stored as list-columns to be robust to multi-part col classes, e.g., POSIX dates with two parts
   col_diffs <- cbind(
@@ -50,14 +96,19 @@ factorize_df <- function(dat, lvls) {
 
   changed_cols <- col_diffs$var_name[types_changed]
 
+  # ignore.case messages
+  if(is.null(ignore.case) && any(match_nocase)) {
+    cli::cli_warn(c("!" = "Column{?s} {.var {names(match_nocase)[match_nocase]}} {?was/were} NOT matched, but would match if {.var ignore.case} was set to {.val TRUE}"))
+  }
+
   # message if a match was _already_ a factor, the transformations made, or if no matches
   new_text <- ""
-  if (any(col_diffs$match_prop == 1 & purrr::map_lgl(dat, inherits, "factor"))) {
+  if(any(col_diffs$match_prop == 1 & purrr::map_lgl(dat, inherits, "factor"))) {
     cli::cli_warn(c("!" = "At least one matching column was already a factor, though this call will have reordered it if different levels were provided. This could be caused by overlapping sets of factor levels, e.g., {.val Yes}, {.val Maybe}, {.val No} and {.val Yes}, {.val No}"))
     new_text <- "new "
   }
 
-  if (length(changed_cols) > 0) {
+  if(length(changed_cols) > 0) {
     cli::cli_inform(c("i" = "Changed the following columns to factors: {.var {changed_cols}}"))
   } else {
     cli::cli_warn(c("!" = "No {new_text}columns matched. Check spelling & capitalization of your levels."))
diff --git a/man/factorize_df.Rd b/man/factorize_df.Rd
index 068f852..d2fa114 100644
--- a/man/factorize_df.Rd
+++ b/man/factorize_df.Rd
@@ -4,12 +4,14 @@
 \alias{factorize_df}
 \title{Convert all character vectors containing a set of values in a data.frame to factors.}
 \usage{
-factorize_df(dat, lvls)
+factorize_df(dat, lvls, ignore.case = NULL)
 }
 \arguments{
 \item{dat}{data.frame with some factor variables stored as characters.}
 
 \item{lvls}{The factor levels in your variable(s), in order.  If you have a question whose possible responses are a subset of another question's, don't use this function; manipulate the specific columns with \code{dplyr::mutate_at}.}
+
+\item{ignore.case}{Logical. If TRUE, will match without checking case, using the capitalization from the \code{lvls} parameter for the final output. If not provided, the function will provide a warning if it detects columns that would match without checking case but will NOT coerce them.}
 }
 \value{
 data.frame with factorization completed in place.
diff --git a/man/prop_matching.Rd b/man/prop_matching.Rd
index 93d3eb9..2668bcd 100644
--- a/man/prop_matching.Rd
+++ b/man/prop_matching.Rd
@@ -4,12 +4,14 @@
 \alias{prop_matching}
 \title{Calculate the percent of non-missing values in a character vector containing the values of interest.  This is a helper function for factorize_df().}
 \usage{
-prop_matching(vec, valid_strings)
+prop_matching(vec, valid_strings, ignore.case = FALSE)
 }
 \arguments{
 \item{vec}{character vector.}
 
 \item{valid_strings}{the values that the variable can possibly take on.}
+
+\item{ignore.case}{if TRUE, ignores case in matching}
 }
 \value{
 numeric proportion between 0 and 1.
diff --git a/man/update_case.Rd b/man/update_case.Rd
new file mode 100644
index 0000000..5150948
--- /dev/null
+++ b/man/update_case.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/factorize.R
+\name{update_case}
+\alias{update_case}
+\title{Update case of a character vector}
+\usage{
+update_case(vec, new_case)
+}
+\arguments{
+\item{vec}{The character vector you want to update}
+
+\item{new_case}{A character vector of correctly cased strings}
+}
+\value{
+a character vector the same length as vec
+}
+\description{
+Helper function for factorize_df(). Returns a vector of the same length as vec,
+with any values that match values in valid_strings updated to the case in valid_strings
+}
diff --git a/tests/testthat/test-factorize.R b/tests/testthat/test-factorize.R
index 9151599..aae0b0f 100644
--- a/tests/testthat/test-factorize.R
+++ b/tests/testthat/test-factorize.R
@@ -7,6 +7,51 @@ x <- data.frame(
 )
 
 # Tests
+test_that("prop_matching works as expected", {
+  a <- c("frog", "lizard", "frog", "frog")
+  b <- c("FroG", "LIZard", "FROG", "frog")
+  c <- c("frog", "bunny", "frog", "lizard")
+
+  valid <- c("frog", "lizard")
+
+  expect_equal(prop_matching(a, valid), 1)
+  expect_equal(prop_matching(b, valid, ignore.case = FALSE), 0.25)
+  expect_equal(prop_matching(b, valid, ignore.case = TRUE), 1)
+  expect_equal(prop_matching(c, valid), 0.75)
+})
+
+test_that("update_case works as expected", {
+  a <- c("yes", "no", "Yes", "Yess", "NO")
+  expect_equal(update_case(a, "Yes"), c("Yes", "no", "Yes", "Yess", "NO"))
+  expect_equal(update_case(a, c("YES", "NO")), c("YES", "NO", "YES", "Yess", "NO"))
+})
+
+test_that("ignore.case works", {
+  df <- tibble::tibble(
+    a = c("Yes", "yes", "No", "nO"),
+    b = c("Yes", "yes", "yes", "YES"),
+    c = c("yes", "maybe", "no", "no")
+  )
+
+  ymn <- c("yes", "maybe", "no")
+  YN <- c("Yes", "No")
+
+  # Warning when not provided:
+  expect_equal(factorize_df(df, ymn), df |> dplyr::mutate(c = factor(c, levels = ymn))) |>
+    expect_warning("NOT matched, but would match if") |>
+    suppressMessages()
+
+  # No warning when set to FALSE
+  expect_equal(factorize_df(df, ymn, ignore.case = FALSE), df |> dplyr::mutate(c = factor(c, levels = ymn))) |>
+    suppressMessages()
+
+  # Ignores case and no warning when set to TRUE:
+  factorize_df(df, YN, ignore.case = TRUE) |>
+    expect_equal(df |> dplyr::mutate(a = factor(c("Yes", "Yes", "No", "No"), levels = YN),
+                                     b = factor(c("Yes", "Yes", "Yes", "Yes"), levels = YN))) |>
+    suppressMessages()
+})
+
 test_that("works with POSIX (two-class) columns present", {
   y <- x
   y$a <- factor(y$a, c("a little", "some", "a lot"))

From 343b1a16eca221c7a4fc0782fa586fe657793b86 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 27 Nov 2023 15:03:34 -0500
Subject: [PATCH 14/30] Fixed documentation bug in fake county data

---
 R/data.R           | 76 +++++++++++++++++++++++-----------------------
 man/fake_county.Rd | 76 +++++++++++++++++++++++-----------------------
 2 files changed, 76 insertions(+), 76 deletions(-)

diff --git a/R/data.R b/R/data.R
index 6a73341..6bdef26 100644
--- a/R/data.R
+++ b/R/data.R
@@ -34,44 +34,44 @@
 #'
 #' @format A data frame with 39,339 rows and 38 variables:
 #' \describe{
-#'   \\item{tid}{double: Teacher ID}
-#'   \\item{fake_data}{double: Record Is Simulated}
-#'   \\item{school_year}{double: School Year}
-#'   \\item{school_code}{double: School Code}
-#'   \\item{school_name}{character: School Name}
-#'   \\item{t_male}{double: Teacher Is Male}
-#'   \\item{t_race_ethnicity}{double: Teacher Race/Ethnicity}
-#'   \\item{t_job_area}{double: Teacher Assignment Type}
-#'   \\item{t_salary}{double: Monthly Salary}
-#'   \\item{t_nbpts}{double: Teacher Has National Board Certification}
-#'   \\item{t_tenured}{double: Teacher Is Tenured}
-#'   \\item{t_experience}{double: Years of Teaching Experience}
-#'   \\item{t_fte}{double: Teacher's FTE Status}
-#'   \\item{t_highest_degree}{double: Teacher's Highest Degree}
-#'   \\item{t_licensed_stem}{double: Teacher Is Licensed In STEM Field}
-#'   \\item{t_eval_obs}{double: Evaluation Summary Observation Score}
-#'   \\item{t_eval_growth}{double: Evaluation Summary Student Growth Score}
-#'   \\item{t_stay}{double: Teacher in Same School in Following Year}
-#'   \\item{t_transfer}{double: Teacher in Different School in Following Year}
-#'   \\item{t_leave}{double: Teacher Not Teaching in Fake County Schools in Following Year}
-#'   \\item{t_novice}{double: Teacher Is Novice First-Year Teacher}
-#'   \\item{t_new_hire}{double: Teacher Did Not Teach in Fake County in Prior Year}
-#'   \\item{sch_elem}{double: School Is Elementary School}
-#'   \\item{sch_middle}{double: School Is Middle School}
-#'   \\item{sch_high}{double: School Is High School}
-#'   \\item{sch_alternative}{double: School Is Alternative School}
-#'   \\item{sch_regular}{double: School Is Regular School}
-#'   \\item{sch_title_1}{double: School Is Title 1 School}
-#'   \\item{sch_magnet}{double: School Is Magnet School}
-#'   \\item{sch_vocati~l}{double: School is Vocational School}
-#'   \\item{sch_region}{double: School Region Code}
-#'   \\item{sch_calendar_type}{double: School Calendar Type}
-#'   \\item{sch_iep_pct}{double: School Special Education Student Share in 2012-15}
-#'   \\item{sch_minority_pct}{double: School Minority Student Share in 2012-15}
-#'   \\item{sch_frpl_pct}{double: School Free and Reduced Price Lunch Student Share in 2012-15}
-#'   \\item{sch_ela_avg}{double: School ELA Test Score Average in 2012-15 (in standard deviations)}
-#'   \\item{sch_math_avg}{double: School Math Test Score Average in 2012-15 (in standard deviations)}
-#'   \\item{sch_enrollment_2015}{double: School Enrollment in 2015}
+#'   \item{tid}{double: Teacher ID}
+#'   \item{fake_data}{double: Record Is Simulated}
+#'   \item{school_year}{double: School Year}
+#'   \item{school_code}{double: School Code}
+#'   \item{school_name}{character: School Name}
+#'   \item{t_male}{double: Teacher Is Male}
+#'   \item{t_race_ethnicity}{double: Teacher Race/Ethnicity}
+#'   \item{t_job_area}{double: Teacher Assignment Type}
+#'   \item{t_salary}{double: Monthly Salary}
+#'   \item{t_nbpts}{double: Teacher Has National Board Certification}
+#'   \item{t_tenured}{double: Teacher Is Tenured}
+#'   \item{t_experience}{double: Years of Teaching Experience}
+#'   \item{t_fte}{double: Teacher's FTE Status}
+#'   \item{t_highest_degree}{double: Teacher's Highest Degree}
+#'   \item{t_licensed_stem}{double: Teacher Is Licensed In STEM Field}
+#'   \item{t_eval_obs}{double: Evaluation Summary Observation Score}
+#'   \item{t_eval_growth}{double: Evaluation Summary Student Growth Score}
+#'   \item{t_stay}{double: Teacher in Same School in Following Year}
+#'   \item{t_transfer}{double: Teacher in Different School in Following Year}
+#'   \item{t_leave}{double: Teacher Not Teaching in Fake County Schools in Following Year}
+#'   \item{t_novice}{double: Teacher Is Novice First-Year Teacher}
+#'   \item{t_new_hire}{double: Teacher Did Not Teach in Fake County in Prior Year}
+#'   \item{sch_elem}{double: School Is Elementary School}
+#'   \item{sch_middle}{double: School Is Middle School}
+#'   \item{sch_high}{double: School Is High School}
+#'   \item{sch_alternative}{double: School Is Alternative School}
+#'   \item{sch_regular}{double: School Is Regular School}
+#'   \item{sch_title_1}{double: School Is Title 1 School}
+#'   \item{sch_magnet}{double: School Is Magnet School}
+#'   \item{sch_vocati~l}{double: School is Vocational School}
+#'   \item{sch_region}{double: School Region Code}
+#'   \item{sch_calendar_type}{double: School Calendar Type}
+#'   \item{sch_iep_pct}{double: School Special Education Student Share in 2012-15}
+#'   \item{sch_minority_pct}{double: School Minority Student Share in 2012-15}
+#'   \item{sch_frpl_pct}{double: School Free and Reduced Price Lunch Student Share in 2012-15}
+#'   \item{sch_ela_avg}{double: School ELA Test Score Average in 2012-15 (in standard deviations)}
+#'   \item{sch_math_avg}{double: School Math Test Score Average in 2012-15 (in standard deviations)}
+#'   \item{sch_enrollment_2015}{double: School Enrollment in 2015}
 #' }
 #' @source \url{https://github.com/OpenSDP/fake-county}, posted under a Creative Commons license.
 "fake_county"
diff --git a/man/fake_county.Rd b/man/fake_county.Rd
index f51a3ed..9c986b6 100644
--- a/man/fake_county.Rd
+++ b/man/fake_county.Rd
@@ -7,44 +7,44 @@
 \format{
 A data frame with 39,339 rows and 38 variables:
 \describe{
-  \\item{tid}{double: Teacher ID}
-  \\item{fake_data}{double: Record Is Simulated}
-  \\item{school_year}{double: School Year}
-  \\item{school_code}{double: School Code}
-  \\item{school_name}{character: School Name}
-  \\item{t_male}{double: Teacher Is Male}
-  \\item{t_race_ethnicity}{double: Teacher Race/Ethnicity}
-  \\item{t_job_area}{double: Teacher Assignment Type}
-  \\item{t_salary}{double: Monthly Salary}
-  \\item{t_nbpts}{double: Teacher Has National Board Certification}
-  \\item{t_tenured}{double: Teacher Is Tenured}
-  \\item{t_experience}{double: Years of Teaching Experience}
-  \\item{t_fte}{double: Teacher's FTE Status}
-  \\item{t_highest_degree}{double: Teacher's Highest Degree}
-  \\item{t_licensed_stem}{double: Teacher Is Licensed In STEM Field}
-  \\item{t_eval_obs}{double: Evaluation Summary Observation Score}
-  \\item{t_eval_growth}{double: Evaluation Summary Student Growth Score}
-  \\item{t_stay}{double: Teacher in Same School in Following Year}
-  \\item{t_transfer}{double: Teacher in Different School in Following Year}
-  \\item{t_leave}{double: Teacher Not Teaching in Fake County Schools in Following Year}
-  \\item{t_novice}{double: Teacher Is Novice First-Year Teacher}
-  \\item{t_new_hire}{double: Teacher Did Not Teach in Fake County in Prior Year}
-  \\item{sch_elem}{double: School Is Elementary School}
-  \\item{sch_middle}{double: School Is Middle School}
-  \\item{sch_high}{double: School Is High School}
-  \\item{sch_alternative}{double: School Is Alternative School}
-  \\item{sch_regular}{double: School Is Regular School}
-  \\item{sch_title_1}{double: School Is Title 1 School}
-  \\item{sch_magnet}{double: School Is Magnet School}
-  \\item{sch_vocati~l}{double: School is Vocational School}
-  \\item{sch_region}{double: School Region Code}
-  \\item{sch_calendar_type}{double: School Calendar Type}
-  \\item{sch_iep_pct}{double: School Special Education Student Share in 2012-15}
-  \\item{sch_minority_pct}{double: School Minority Student Share in 2012-15}
-  \\item{sch_frpl_pct}{double: School Free and Reduced Price Lunch Student Share in 2012-15}
-  \\item{sch_ela_avg}{double: School ELA Test Score Average in 2012-15 (in standard deviations)}
-  \\item{sch_math_avg}{double: School Math Test Score Average in 2012-15 (in standard deviations)}
-  \\item{sch_enrollment_2015}{double: School Enrollment in 2015}
+  \item{tid}{double: Teacher ID}
+  \item{fake_data}{double: Record Is Simulated}
+  \item{school_year}{double: School Year}
+  \item{school_code}{double: School Code}
+  \item{school_name}{character: School Name}
+  \item{t_male}{double: Teacher Is Male}
+  \item{t_race_ethnicity}{double: Teacher Race/Ethnicity}
+  \item{t_job_area}{double: Teacher Assignment Type}
+  \item{t_salary}{double: Monthly Salary}
+  \item{t_nbpts}{double: Teacher Has National Board Certification}
+  \item{t_tenured}{double: Teacher Is Tenured}
+  \item{t_experience}{double: Years of Teaching Experience}
+  \item{t_fte}{double: Teacher's FTE Status}
+  \item{t_highest_degree}{double: Teacher's Highest Degree}
+  \item{t_licensed_stem}{double: Teacher Is Licensed In STEM Field}
+  \item{t_eval_obs}{double: Evaluation Summary Observation Score}
+  \item{t_eval_growth}{double: Evaluation Summary Student Growth Score}
+  \item{t_stay}{double: Teacher in Same School in Following Year}
+  \item{t_transfer}{double: Teacher in Different School in Following Year}
+  \item{t_leave}{double: Teacher Not Teaching in Fake County Schools in Following Year}
+  \item{t_novice}{double: Teacher Is Novice First-Year Teacher}
+  \item{t_new_hire}{double: Teacher Did Not Teach in Fake County in Prior Year}
+  \item{sch_elem}{double: School Is Elementary School}
+  \item{sch_middle}{double: School Is Middle School}
+  \item{sch_high}{double: School Is High School}
+  \item{sch_alternative}{double: School Is Alternative School}
+  \item{sch_regular}{double: School Is Regular School}
+  \item{sch_title_1}{double: School Is Title 1 School}
+  \item{sch_magnet}{double: School Is Magnet School}
+  \item{sch_vocati~l}{double: School is Vocational School}
+  \item{sch_region}{double: School Region Code}
+  \item{sch_calendar_type}{double: School Calendar Type}
+  \item{sch_iep_pct}{double: School Special Education Student Share in 2012-15}
+  \item{sch_minority_pct}{double: School Minority Student Share in 2012-15}
+  \item{sch_frpl_pct}{double: School Free and Reduced Price Lunch Student Share in 2012-15}
+  \item{sch_ela_avg}{double: School ELA Test Score Average in 2012-15 (in standard deviations)}
+  \item{sch_math_avg}{double: School Math Test Score Average in 2012-15 (in standard deviations)}
+  \item{sch_enrollment_2015}{double: School Enrollment in 2015}
 }
 }
 \source{

From 5bf6a18ff3de939dfbbf3eb333d703a8e9fa22b6 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 27 Nov 2023 15:03:50 -0500
Subject: [PATCH 15/30] Basic tests for deprecated themes

---
 tests/testthat/test-theme_tntp.R      | 4 ++++
 tests/testthat/test-theme_tntp_2018.R | 4 ++++
 2 files changed, 8 insertions(+)
 create mode 100644 tests/testthat/test-theme_tntp.R
 create mode 100644 tests/testthat/test-theme_tntp_2018.R

diff --git a/tests/testthat/test-theme_tntp.R b/tests/testthat/test-theme_tntp.R
new file mode 100644
index 0000000..271bb2c
--- /dev/null
+++ b/tests/testthat/test-theme_tntp.R
@@ -0,0 +1,4 @@
+test_that("theme_tntp is a theme", {
+  expect_s3_class(theme_tntp(), "theme") |>
+    expect_warning("deprecated")
+})
diff --git a/tests/testthat/test-theme_tntp_2018.R b/tests/testthat/test-theme_tntp_2018.R
new file mode 100644
index 0000000..5f31e72
--- /dev/null
+++ b/tests/testthat/test-theme_tntp_2018.R
@@ -0,0 +1,4 @@
+test_that("theme_tntp_2018 is a theme", {
+  expect_s3_class(theme_tntp_2018(), "theme") |>
+    expect_warning("deprecated")
+})

From e728b06ab18dda54320cbd11a9bd23160c89551c Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 27 Nov 2023 15:10:09 -0500
Subject: [PATCH 16/30] Fixing Rhub CRAN notes

---
 README.Rmd                           | 6 ++++--
 vignettes/visualization-cookbook.Rmd | 2 +-
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/README.Rmd b/README.Rmd
index 7194b5d..ac874e2 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -13,8 +13,10 @@ knitr::opts_chunk$set(
 )
 ```
 
-[![Travis-CI Build
-Status](https://travis-ci.org/tntp/tntpr.svg?branch=master)](https://travis-ci.org/tntp/tntpr)
+<!-- [![Travis-CI Build
+Status](https://travis-ci.org/tntp/tntpr.svg?branch=master)](https://travis-ci.org/tntp/tntpr) 
+
+Removed above - doesn't seem to link to anything?-->
 
 # tntpr <img src="man/figures/logo.png" align="right" />
 
diff --git a/vignettes/visualization-cookbook.Rmd b/vignettes/visualization-cookbook.Rmd
index 5990c81..d8b54d4 100644
--- a/vignettes/visualization-cookbook.Rmd
+++ b/vignettes/visualization-cookbook.Rmd
@@ -92,7 +92,7 @@ The `family` parameter lets you set the text font family. This changes the font
 
 You will need to manually import additional fonts, including the Halyard fonts, using the `extrafont` package before they are available to R. Follow these steps to import fonts:
 
-1. Download the Halyard Display Fonts in .ttf forms from the [Data Analytics Sharepoint](https://tntp.sharepoint.com/sites/DataAnalytics/Shared%20Documents/Forms/AllItems.aspx?viewid=ed2700f4%2D6b5b%2D4d23%2Da5c5%2D5567e8a5ccce) under the "Fonts" category.
+1. Download the Halyard Display Fonts in .ttf forms from the [Data Analytics Sharepoint](https://tntp.sharepoint.com/sites/DataAnalytics/Shared%20Documents/Forms/AllItems.aspx) under the "Fonts" category.
 2. Open the fonts folder on your laptop (Settings -> Personalization -> Fonts) and drag and drop the Halyard Fonts there to install them on your computer.
 3. In RStudio, install the `extrafont` package with `install.packages('extrafont)`.
 4. Import fonts into the extrafont database with `extrafont::font_import()`. This only needs to be done once. The process is long, and can be significantly shortened by only importing the Halyard fonts using `extrafont::font_import(pattern = 'Halyard')`.

From 270d134d1abfc0805b8e6ff246f03ca689eb7582 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 27 Nov 2023 15:17:42 -0500
Subject: [PATCH 17/30] Fixed fake_county documentation

---
 R/data.R           | 4 ++--
 man/fake_county.Rd | 4 ++--
 2 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/R/data.R b/R/data.R
index 6bdef26..078cdec 100644
--- a/R/data.R
+++ b/R/data.R
@@ -63,7 +63,7 @@
 #'   \item{sch_regular}{double: School Is Regular School}
 #'   \item{sch_title_1}{double: School Is Title 1 School}
 #'   \item{sch_magnet}{double: School Is Magnet School}
-#'   \item{sch_vocati~l}{double: School is Vocational School}
+#'   \item{sch_vocational}{double: School is Vocational School}
 #'   \item{sch_region}{double: School Region Code}
 #'   \item{sch_calendar_type}{double: School Calendar Type}
 #'   \item{sch_iep_pct}{double: School Special Education Student Share in 2012-15}
@@ -71,7 +71,7 @@
 #'   \item{sch_frpl_pct}{double: School Free and Reduced Price Lunch Student Share in 2012-15}
 #'   \item{sch_ela_avg}{double: School ELA Test Score Average in 2012-15 (in standard deviations)}
 #'   \item{sch_math_avg}{double: School Math Test Score Average in 2012-15 (in standard deviations)}
-#'   \item{sch_enrollment_2015}{double: School Enrollment in 2015}
+#'   \item{sch_enroll_2015}{double: School Enrollment in 2015}
 #' }
 #' @source \url{https://github.com/OpenSDP/fake-county}, posted under a Creative Commons license.
 "fake_county"
diff --git a/man/fake_county.Rd b/man/fake_county.Rd
index 9c986b6..61a3d3c 100644
--- a/man/fake_county.Rd
+++ b/man/fake_county.Rd
@@ -36,7 +36,7 @@ A data frame with 39,339 rows and 38 variables:
   \item{sch_regular}{double: School Is Regular School}
   \item{sch_title_1}{double: School Is Title 1 School}
   \item{sch_magnet}{double: School Is Magnet School}
-  \item{sch_vocati~l}{double: School is Vocational School}
+  \item{sch_vocational}{double: School is Vocational School}
   \item{sch_region}{double: School Region Code}
   \item{sch_calendar_type}{double: School Calendar Type}
   \item{sch_iep_pct}{double: School Special Education Student Share in 2012-15}
@@ -44,7 +44,7 @@ A data frame with 39,339 rows and 38 variables:
   \item{sch_frpl_pct}{double: School Free and Reduced Price Lunch Student Share in 2012-15}
   \item{sch_ela_avg}{double: School ELA Test Score Average in 2012-15 (in standard deviations)}
   \item{sch_math_avg}{double: School Math Test Score Average in 2012-15 (in standard deviations)}
-  \item{sch_enrollment_2015}{double: School Enrollment in 2015}
+  \item{sch_enroll_2015}{double: School Enrollment in 2015}
 }
 }
 \source{

From 7165e3248ab8ebab4d9268df269ca3c1d743c2c0 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 28 Nov 2023 12:22:08 -0500
Subject: [PATCH 18/30] Deprecated labelled_to_factors()

---
 DESCRIPTION                |  3 ++-
 R/labelled_to_factors.R    | 18 +++++++++++++-----
 man/labelled_to_factors.Rd |  8 ++++++--
 3 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index e52f92d..8010c71 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -42,7 +42,8 @@ Suggests:
     usethis,
     ggridges,
     ggalt,
-    forcats
+    forcats,
+    haven
 VignetteBuilder: 
     knitr
 Encoding: UTF-8
diff --git a/R/labelled_to_factors.R b/R/labelled_to_factors.R
index b183e23..09901c9 100644
--- a/R/labelled_to_factors.R
+++ b/R/labelled_to_factors.R
@@ -1,16 +1,24 @@
-#' @title Convert all \code{labelled}-class columns to factors.
+#' @title Convert all `labelled`-class columns to factors.
+#'
+#' @md
 #'
 #' @description
-#' Takes a data.frame, checks for columns that are class \code{labelled} from the \code{haven} package, and converts them to factor class.
+#' Deprecated. Use the `as_factor()` function from the `haven` package instead for the same functionality.
+#'
+#' Takes a data.frame, checks for columns that are class `labelled` from the `haven` package, and converts them to factor class.
 #'
 #' @param labels_df a data.frame containing some columns of class labelled
 #' @return Returns a data.frame.
 #' @export
 #' @examples
-#' # not run
-#' # haven::read_spss(filepath) %>% labelled_to_factor()
-# Convert labelled columns to factors
+#'
+#' tntpr::fake_county |>
+#'   haven::as_factor()
+#'
 labelled_to_factors <- function(labels_df) {
+
+  .Deprecated()
+
   labeled_var_index <- unlist(
     lapply(labels_df, function(x) class(x) == "labelled")
   )
diff --git a/man/labelled_to_factors.Rd b/man/labelled_to_factors.Rd
index d6d0729..beb96d9 100644
--- a/man/labelled_to_factors.Rd
+++ b/man/labelled_to_factors.Rd
@@ -13,9 +13,13 @@ labelled_to_factors(labels_df)
 Returns a data.frame.
 }
 \description{
+Deprecated. Use the \code{as_factor()} function from the \code{haven} package instead for the same functionality.
+
 Takes a data.frame, checks for columns that are class \code{labelled} from the \code{haven} package, and converts them to factor class.
 }
 \examples{
-# not run
-# haven::read_spss(filepath) \%>\% labelled_to_factor()
+
+tntpr::fake_county |>
+  haven::as_factor()
+
 }

From f47d871aeb68db1fe7a86c9aaa43ebc832d3f123 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 28 Nov 2023 12:25:04 -0500
Subject: [PATCH 19/30] Updated README

---
 README.Rmd | 39 ++++++++++++++++++++-------------------
 README.md  | 42 +++++++++++++++++++++---------------------
 2 files changed, 41 insertions(+), 40 deletions(-)

diff --git a/README.Rmd b/README.Rmd
index ac874e2..9b799ff 100644
--- a/README.Rmd
+++ b/README.Rmd
@@ -16,10 +16,10 @@ knitr::opts_chunk$set(
 <!-- [![Travis-CI Build
 Status](https://travis-ci.org/tntp/tntpr.svg?branch=master)](https://travis-ci.org/tntp/tntpr) 
 
-Removed above - doesn't seem to link to anything?-->
-
 # tntpr <img src="man/figures/logo.png" align="right" />
 
+Removed above - doesn't seem to link to anything?  -->
+
 About
 -----
 
@@ -33,33 +33,33 @@ Package summary
 
 Some of the highlights of the package include:
 
+-   TNTP brand colors and palettes with the `tntp_colors()` and 
+    `tntp_palette()` functions
+-   A TNTP ggplot2 theme using brand fonts (`tntp_style()`)
 -   TNTP-themed RMarkdown templates, for starting a new analysis with a
     shell that can already generate a TNTP-themed .docx report
--   TNTP-specific ggplot2 theme and color palette
 -   Functions for initializing a new repository or project folder with
     TNTP-standard directories and documentation
--   Survey analysis tools
+-   Survey analysis tools such as `factorize_df()`, `recode_to_binary()`,
+    and functions for dealing with check-all style questions
 -   Wrappers for quickly making typical TNTP-style charts (e.g., bar
     chart of means on variable 1 grouped by variable 2)
--   Education-specific data management functions (e.g., `date_to_SY()`
+-   Education-specific data management functions (e.g., `date_to_sy()`
     to convert continuous hire dates into school years using a specified
-    cutoff date), and a built-in fake student achievement dataset to
-    play with called `wisc`.
+    cutoff date)
+-   Built-in fake data sets to practice with, including student achievement 
+    data (`wisc`), teacher data (`fake_county`) and survey data 
+    (`teacher_survey`)
 
 `tntpr` is built to work with the tidyverse set of packages.
 
-Installing the package
-----------------------
-
-This package is not on CRAN, and probably will not ever be. You’ll need
-to install this package from its GitHub repository. You can add this to
-the top of your analysis script:
-
-## Install the `tntpr` package
-
-`tntpr` is not on CRAN, so you will have to install it directly from Github using `devtools`.
+Installing the `tntpr` package
+------------------------------
 
-If you do not have the `devtools` package installed, you will have to run the first line in the code below as well.
+`tntpr` is not currently on CRAN, so you’ll need to install this package 
+from its GitHub repository using `devtools`. If you do not have the 
+`devtools` package installed, you will have to run the first line in the code 
+below as well:
 
 ```{r eval=FALSE}
 # install.packages('devtools')
@@ -72,7 +72,8 @@ Once installed, you load it like any other package.
 library(tntpr)
 ```
 
-Once installed, you can update the package with `update_tntpr()`. 
+To update `tntpr`, you'll need to unload it (or start a fresh R session) and 
+then run the `install_github('tntp/tntpr')` command again.
 
 
 Feature Requests and Bug Reports
diff --git a/README.md b/README.md
index e1b2f74..c01e4e3 100644
--- a/README.md
+++ b/README.md
@@ -1,8 +1,9 @@
 
 <!-- README.md is generated from README.Rmd. Please edit that file -->
-
-[![Travis-CI Build
-Status](https://travis-ci.org/tntp/tntpr.svg?branch=master)](https://travis-ci.org/tntp/tntpr)
+<!-- [![Travis-CI Build
+Status](https://travis-ci.org/tntp/tntpr.svg?branch=master)](https://travis-ci.org/tntp/tntpr) 
+&#10;# tntpr <img src="man/figures/logo.png" align="right" />
+&#10;Removed above - doesn't seem to link to anything?  -->
 
 ## About
 
@@ -15,34 +16,32 @@ can be tailored to our exact use cases.
 
 Some of the highlights of the package include:
 
+- TNTP brand colors and palettes with the `tntp_colors()` and
+  `tntp_palette()` functions
+- A TNTP ggplot2 theme using brand fonts (`tntp_style()`)
 - TNTP-themed RMarkdown templates, for starting a new analysis with a
   shell that can already generate a TNTP-themed .docx report
-- TNTP-specific ggplot2 theme and color palette
 - Functions for initializing a new repository or project folder with
   TNTP-standard directories and documentation
-- Survey analysis tools
+- Survey analysis tools such as `factorize_df()`, `recode_to_binary()`,
+  and functions for dealing with check-all style questions
 - Wrappers for quickly making typical TNTP-style charts (e.g., bar chart
   of means on variable 1 grouped by variable 2)
-- Education-specific data management functions (e.g., `date_to_SY()` to
+- Education-specific data management functions (e.g., `date_to_sy()` to
   convert continuous hire dates into school years using a specified
-  cutoff date), and a built-in fake student achievement dataset to play
-  with called `wisc`.
+  cutoff date)
+- Built-in fake data sets to practice with, including student
+  achievement data (`wisc`), teacher data (`fake_county`) and survey
+  data (`teacher_survey`)
 
 `tntpr` is built to work with the tidyverse set of packages.
 
-## Installing the package
-
-This package is not on CRAN, and probably will not ever be. You’ll need
-to install this package from its GitHub repository. You can add this to
-the top of your analysis script:
-
-## Install the `tntpr` package
-
-`tntpr` is not on CRAN, so you will have to install it directly from
-Github using `devtools`.
+## Installing the `tntpr` package
 
-If you do not have the `devtools` package installed, you will have to
-run the first line in the code below as well.
+`tntpr` is not currently on CRAN, so you’ll need to install this package
+from its GitHub repository using `devtools`. If you do not have the
+`devtools` package installed, you will have to run the first line in the
+code below as well:
 
 ``` r
 # install.packages('devtools')
@@ -55,7 +54,8 @@ Once installed, you load it like any other package.
 library(tntpr)
 ```
 
-Once installed, you can update the package with `update_tntpr()`.
+To update `tntpr`, you’ll need to unload it (or start a fresh R session)
+and then run the `install_github('tntp/tntpr')` command again.
 
 ## Feature Requests and Bug Reports
 

From 886bec30673b48f94dfb7bd80074c6947ff48d65 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Thu, 7 Dec 2023 12:27:57 -0500
Subject: [PATCH 20/30] Changed update_case() to standardize_case()

---
 R/factorize.R                               | 4 ++--
 man/{update_case.Rd => standardize_case.Rd} | 6 +++---
 tests/testthat/test-factorize.R             | 6 +++---
 3 files changed, 8 insertions(+), 8 deletions(-)
 rename man/{update_case.Rd => standardize_case.Rd} (86%)

diff --git a/R/factorize.R b/R/factorize.R
index 02b0b1e..6a478d7 100644
--- a/R/factorize.R
+++ b/R/factorize.R
@@ -28,7 +28,7 @@ prop_matching <- function(vec, valid_strings, ignore.case = FALSE) {
 #'
 #' @return a character vector the same length as vec
 #'
-update_case <- function(vec, new_case) {
+standardize_case <- function(vec, new_case) {
 
   names(new_case) <- tolower(new_case)
   vec_l <- tolower(vec)
@@ -77,7 +77,7 @@ factorize_df <- function(dat, lvls, ignore.case = NULL) {
     # Update capitalization if ignoring case
     dat_out <- dat_out |>
       dplyr::mutate(dplyr::across(tidyselect::all_of(transform_cols),
-                                  ~update_case(., lvls)))
+                                  ~standardize_case(., lvls)))
   }
 
   dat_out <- dat_out |>
diff --git a/man/update_case.Rd b/man/standardize_case.Rd
similarity index 86%
rename from man/update_case.Rd
rename to man/standardize_case.Rd
index 5150948..7f98e48 100644
--- a/man/update_case.Rd
+++ b/man/standardize_case.Rd
@@ -1,10 +1,10 @@
 % Generated by roxygen2: do not edit by hand
 % Please edit documentation in R/factorize.R
-\name{update_case}
-\alias{update_case}
+\name{standardize_case}
+\alias{standardize_case}
 \title{Update case of a character vector}
 \usage{
-update_case(vec, new_case)
+standardize_case(vec, new_case)
 }
 \arguments{
 \item{vec}{The character vector you want to update}
diff --git a/tests/testthat/test-factorize.R b/tests/testthat/test-factorize.R
index aae0b0f..c2dd425 100644
--- a/tests/testthat/test-factorize.R
+++ b/tests/testthat/test-factorize.R
@@ -20,10 +20,10 @@ test_that("prop_matching works as expected", {
   expect_equal(prop_matching(c, valid), 0.75)
 })
 
-test_that("update_case works as expected", {
+test_that("standardize_case works as expected", {
   a <- c("yes", "no", "Yes", "Yess", "NO")
-  expect_equal(update_case(a, "Yes"), c("Yes", "no", "Yes", "Yess", "NO"))
-  expect_equal(update_case(a, c("YES", "NO")), c("YES", "NO", "YES", "Yess", "NO"))
+  expect_equal(standardize_case(a, "Yes"), c("Yes", "no", "Yes", "Yess", "NO"))
+  expect_equal(standardize_case(a, c("YES", "NO")), c("YES", "NO", "YES", "Yess", "NO"))
 })
 
 test_that("ignore.case works", {

From 3913affc8d36829803a14dd12e68345411db2b34 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Fri, 8 Dec 2023 18:25:16 -0500
Subject: [PATCH 21/30] Initial Qualtrics Cookbook draft

---
 vignettes/qr-question_code.PNG     | Bin 0 -> 5656 bytes
 vignettes/qr-recode_values.png     | Bin 0 -> 2390 bytes
 vignettes/qr-survey_id.png         | Bin 0 -> 3192 bytes
 vignettes/qualtrics-r-cookbook.Rmd | 182 +++++++++++++++++++++++++++++
 4 files changed, 182 insertions(+)
 create mode 100644 vignettes/qr-question_code.PNG
 create mode 100644 vignettes/qr-recode_values.png
 create mode 100644 vignettes/qr-survey_id.png
 create mode 100644 vignettes/qualtrics-r-cookbook.Rmd

diff --git a/vignettes/qr-question_code.PNG b/vignettes/qr-question_code.PNG
new file mode 100644
index 0000000000000000000000000000000000000000..e97573a87be046f7680342cb6e2ba10c62b1c573
GIT binary patch
literal 5656
zcmdT|cTiL7w%^K;a1IzbQi2+37TQ6KfDmbdAgEM9subY}1Oz0Mgc>x0APOQabWjLI
z%0W635Cx*4DNRL4JYc|3git~axf}4#+&6dT&Yk!EdV3~i@4eRgR{Pdk-!I10SbzU-
zhkpYAVE-ip-Kzk=1p)up@o<CR`oWTg;LjevtNJ=Xc@LZc-u&XGZKMqVmGQirH}-+|
zzuq>m@dE(po9)jYvQN>U03cL$Nmttf>o7aY@f!)qg3NEMg*R=OeCOlqN}7%yJAJGx
zYc|VVM5t%V7c1}BfgTakKL1?1o-dO$B{YRP8oRf^v{JA%f+$_U%3!U!Hl$olS3+fQ
zAC%Um)m30viQzA9^>v@k_%nm-GEw|aDrdAeq;sZgx*>->v!%Be0E$eZ01#n_1l2o3
z2fyAXaRGq1`G5T|V*x!ssl~C;-M(y-EIk_G19nBx+gFz%@pV2$o1~YtSg6Imv`dj0
zT!lq;d(^{|4hZuO`?*Vdjg00rb27#mtzP6El0VZ0s<2((5E&m+qFgg8K|+3rI$~AZ
z;rt&HcgmX+HXE&W=!j~ALF%rHgbyy3S{YAH-#|*!Q1IgmpUMTEL2%DjNK1du&*vWi
zqm`LOXmt^ePiw+5HC>mTy%l;F9v!ZOC(V_rzWSj8(T{C~h{=NSIo<DkGX8UuG!LRm
z#g6~*DTrA3>J4v6-(hFYhlCZSJpiDnu)AJ-nuhC&j2win7Nd4lRMc23bY9zb<8|dG
zm3TmN^{+-LP}q^ShoV)%T{DQ6WInCWcjpt(rp>;`e<-Dsi_Hts0yc}!vum|HO$D>Z
zD%-Uj)SKUK%(ZBxuTVoO3S`8dtA>}J7_um>80D1h0SKZ9m5x$T#gMM#c0(IAn#rH9
z(WZPKe94Gc7X{X+e)=ULwH4Uw%a^tJX7G6Yv!InxjQ(Pe+T6FKI-`@z-j14<X2Kp<
z?xF$U{4-}uQ2PnWQ+S)YO*T`i&lDMbBf#Cg$QDX1|M9tbOicD*yj;`*_7)-+#<lq_
zQA)p`Mx#ARiZ_F+4Dox$D7Ozk2-pjpKei*tl|qo}ErBQb2+BCz(E3Qx_U#Zqe2wp$
z{YzG%31`}*&oON53qyf3VW;>+HLz4-=%A-;k7S$e9w7Jk8oIda+Ax~`P;WgwSJjgr
zBZBuZgEnu>G?+mjC~_kna+V8L29ADmldMd!HZPSQDuM&R`y#?%Ec$(yT`U+NrU$Fx
zDo88Aw9LlVXhtoZpkXCRjU3Y{1|uz@t<q)xPfiifeL%!TL3%D$ijtIqudni}gty5p
zFtOa++!tw=t2tj2KH%EY4B%=%O?0*^6#{_6W)*PVllD-GntsnRn!lop9NCI^s6WOO
znq%g~Y|C#CcJ`{g2yUE+i^{f8$>jlgi0?S)+podp$$0D^2yBk3ud}~MJlR_9FB6RO
zE`5i!8~`Xit%bKev`NAb-!(P4Ko@r)#r4v)QYqS@_r5d7$!=cA=$iJ!$y`A0sQO~8
zBeAR{w0!+Yf3Y-VJEO!DiRjzhdPvp4nNOwikjk^53hw%})uB<;O|r%yjbKdC78t8+
z3t8V-Uw7S=<x&O!Ro#hNI9c{m!u~;8M{wbpmZlAFHcS<_F#im-Xl`PKb19L57`f-e
z;opy@rzFJ}gD#(Se$ye<M`N?c21ZBCN71hLY2j)#*KvW25<7wixXuF;S&#c@e$dB+
zM-CzE_`#fuOK^?!@YQExg?2tIijx~!n`WA^rj{W`h?ZYc@yGPz^7kJ(n;$YqQVH<)
zHza(LVm<njxgWH_$wTAC4Hr$hzvdOK3T~>%_pU8zT~E^tS$;B5GaEVOP;G0MiWgaM
z`ATc>bGtzM1-{YN?3+;~!^5<8p8qjBn*}D-kg(^&n!P}mYcHon4u%goH)q1dRp|I>
zW_J3@N1DIisb3*bc&T?m@^B-(%_c&GB_-!AQ0J8bZjaN-&VidV%8rIA;q(-Bt)T}m
z=G$=&>6Rmb`T@LU14DH29zY4*k!v|}()&y4rDS|+UBQNr%@fT)rXHhd5tbis&mQ#W
z^!q$IG=E@;Ram}!6vZURhMnu<Qdo}P3Zuow6NRjBvi7&bH`xM=2S<kTjVc~(mW3K_
z$4>=93suZf#-bNfrc&aAXP8DoIf-0cgYwmvL96TIa&6rFzC?AlHtY94iG}4y)|Hvq
zu~@{g4Vr=7)?|70UoX7gt*czT&nd6D(ibGwf-DRFyNsggQ{eWI`uJ3R{V}iLmkTSL
zFDaJc-j^DK*wpF}&fBnC^`5@x<{I_;y|;Bx^gZcBuWQy=KjEg(vfv@QiTN>{g{zpv
zsA1?~4xI6~?QfYUP)rS;8kn3PD+zy6$r4JveBe69tnn7Tb}6{#7r~$~Pq)UI&5Zs=
zHZue_RU#ObY-f@qqxzmCA2z#bQW)Z(9+rU!YF5m`gu4x2U2E8}o-jN1<|-PAWvy*)
zB>ecHzUmX?>bXVAR(;OD0oNGLz~Nk{s~X@BSL}KE|0W+`D}_yz^n&Rnwh>skT0eN=
zV>oiMjM96v(g%!<n%#C57r~oqW#o|@Kh$#1xi?{Rov7t&u!0j>#bF_4${Q*L(>*N`
zWzU-f+zqLsNWa^9lX2J2QOFihAR=(7U^<0}YuF;HD-IooAEw}1ygxr0lvkYVR-sXD
z78p#jpO@e+F~nN@XTP&n8~8Vpd<0eyM|M|Dav0^jjc|NNOokQk%5rV#Zw;|820JnC
z`s<P3&TBQY>H2avkCh|qrNd@w3;TckNSLL&$U=bgYQZRS&t{A+CvbW;h$z$6TUS~y
zk85INlUgdgvw|utXun<imVu#}v#(HKR<JMQlR7iz%|;{STlsLM8)xWF<^j=S8C%tV
z$DO0+Zj^;ue!W`|PlS2;d>qYT&CVIU#Av2kI*`P>IV*+z%@o!GV!OWBdr=n*MbmRu
zKPL{#%V=!1^)A%Pn{b{s-eg%Xk8+H8<sv86Gg7ST9<Gj-YcNWB72d_<bUM@OjYa}%
zuR_z`n<7Q#yz~%Dm^q`B(5a{XY!^~N%W|Ro(Q!fia1u4pLX!yYt?H_Zkr$Gq%w-=-
z+?BOSdfkXE`w=4-u9TODHeLJDn9<?zcypcCv+s4JXJ2Cg6Q%2Dbb!wL<QThHPBYK_
zhTAZ@=#yo4-sOaPudpduSX5ok6**b@*E^}85no4qr)M$5=bD_zO%6RLO%p6jhvgv2
z63wh<hASFbmZ4|Lk634Vhi@*mzf~x&5X75MlSPMNV%KahhbA%djxs!X6)sziEME^s
z)RH#QwlJ}qwlar$Eq}YPMxg8g-uEQo(>@N-bLCrp@nY;pG23JNKV~avHdde6v{Fzi
z?|!m8xR*Ix>)*RSwtur}G&Oe*FiGUp&#A3_c^n(Gz{^>p4+L>ACAgdCssoUp{<?8t
z7_4B+bsg<qW3}Ds7RaJR*hgBjclgXwYHpU%&opFhXw7uO#2s<{-6+O>$9G!f)O<u3
zShwIv^zocM(KlKW6nQF5W{%Xwd^tOPtFzUDxLZmvFIQ%|-FPL<gb5B__D~(ZHD6(I
z?ydSbr>AY2m2;m3@%*$I7#`#3NZW27wbm{>{q6&c?sQTboN6;;!L8lqf=b;f>k${F
zcbY<%?)G%p6NP?%ueG(+f8pCZ|CvvfHg-_33GOyE9i+RC88l8zOVhJcyVM9AE1k}4
zOL}z_ww|r(E6E;|YR<aPe4`=N!8fItV0{4`a|AtOmBH)>lrDqJ>e*ugv0H&_>*|kj
zzI5Ue>%$h}&AR`|xTBuYHErqtV<GiytX{a2lek99c+H0@NR`CD&I!`=++UeSofj@#
zSW8~RI&%CJNa>DcIq#nEljD@zY@Lm^jXp+$?*{;Fa9t*WvQL6KE|$YDC?*lS^!>v?
ze}7{C=xCMzjdFc+<Q8ScYy=0Fi#r5zC&g+r#RS3eAP=r2A!^<vDV77ZxSk338IM_6
zBS(nl2wDh64ll7-XOn|hgvik@?TGPDl~LALN@c*_1lAY8JqdIn_IiRy^LS<Z^Ci7Y
z(mlroWAaEsGGfnEy-V{{UHCoahJFQrN2btp)9_n}doZ`($9y{?9FB|nB{)YY_+%JP
zjW&mtss{SjieKG2@RO83-V2LWEp)gfeK7uIGB`)p3JOlgg3a*!vHvvJ+vd+PZ=$G8
zK`x4%K7YE^x&99Out5?SJeDcc_RoCy_3V^Ul5Cl+eK$$2PdU||5c~S6S}pO-o53up
zyty<XM&DW%%48V>00dczcI?9>{7saLNx+30SaH(A`xpK<1n<>USg4%!{uT~yR)Cm|
zelIzmf}gRNT6fLVwoa&pTBt<+-CP~ky-@xANkW~3ymh_0#_E?bd4n+2cwc&*O!5_-
zq&TwL#a_ef*w4zv<4hG<{k=d$hcra~j4!h2(_mV!sQ<0!adY^PtCO!OuW;{b7_Ei1
zg|jWA*=H-7i7$F12g8gD-h{|~`9XStZt3iAq|oX(tVc?H^2P-kEAp2YCmho(H=P#W
zdf`lE4kd3mRtLx51t;bUNqAwT3-bGCLdvzMm7DQay?lIP#z$J3WxW(~z`zNQ)Hf`c
z2V5c53C)I_w%4?kG*)YpVA*G%%_;H*2g6^tRb-$~$7!rwqqO!t5=g;Y4LM}jc~y{J
zt<87%d#%m<0sw~Rk?skul-5_zGx|#^9MpolTitt1q3Ao(bB>9MLi_;013EUd7@j#i
zWVW^uS?p)Eyh3`upuCs2eA@6x4(`NJO~hkvSw`c_GhbCKpbw_`HPbcjXMsELYZqui
zT0PvN;sk+~P-`{GQvXU`fekb%yKj)(PC<_O$d#;pI|jz?I6YUdLmu*m3)MTEU?O45
z`o^f+_=di{hDUX&i17s$#I0@9!;be}={yTB_bxiugcxn;C=>z<qzK4+F={p4$G~AU
zAw`JxI22<wC6{$V1nUuWb0d<GK6p$_uaR9GfLeR4hcXLoLN&nEZAi45WOnv&I_q22
zzQOo2S#{#}A+(NxYYkx^-(ZMxa_wWU+Yb;mhQY(v{@qlx;NC#kJQlXElPo*JcCLD&
z`i!4uWV*h$Isgo<r4^-Z^IBoAAYb#7p;0VqEAC!UYN>%;?8}nyUx#aWVGrTcPxMf0
z>9a1s@qkX({a>GZ|N9g2zfpqegq?R9uJN=Qu5`H%9+cl^8gywQxIQ$4af+5|zrzJt
z7>57^IcHYPAp>o9M~XJDuBRm*5YZs*noEduHvu2Cp_IXU${z#UO!M~uVB$=b>Bd#4
z?JI%30HL!>XZ8xxeUAwb;B-onw?=`UyH8yLWa#?;!w|yC?+MCE<|y;lDE?D@x<7))
zHIG#Qua1!V1vrg)D9_#cFBV0`3*()HJ+>W&)d7IX=3(cr>3F|8==XcG`GHprUYpMR
zyPmmY|1ywHh61;Lq}7YG@d;M(&t5{h-@!u;5V;^wX&&HJ=D{kHuJZ`q580rDW2E$|
zCsfN$N=izefgP-hcYaU(PxbWwgsA*mzJLYu-vAjR2_8C!1P6A&^%-HXkOb#DaKOrE
z9{_Z5Bc7RfBCTJRRiIxTL%Dw^O@YV0h|l7#ON2oe*PIme{M)$Z>Io|i2JXPoUK}Xg
z)uC$w@r=9;FkGQ%XQoT1;$e<j*(T=d3w<93aA<K3*dqx@L?Zc?sA6!}6rw7%Q@d-)
z97GIo9JZ3GDuJ6@7V@YH(xRCzN~I=l-Og3n-?V5<b!!5p1LktBbGrb{PqbzSJt6#E
zm=D)|faWihFwQ!c92FJSr<RNtn?h!bh8L@dsh`5GR+QcE!(?kd-dZeXGq$>MhAZsN
zfZw+-l$rBH+-Eh{c|yC($zBDj)vj^zpEX=p3G`UBsoLB}MO&y&&?E>i6rLD6&t|h3
zpDJA#Diy42hc9O~et!qkY<nun{9FP?R8q1pUC<BH^%W6IHWaN2>iUj&PVN$|+R&vt
zse{$pVB|(-Tr^i3BL=Ol8ocCgjKN^ep}*~5T+xQ+&fE$UOf(`ojZ{ws0S)JJh2HgX
zuwg_Kf5%+U)QFBfG8Sg&J3mg2pNw2uUM`?gsf{wif9x!rXhJ%qc2E)9HTKiHz7puJ
zABiNY_(MCWq#jbbN3>0EfBT_(s#vpw51yJD|6#F<eVwdX3`E?A`33oQ<ks^CHPs2~
zbtn?y_ZA*KNHNRQkp4~Q`d9uK*Mo(p9_$lB1})_8Xlv-}G5KTLX9^RGPepW3h75@-
zSwKB_bux+4ASxsIv>-`<S8&_I3B^XUBS)*SzO}hnIWsRrbduX<jG;ADl8)w=p*jmf
z6fWx^D^<5ie@7X4OwKu<ia$gGNgLn;Ju3oh21uS7jA@0qpv>?kGZ7D%+>W{CsZV(X
zWqK#v%=vUi(fl5BMXIl`C-Mw}@^)UIsVP>$e@wY+Fsn|Bj_TCT5B<w|5B;BTqM_GR
z_ZZ!VME!#n?c1qcgej!sg^TNc>Hxl+Saw~#Xk-o5A*m@`^+D{4Bo(VXhowDKOu_4r
zxCV(-9ldP_{^?=vBV1vm2x3TiRPEhIfdw{+vXGn0!V){2iiySV{gEOjq{s)`zI!{6
dA8>UYSN6d9Yk1!JQ!uZAOM1q-<vLDx{{a%SWcUC8

literal 0
HcmV?d00001

diff --git a/vignettes/qr-recode_values.png b/vignettes/qr-recode_values.png
new file mode 100644
index 0000000000000000000000000000000000000000..aed19a48cd6370b0780dc5b1b1903841003841dd
GIT binary patch
literal 2390
zcmcgu`9Bj510ISo*Rn{ij7(!mLM+P6RhgsQXC;m1O9_)?^wOBCd#;H^%Q2LpNN(yg
z_D&4bCX}3M7+T@={txfx{oy(Pfamk1yJ8&VWDd#z0022BN3=TtAa;1yBY~2;Y{e|p
z-xaZFcLx-JKA=9g8}?kYakc>f>T*DTFYVpU(ov2+(Exya=YJvA8%YZR0DuclXq$`p
zz$LE2`Nuyrq<$HxC&}B%lYym!)cPy%2cbRT5$1kABtP|rcVqo0Kl=BW`DoKF$(f#b
zJruzVZ#%8Vs2nyuI>nsnx5yiZ_tYOQ_mHJYz41?$a5)eag<lqvO5kq<3Toe_myNvq
zxbdh(!2k1pqji}Y7gRhEt#Sf-D{kYEp58$;x|k8X<pPBsIrf<72$ww!eJEp_PJGef
z3WdJ<A65HmU2m?*m-JiEmU)+#Rl9_(+KG{+x2QM$5YW}Fh7{kb3Tz5vq*6=C+w{-%
zy7CIY2~Z|$Dj!{Zu?_WV)>}<;Cq}~84#*oCv?9P7%!5fZUVkL()|3iNL&V<<vC0Gd
zVO_X0K65g}GQl`0&gADZ4h;c{fyz=c!<r^l?K%9)*$XY)hADHcaMpK3QMs1zhPh;#
z;L`-XWYcI#WHNp1h-^8{al%XoY%xJXJ)M>ew-j1}onXNwkDp?@+LuogdKNTK?Yxs?
zWt<T;;{S4PzwvA?$O<Y*`vRM;oz@x=4DOKKc+FtqsWsKul66O`<7R(+TQa@W+!i?3
z;R&F#Nj@Y9V{7~l_^kuI-D1(;h?ZFiwlZibH?dxFt<(2vH+-w55{_#+{`}bq+u9;!
zAu1?w+tZ+eyFBFi&ecONFjC;+W)!Xvfc|8Sga}4|-_<c|T|~Nko3Vrx%?;)>2dJH0
zU2vT{?c6eYC~$;uFi|CTe3tAkv&AY4d@1(Uu65xBghO4sb-&4)-36LO#myAzFaG76
zFATd?(i1C@(24}PuqdTo$@FdQD*nj7t~S%N$HM)1KzZ>`+r!B#jmR}>@5j%n71N2e
zUG`tuc%ifrt{3M$7SffCh@Rw9GBrXKJb%9a%|*t6G8*D0&xVUz>lcv*N?$of#7v=T
zXu=azte4i~ZWGrJCK_}^DQ7hOi3rAzFISzQN!~Oo>tLAdPxuiZ_3NSMpuTBV-)1vS
zWpf@zIcT45iOIR!Msqau!F8o>6xGhLf}13URg(YqDh02djQTpHs9f!oR%s|#6c4V|
zi0Bk+zPpIWPA{bj@_a6z52G0o#WD4z^_VP8DLCIfmxB1&h&yV%*{-|he{+(H1u8ig
z64C}?V2G}JSfL>-KhXpjV}NTf_te=IrKpBhbEVH^sf?+HzHqn?C~<QP`ln-c{ciR9
zXi9X6e|=&%tGg4TDSib9T|pBK)0G*dEj%JtW`#nLp^D58AbdNoUZR21Jq$w4my5L8
zI$%?|76DAay)0tVq8Nn5J_>Jg-Qq_GYcO^gnwm$JNc(Q)D)a$wT!A#)SVJVhLB*L>
z7LtejzkDXWsk8Lh1C%|c*F80cH&WjbXdpGY_--=CO4*=Ccfiz2+5(iE0h-5sB+L@Q
z7mF4MjA+I3p%C17uI%cM8J=x1Of1o_sA}1+UCU4K<UW*v*ib;6jCt!)BVPB&*7bL1
zNZ}prtIVg?CgS`_@He9@TmFR`BKFS2EUIxcC@BUD%t$IsIb1i@StUS$t9|F%EkAsn
zN4>>X(}_pjZjfTb%iR=e>*{?`qvU*JRN)B1*H*S;OySNEj9f-R=CQOn1>w80itn75
z)$!bM3IE!O$%5Cv_EdQT)U9g<Iw0UXGMagjD**|k>G?X(>g*#cp{oUT+tywJhH=a~
zG-8bs{vh`Dp6t*ZGOSzYNB5o((isGNKcX0`WbR9^OQgEk?T!ZB*=D^!YjQGd5{hSX
z*K_eL>vC#U+07r`4>Mj^y+qbC%Dg;v=UIGe0f;xF3o+7Y7j5;|W;Li^Hd7RX(9bC$
z(y{G-8#>}|_tnE2xq7GLD#EnpiHE?a+mB_Wk35lQu$o_~WV6dCu4Fw@8?#VYx1jkc
zlbs{Dc1EN#Wk2jgZkF(f(e6_=F?h0yQ#(GO_KVsd?pH?9k&eVx&+%kCml{LMd2cXk
zpNI5^c(E?@(h#r{>f))_oPi#;J6rFcj1+-})Tf2|XZxIKgw%%zkGf4|MULgB9I?OG
zpz-J9Ju*boFgz{@mJd<ReAY@KJdDJQ6u;GyBtPrE!U{IZ!0^xCf7R!UZA(`2a^oFE
z-SAGH_LsQ1Q3>iJgxTn>+z!zH{YV0nBVP77SpvD>Hum$q2a+v))tlM$Zc+cV8G+et
z?08@LoTgmz_bQ+wTL%8~?kGRP!RO6#1=o@dWzQGIJRhu(98oOf=;6NbzNwHK^OUj*
zqs-;CAPCOA3-!wGW%w>ohnyo>eZF}ou7*0*kmv4P3BojrkhRCUdb7WN9gm&B583^l
zmS}AQ*Bi$OOIprmdTkBc=QMrbJ!1$ucxi)0a;+a=2&QeWBK>_PwqtJ=kjJwkrn4vJ
ziuVb7AMqc6b@RKV`f^0mA6;z~%bmfWNz&A9{A<-DO7V%<^-B@xo<If8ex`kc4^wt1
zaw5C&`8Ot@qD#uyltV18&PyIva1dpCeaO1aOYemCs+ZXGZLg@*E+I{V-KlrZ_Y>5O
z6XN6JQ)<d78?z4HI|GVUQ1hX^+lIz|@I3YVmDh*I_=>n|HKkpp&j%&QcH{Z0{?HZW
zFJa~1uDlu2UMdcR(4FlB;#=cqH%wbRXWDAG-B!c}dLXW&)BrO|aq4bJwbzf4^A;k_
zD=u9A_wUcTU)^=gTH<Y+L+96kivgM$uM_X}8U2AOSNyneZ+;_y=E{1R)3`Zqq8J&~
ze*05)^{|X#sSvUg%*8ieJxt8gW_QVW>x02O5`htkMsK8)pwaG^^uZ4<9yp8E-JiA(
h?3DU{s?dZT@tX#>PA!W4*53U>04F;PnvM!i`43IIeCYrH

literal 0
HcmV?d00001

diff --git a/vignettes/qr-survey_id.png b/vignettes/qr-survey_id.png
new file mode 100644
index 0000000000000000000000000000000000000000..4f5e90c213f81db88f1150b3e6140d1ea65e4454
GIT binary patch
literal 3192
zcmai%c{CJm7snCBU`UoMk&Lp9vem@Q*c-CM82eHh*^+%3g~}2$WF6Ue*^(u@k;yV9
zlL$>H+4r$cC|Q4g|GwwE@B7DdpXZ+MJ>PSlbMCq4bFn7I2u^?yfPsO5Q(sR9$-uz4
zfAW@OWjcwJiV@F~i_s5>&|;|S7g;_@m|ZlDG#MCb6W9+NSx#~`Z#`>21_of)zlV|R
zRp!LNz`?1nqlv;etYsQ`*dzGJMkdc$W(@RDa)4N;Q|5q*NUMvWK#vMm@#oy^r~pQS
zyh+MM{>l$Y$XaP-UA^x7&NnD=o2ctL;OmmSu@t0`qqpu%u_w~j*zSkE$gEK5LiSB1
zKlu9ipLM@A0b<+Mu&Mt*Uxt#)df)yeE$v4AG9-SM<8;+-{469QT(*4{(w{$t+knI?
zNj1-?ok)NaX_(A$A=jUVh}|FYv!h=qO;Avs`F556PxazSjj<Tozx(Z7x%ImPKBS;*
zc+XOdEzxS6m^*u76B;*owkfQ(`6-OdH|eu?zDUCJ@V?LSV`DYa@fKyZmQ?<<(n0)B
z3#~5U^FZQZ*fiLk*}=+6UGY7D|FEPlK@<iV`V`d_i9jqCMHt3!H$IE+YXFM4e%5vQ
zAt)y5o_N9CmFJs5;0Qe6iD$tcFIU<g^R31M(+}eVXIQMWaYi4$`?zLU{jjqSw$kGm
z?HU%&+KPSm+T)7FE2-Y;v0Ccqa<-rQo^eV=j<76Y^p&z4>&#qEM#z&W2sBO-B0lC5
z9Gg`s@X{;a{_41XPd}+7E#I?!1wc#1O_Jyfr$EN$LG@+_BNGl2PmY!c^3+=D>BNkN
z9m2rD{HGKb;^qnwzTMP&CmY@rCi`Ly)&Sj(CjEgna37X@74;i7{iCqVpA}u|CLh%`
zJ2)1W&sux~N9=kyX3;1Yt=3H_D_xiJQji4he;4P$mr1yulbsflG>o-G|8=&X&?g}z
zjYi(VP`NsHGo^0D=`Onjb9RDJN4p`$KYFhDWt&d+ZEkW4UjF93@xq2lSe;rn-%UZK
zORZk~LY)xcG6`ZDo3_mn>pv2XJVK<&!~NHxtcSY|)cw1`v!Pe}#{=Af4r}65ojaUg
z_Fxj0zoCPee!VrM5&60_yx6p^Lr!{a%`yc4<m1oE#J59vxU0Y2g1%4@sJiz!vGqQ(
zhR*Hkt$Sq_zc`z2B?Eer)Jk@3tR6k8DWniu4o>MhWVst8;EYRLqW5p<Z`T#4WJo6V
zmS$dW!M;rR(=Q8e`?-;W*_pk1d~WXOM@o9Y@iK`kuRCoo!o@3m|IP7%K>d*fd0}FI
zDa%pEZz)~7MMq9`|HDU64@isQZ9h;8a}R(LyR;b_p71@5^|9Xl7@odIe>tJgkou<3
zX1TokC_oLCS1Sb!^=wX^w_$JEY`&&oK=CwSoxLXg)<Qr$T>H{*_EemkS#@P3!lYc<
zQs&aVA<CV|u^CKw*_~i+jK9CK&T--EZWQzM15o{vM+YA{wg4iULyolGdbWyflL@y}
zQj{rO=)0@}*6Yz!#B&wpj@6G#rOKu6+MsRRmcB9{2@`(F2ENi#Q3G{6%w#{7tW+h}
zjDB1j1moSeQHGR`%P)*zO>+^6H2g4$8i4tZ-H7ijem%C;RphRmd_AdZK8gEfh-l~8
z7#JOe?Ycy+FW5RBhld4Y9adbvZN5I5PzP_o8V<%>CR+cv9mpKp4uC`V=q-opc?8-S
zCGobKD7mNnz9b(7Y$qACQ-~P3<Qm2!W;7m^j=x+!1WC@7N-5Jv65c&V;#U=K>!QsL
z?B1l#DU$h4muoSr@{N?<=9#d2*ld#VvFh}TIA}HN@Kz^}6OK+-4o@_D6yLNd<J7+u
z<53`?I-0$hrgZ6ko{X(WpgE@b@3IZcyvS%~9f_5%T!iKKQkPIQHDkz(WGM2SuVfpa
z2u<qez>@{BErsFv&9sg9L6hzj=U!SxuftFf&(&7rl|I!^$wu$`?_wi`P-wkQ#w=k2
zb4hbwYj6Xo9Rf-u*}$Xg*^J0@e>GWg9BvPJ^G2*x4o9u@aRZS%jZd5-rQqCqdUJun
zqD#Cw)tHLRFV=LTk8|)+g25*8m~dm_^htx65$$)6?pAjh97fTEgShU7l{I)z-jNTT
zdLkgzu2AT#foavg`ms_zdge1XnuEJ!gDo=FwEzveRe7`1?1Cz#Si^(ieuPYf3}>X<
z!q>;iL-=>5#ij+$c0k#=i1rm;or1uuXQ9-h<P~M#yb4>pC*fbEr5k8T!9t=gOrS<t
zE@U15Vg=iLVrHucG_kcf#x+M5?O0){tvvi`@1cq;u|C=2MeNJk<y}b*UXAxELKIx}
zW3(C?#Z#9t^Pt1qh}vi^F*m@{R~`3uVUZuWYD52fRPVJ~yc_&<*~UXbgn8S2z=n=e
zDU6sQ*3<xPj!6P(lgD%B+<U^bjn(7Ne3<g5%R4HV@-uJG6sQOPUPuEvv@X&FX46ZS
zsH_8WX5f!izyn@Dnw}#)(WD7y8iN!BoBjKDnO&O=A=Y~h1=m=m`uIYBO2ANqh910Q
zRE-q%=+rmZ3^jRR8R#QtU>ML0-3K27SHU#7uiSvXp7vKrdNwnx;d5U{N+n~qx7O`i
z(t9oYDBcz=ZD|z-PW*?Zm{3h)MSN<jtHm#?wn}Gn<xn3PoJ6;F4TgS$t!}DE&nm#D
z2j`e(I??IJ`t!Pea)`Dgx1c2>Mby29+VlJIdwICc?YgFxHQ#fLP^QyMb^HBc(<qgq
zoSEv$&JAx3+O&PH!wMJCf6Y%l>qpR>qJQYGsXl~QTg^s?U~||M!E53;^=-(T6ahKd
z&jJA_3l}X$4+UCNP_d$3dE6`cY3o!ZljYeP!p}x8#tcTtShEgucpARF(wiG6AYN$A
z`PCZIS1((0C(RwFBg1y_MTnYu0<T*|mcbnO8)Ijk8W6tyg~%AA5)IOlct|)4dy{TB
zkog{IugYr=D9;-0j>X?Xe5j`+dQgc~$%1UBZs066ZPC6w%~%!Rh=t^Jw3ViI>WsDo
zJfpearnZMkrqH@*_mQ%yMLVQX$ocuQg=KtcX_|GILy^61<NXFw&rF?oIt)=m`h_}s
z`Sec=P$%K0$OYHZUG<!{mPKr^NpN#}V<0V8B269RdOGq*DcWRQ>}FuV<f&@)U$bw#
z4|BZwLwDK@ASLYE?vXC9%K0PnUXJ(PxEJORit6^}D26oijCD%+Mc}R6GI(;$rRlls
zY>{|VzZgBb?VhN*i%R*fthYj~D_NHBbB8p6V=$g0C8ERa<<>FRoKzJ<weJpRJ9%Jj
zYO^9Zu<i~OTrzwSXcXwH!8Gt826`sMp94ZO4LFi>EP;N*Cw{NJsXFRG1Kb=E>A>dp
ziGN`a&tEMFDa+$1OukLk9%FL%zams&E*jNZeqxILtFK`%Y_R-Vv~^0AhE7*jN9*V#
z`R9vuTZ*BtDdvPqKsEJT_|qKh455}+_A4p+L64~ww!)5&+bf_M+%|du3kzTqM>dw;
zb)gt>#H4iJLj%u6S70iH294=?k00%%xmb8s61CT51xCVPffrWChGnN5vaO#kj0p=2
z%syQ_I{Zr=yh1Nk`+3p*G+y9U30&W;+%aIgh^0GTql{Cylh1BWs@S*mdA^}(HU7LC
zm!v_3%waoAFD`10f}LwjKh^t4@Rgd5RIy$_zDm4bR;It&9p8Hx$eA~*3ZQDqc_l|@
zwrnfVd<WGtL&LDJgc(8AHGXh1iR0#aii%R!;HS=8x>CG*yuW|NDnzE>h*jcF-!RDM
zn-a<^06Mi5Vv*`lWdQ6>T1||p|I3s8Shl*CZx$qsK4;x#Qqy@S2${C4t=a2&KDV?-
z{-6~KoE>{9=luNonv-2J=tWdCpr8V$n8VF(IiQ6}8W~82Qk>Y61Vy!wqWQOM!B-J@
zfXV(R7Qq<_#yJN#*NjQ8S!$2@FTUji^(F#)z_##3FT?yF%qr(oSEZZ$)^lr(_P@eX
z&(;0-67)j(L6fz~!O$OZPp4>6f)RP&*fL~ycg6cW5iI6nd64sf@VngBWW#G1Q7gXC
zZza9#N)=eVkmziA@Vl|;FfU21H|HpxXx2P4>C;Vo8MLz>$|oU7=(eM)*_;sUu-CsN
td@^tTKhVbi7j*s~RQ;dQc@NJcF=LF1>wH9I@yWKpps#DJQ>Aq;{2$ayHd+7x

literal 0
HcmV?d00001

diff --git a/vignettes/qualtrics-r-cookbook.Rmd b/vignettes/qualtrics-r-cookbook.Rmd
new file mode 100644
index 0000000..64f7416
--- /dev/null
+++ b/vignettes/qualtrics-r-cookbook.Rmd
@@ -0,0 +1,182 @@
+---
+title: "TNTP Qualtrics/R Cookbook"
+output: html_document
+vignette: >
+  %\VignetteIndexEntry{Vignette Title}
+  %\VignetteEngine{knitr::rmarkdown}
+  %\VignetteEncoding{UTF-8}
+---
+
+```{r, include = FALSE}
+knitr::opts_chunk$set(
+  collapse = TRUE,
+  fig_caption = FALSE,
+  comment = "#>"
+)
+```
+## Introduction
+
+This vignette is designed to showcase best practices for setting up, pulling, and processing Qualtrics data in R. There are *many* different ways to accomplish these tasks, but we will lay out a recommended workflow that we belive to be the simplest and most flexible. This document will go through the following big ideas:
+
+1.  **Setup:** Installing the necessary packages
+2.  **Building Surveys:** Best practices in Qualtrics for creating surveys in a way that will help you analyze efficiently
+3.  **Qualtrics Authentication: ** How to get an API token from Qualtrics and safely store it in R.
+4.  **Getting Data:** How to use the `qualtRics` package to pull survey data.
+5.  **Analysis:** Some common methods of analysis, including helpful functions from `tntpr`
+6.  **Advanced Tools:** A brief overview of the `QualtricsInR` and `httr2` packages and how they can be used to automate even more in Qualtrics.
+
+## Setup
+
+The main package you'll be using for interacting with Qualtrics is named `qualtRics` (get it?). We'll also be using some basic functionality from the tidyverse packages, and from `tntpr`. Make sure you've installed these packages first using `install.packages()` (or `devtools::install_github('tntp/tntpr')` for the `tntpr` package).
+
+```{r warning = FALSE, message = FALSE}
+library(qualtRics)
+library(tntpr)
+
+# NOTE: We are not simply loading `tidyverse` in this vignette due to how vignettes
+# are built to create the documentation website. In other contexts, however, we
+# would simply use `library(tidyverse)` instead of loading the following packages individually.
+library(dplyr)
+library(tidyr)
+library(purrr)
+library(forcats)
+library(lubridate)
+```
+
+## Building Surveys
+
+### General Survey-Building Advice
+
+*What makes a good survey question? How long should my survey be? How do I deal with distribution lists? Authentication?*
+
+These are all great questions, and they will **not** be answered in this vignette. For more guidance, check out the "Survey Resources" category in the Documents of the TNTP Data Analytics Sharepoint site. This vignette will focus only on the aspects of survey design that interact directly with R, specifically...
+
+### Question Codes
+
+When you create surveys in Qualtrics each question will come with a standard question code in the form `Q7` or `Q192`.
+
+![](qr-question_code.png "A bad question code")
+
+These question codes will eventually become the column headers of your data-frame in R, so we recommend setting them up in advance to be usable:
+
+-   Follow tidyverse naming conventions (snake case, e.g. `styled_like_this`)
+-   Avoid spaces and special characters (except for \_ and -)
+-   Use standard prefixes or suffixes for questions you will want to group together in analysis. For example, using `id_name`, `id_school`, `id_district`, `id_email`, etc. allows you to easily pull all of those columns with the tidy-select statement `starts_with('id_')`
+
+For simple multiple choice and text-entry questions, you'll only need to edit the main question code as seen in the image above. However for more complicated question types you may need to adjust the Recode Values, Variable Naming, or Question Export Tags. You can access these settings by clicking on the question and finding the Recode Values button under Question Behavior:
+
+![](qr-recode_values.png "Recode values")
+
+Here's a quick rundown of how each question type behaves with recode values:
+
+- **Check all:** fill this out later...
+
+Once your survey is built and ready to go, you'll want to get data from it (well, after you collect responses of course). You *could* download the data as a .csv and then import that into R, but with a little bit of time on setup you can make the process much easier by just pulling directly from the **Qualtrics API**. The first step to getting your data is to get set up with...
+
+## Qualtrics Authentication
+
+This section will cover:
+1.  Getting a Qualtrics API Token
+1.  Storing your token securely in R
+1.  Accessing your token in R
+
+### Qualtrics API Token
+
+Follow these steps to get your API token:
+
+1. Log in to the TNTP Qualtrics site
+1. Click on your bubble in the top-right, and select "Account Settings"
+1. Go to the "Qualtrics IDs" tab
+1. Under the "API" heading click "Generate Token" and copy the resulting string of characters
+
+### Storing Credentials in R
+
+Your API Token should be treated and protected like a password. Just like you wouldn't write your computer password down on a post-it note next to your trackpad (you wouldn't do that, right?), you **should NOT** hard-code your token (or any other passwords / secrets) directly into your scripts, since they may be seen and used by other people.
+
+```{r}
+# BAD! DO NOT DO THIS!!!
+api_token <- 'abcdefghijklmnopqrstuvwxyz'
+```
+
+Instead we're going to save our token in a local file called `.Renviron` (which lives in your home directory and is not synced by Github, Bitbucket, or Sharepoint), and then pull it in from there.
+
+The qualtRics package provides an automated way to do this saving. Note that you should run the script below only one time and from the Console. **DON'T put it in your analysis script(s)** (otherwise you're defeating the whole point):
+
+```{r, eval = FALSE}
+# Run this ONCE from the console to save your credentials
+qualtrics_api_credentials(
+  api_key = "YOUR KEY HERE",
+  base_url = "tntp.co1.qualtrics.com",
+  install = TRUE
+)
+```
+
+### Accessing Credentials in R
+
+Once you've saved your credentials, you'll need to restart R (either close and re-open RStudio or run `.rs.restartR()`) and then you should be able to access your credentials using the `Sys.getenv()` command:
+
+```{r, eval = FALSE}
+Sys.getenv('QUALTRICS_API_KEY')
+Sys.getenv('QUALTRICS_BASE_URL')
+```
+
+From now on, these environmental variables will be available every time you open R. You can use this same process to store other tokens or passwords:
+
+```{r, eval = FALSE}
+# Open the .Renviron file
+usethis::edit_r_environ()
+
+# Add any values you want to the file in the format below and then save the file
+# MY_KEY_NAME = 'keyvalue'
+
+# Restart R / RStudio
+
+# Access variables from the .Renviron file
+my_key <- Sys.getenv('MY_KEY_NAME')
+```
+
+Congrats! You've now securely saved your Qualtrics credentials, and you're ready to start pulling down survey data!
+
+## Getting Data
+
+### Survey ID
+In addition to your survey data, you'll need the survey ID for the survey you are trying to pull. This ID will be in the form "SV_**********", and the easiest way to get it is by navigating to the survey in your browser and copying it from the URL bar:
+![](qr-survey_id.png "Survey ID in URL bar")
+
+You can also pull down all surveys you have access to using the `all_surveys()` function from `qualtRics`, and then filter that by name:
+```{r, eval = FALSE}
+surveys <- all_surveys()
+surveys |> 
+  filter(name == "FY24_tntpr_Example Survey")
+
+```
+
+Your survey ID is *not* a secret, so you can happily keep that value hard-coded at the top of your script
+
+### Pulling Survey Data
+Now that you have your authentication details saved in `.Renviron` and your survey id ready to go, it's time to pull a survey!
+
+```{r, eval = FALSE}
+survey_id <- 'SV_dbwpKPZ8Cw0CcEC'
+survey <- fetch_survey(survey_id, force_request = TRUE)
+```
+
+It's worth noting a few of the useful optional arguments in `fetch_survey()` (one of which we used above):
+
+-   `force_request = TRUE` by default qualtRics saves the survey data for the session and will use that data when you call `fetch_survey()` again for the same id. This argument forces a fresh pull, which is useful when you're testing a script or if you want to make sure you have the most up-to-date data.
+-   `start_date` and `end_date` can be used to limit the responses pulled by `RecordedDate`
+-   `include_metadata = NA` or `include_embedded = NA` can be used to exclude metadata or embedded data columns. You can also run them with a character vector to include only certain columns: `include_metadata = c('RecipientEmail', 'RecordedDate')`
+-   `label = FALSE` Enabling this option will pull recode values instead of text (e.g. `6` instead of `Strongly Agree`)
+
+# Pulling other data
+There are a bunch of other functions within the qualtRics package to pull other types of data, including:
+
+-   `fetch_description()` for full survey data, including survey flow, options, scoring, etc.
+-   `fetch_distributions()` to pull distributions for a survey
+-   `fetch_distribution_history()` to pull history for an individual distribution
+-   `fetch_mailinglist()` to pull a mailing list by mailing list ID
+-   `survey_questions()` to pull information on each question in a survey. Similar to the `column_map` that is downloaded by `fetch_survey()` by default.
+
+## Analysis
+
+## Advanced Tools

From c6b038baa14d161d4cf0aff73d0959d5d49a701e Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 12 Dec 2023 10:20:20 -0500
Subject: [PATCH 22/30] Added title to vignette

---
 vignettes/qualtrics-r-cookbook.Rmd | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/vignettes/qualtrics-r-cookbook.Rmd b/vignettes/qualtrics-r-cookbook.Rmd
index 64f7416..f1ee717 100644
--- a/vignettes/qualtrics-r-cookbook.Rmd
+++ b/vignettes/qualtrics-r-cookbook.Rmd
@@ -2,7 +2,7 @@
 title: "TNTP Qualtrics/R Cookbook"
 output: html_document
 vignette: >
-  %\VignetteIndexEntry{Vignette Title}
+  %\VignetteIndexEntry{TNTP Qualtrics/R Cookbook}
   %\VignetteEngine{knitr::rmarkdown}
   %\VignetteEncoding{UTF-8}
 ---
@@ -179,4 +179,9 @@ There are a bunch of other functions within the qualtRics package to pull other
 
 ## Analysis
 
+Finally it's time to dig into the data! We'll cover a few different common analysis tasks here, including:
+
+1.  Likert Matrix questions
+1.  
+
 ## Advanced Tools

From cf108f497326bfb2c48fe6fcd038c9b9a2967058 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 12 Dec 2023 10:20:51 -0500
Subject: [PATCH 23/30] Added tntp_cred() function

---
 DESCRIPTION      |  4 +++-
 NAMESPACE        |  1 +
 R/tntp_cred.R    | 60 ++++++++++++++++++++++++++++++++++++++++++++++++
 man/tntp_cred.Rd | 41 +++++++++++++++++++++++++++++++++
 4 files changed, 105 insertions(+), 1 deletion(-)
 create mode 100644 R/tntp_cred.R
 create mode 100644 man/tntp_cred.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index 1d63cf8..8509637 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -22,6 +22,7 @@ Imports:
     grDevices,
     grid,
     janitor,
+    keyring,
     labelled,
     lazyeval,
     lubridate (>= 1.7.4),
@@ -43,7 +44,8 @@ Suggests:
     usethis,
     ggridges,
     ggalt,
-    forcats
+    forcats,
+    qualtRics
 VignetteBuilder: 
     knitr
 Encoding: UTF-8
diff --git a/NAMESPACE b/NAMESPACE
index 7849b48..e904982 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -32,6 +32,7 @@ export(tableN)
 export(theme_tntp)
 export(theme_tntp_2018)
 export(tntp_colors)
+export(tntp_cred)
 export(tntp_palette)
 export(tntp_style)
 export(update_geom_font_defaults)
diff --git a/R/tntp_cred.R b/R/tntp_cred.R
new file mode 100644
index 0000000..1e0257c
--- /dev/null
+++ b/R/tntp_cred.R
@@ -0,0 +1,60 @@
+#' TNTP Credential Get/Set Command
+#'
+#' A wrapper around the `keyring` package for secure credential management.
+#' This command will attempt to get a key, and if no credential is found it
+#' will prompt you to add it (and then return it). You can also use this to
+#' just set (or overwrite) values by using the `.set` parameter.
+#'
+#' @md
+#'
+#' @param service The identifier for the credential you are pulling or setting
+#' @param username OPTIONAL. Can be used to specify different usernames for the same service
+#' @param keyring OPTIONAL. Can be used to specify a specific keyring
+#' @param .set Logical. If `TRUE`, will prompt the user to set a credential and will not return a value. Essentially the same as `keyring::key_set()`.
+#'
+#' @return A stored (or newly created) credential
+#' @export
+#'
+#' @examples
+#' \dontrun{
+#' # Using tntp_cred() with qualtRics
+#' library(qualtRics)
+#'
+#' # If no credential is set, this command will prompt for it first
+#' qualtrics_token <- tntp_cred("QUALTRICS_TOKEN")
+#' qualtrics_api_credentials(api_key = qualtrics_token,
+#'                           base_url = 'tntp.co1.qualtrics.com')
+#'
+#' # To overwrite your Qualtrics credential
+#' tntp_cred("QUALTRICS_TOKEN", .set = TRUE)
+#' }
+#'
+tntp_cred <- function(service, username = NULL, keyring = NULL, .set = FALSE) {
+
+  # Check for and return a value for that key
+  if(!.set) {
+    # Pull with key_get, or return an error
+    cred <- tryCatch(keyring::key_get(service, username, keyring),
+                     error = function(e) e)
+
+    # If a credential is found, return it!
+    if(!("error" %in% attr(cred, "class"))) {
+      return(cred)
+
+      # If no credential is found, ask if a user wants to create it
+    } else if(!isTRUE(utils::askYesNo(paste0("No credentials found for '", service,
+                                "'.\n\nDo you want to set credentials now?")))) {
+
+      # If not, end with an error
+      cli::cli_abort("No credentials found for {.val {service}}.")
+    }
+  }
+
+  # If no value exists, ask if they would like to set a value, then set a value
+  keyring::key_set(service, username, keyring,
+                   prompt = paste0("Enter credential for '", service, "': "))
+
+  # Return the newly set value
+  if(!.set) keyring::key_get(service, username, keyring)
+
+}
diff --git a/man/tntp_cred.Rd b/man/tntp_cred.Rd
new file mode 100644
index 0000000..b2ad872
--- /dev/null
+++ b/man/tntp_cred.Rd
@@ -0,0 +1,41 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/tntp_cred.R
+\name{tntp_cred}
+\alias{tntp_cred}
+\title{TNTP Credential Get/Set Command}
+\usage{
+tntp_cred(service, username = NULL, keyring = NULL, .set = FALSE)
+}
+\arguments{
+\item{service}{The identifier for the credential you are pulling or setting}
+
+\item{username}{OPTIONAL. Can be used to specify different usernames for the same service}
+
+\item{keyring}{OPTIONAL. Can be used to specify a specific keyring}
+
+\item{.set}{Logical. If \code{TRUE}, will prompt the user to set a credential and will not return a value. Essentially the same as \code{keyring::key_set()}.}
+}
+\value{
+A stored (or newly created) credential
+}
+\description{
+A wrapper around the \code{keyring} package for secure credential management.
+This command will attempt to get a key, and if no credential is found it
+will prompt you to add it (and then return it). You can also use this to
+just set (or overwrite) values by using the \code{.set} parameter.
+}
+\examples{
+\dontrun{
+# Using tntp_cred() with qualtRics
+library(qualtRics)
+
+# If no credential is set, this command will prompt for it first
+qualtrics_token <- tntp_cred("QUALTRICS_TOKEN")
+qualtrics_api_credentials(api_key = qualtrics_token,
+                          base_url = 'tntp.co1.qualtrics.com')
+
+# To overwrite your Qualtrics credential
+tntp_cred("QUALTRICS_TOKEN", .set = TRUE)
+}
+
+}

From 929e849021b14d943c3f2516e5a50a0471cb4635 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Tue, 12 Dec 2023 10:47:40 -0500
Subject: [PATCH 24/30] Added tntp_cred_list()

---
 NAMESPACE        |  1 +
 R/tntp_cred.R    | 24 ++++++++++++++++++++----
 man/tntp_cred.Rd |  8 +++++++-
 3 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/NAMESPACE b/NAMESPACE
index e904982..ea5daa8 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -33,6 +33,7 @@ export(theme_tntp)
 export(theme_tntp_2018)
 export(tntp_colors)
 export(tntp_cred)
+export(tntp_cred_list)
 export(tntp_palette)
 export(tntp_style)
 export(update_geom_font_defaults)
diff --git a/R/tntp_cred.R b/R/tntp_cred.R
index 1e0257c..6fef80d 100644
--- a/R/tntp_cred.R
+++ b/R/tntp_cred.R
@@ -1,10 +1,14 @@
 #' TNTP Credential Get/Set Command
 #'
+#' @description
 #' A wrapper around the `keyring` package for secure credential management.
-#' This command will attempt to get a key, and if no credential is found it
+#'
+#' `tntp_cred()` will attempt to get a key, and if no credential is found it
 #' will prompt you to add it (and then return it). You can also use this to
 #' just set (or overwrite) values by using the `.set` parameter.
 #'
+#' `tntp_cred_list()` will list all current credentials by service and username
+#'
 #' @md
 #'
 #' @param service The identifier for the credential you are pulling or setting
@@ -42,11 +46,17 @@ tntp_cred <- function(service, username = NULL, keyring = NULL, .set = FALSE) {
       return(cred)
 
       # If no credential is found, ask if a user wants to create it
-    } else if(!isTRUE(utils::askYesNo(paste0("No credentials found for '", service,
-                                "'.\n\nDo you want to set credentials now?")))) {
+    } else {
+      cli::cli_inform(c("i" = "No credentials found for {.val {service}}",
+                        "i" = "To list all current credentials stop the script and run {.run tntpr::tntp_cred_list()}",
+                        "","Would you like to set new credentials for {.val {service}} now?"))
+
+      input <- utils::select.list(c("Yes","No"))
 
       # If not, end with an error
-      cli::cli_abort("No credentials found for {.val {service}}.")
+      if(input != "Yes") {
+        cli::cli_abort("No credentials found for {.val {service}}.")
+      }
     }
   }
 
@@ -58,3 +68,9 @@ tntp_cred <- function(service, username = NULL, keyring = NULL, .set = FALSE) {
   if(!.set) keyring::key_get(service, username, keyring)
 
 }
+
+#' @export
+#' @rdname tntp_cred
+tntp_cred_list <- function(service = NULL, keyring = NULL) {
+  keyring::key_list(service, keyring)
+}
diff --git a/man/tntp_cred.Rd b/man/tntp_cred.Rd
index b2ad872..006a429 100644
--- a/man/tntp_cred.Rd
+++ b/man/tntp_cred.Rd
@@ -2,9 +2,12 @@
 % Please edit documentation in R/tntp_cred.R
 \name{tntp_cred}
 \alias{tntp_cred}
+\alias{tntp_cred_list}
 \title{TNTP Credential Get/Set Command}
 \usage{
 tntp_cred(service, username = NULL, keyring = NULL, .set = FALSE)
+
+tntp_cred_list(service = NULL, keyring = NULL)
 }
 \arguments{
 \item{service}{The identifier for the credential you are pulling or setting}
@@ -20,9 +23,12 @@ A stored (or newly created) credential
 }
 \description{
 A wrapper around the \code{keyring} package for secure credential management.
-This command will attempt to get a key, and if no credential is found it
+
+\code{tntp_cred()} will attempt to get a key, and if no credential is found it
 will prompt you to add it (and then return it). You can also use this to
 just set (or overwrite) values by using the \code{.set} parameter.
+
+\code{tntp_cred_list()} will list all current credentials by service and username
 }
 \examples{
 \dontrun{

From 914ad39dbaa4c1ac6cad742b0c6f23953009dd82 Mon Sep 17 00:00:00 2001
From: Dustin Pashouwer <dustin.pashouwer@tntp.org>
Date: Wed, 3 Jan 2024 14:36:00 -0700
Subject: [PATCH 25/30] QC 2024-01-03

---
 vignettes/qualtrics-r-cookbook.Rmd | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/vignettes/qualtrics-r-cookbook.Rmd b/vignettes/qualtrics-r-cookbook.Rmd
index f1ee717..89a38de 100644
--- a/vignettes/qualtrics-r-cookbook.Rmd
+++ b/vignettes/qualtrics-r-cookbook.Rmd
@@ -16,11 +16,11 @@ knitr::opts_chunk$set(
 ```
 ## Introduction
 
-This vignette is designed to showcase best practices for setting up, pulling, and processing Qualtrics data in R. There are *many* different ways to accomplish these tasks, but we will lay out a recommended workflow that we belive to be the simplest and most flexible. This document will go through the following big ideas:
+This vignette is designed to showcase best practices for setting up, pulling, and processing Qualtrics data in R. There are *many* different ways to accomplish these tasks, but we will lay out a recommended workflow that we believe to be the simplest and most flexible. This document will go through the following big ideas:
 
 1.  **Setup:** Installing the necessary packages
 2.  **Building Surveys:** Best practices in Qualtrics for creating surveys in a way that will help you analyze efficiently
-3.  **Qualtrics Authentication: ** How to get an API token from Qualtrics and safely store it in R.
+3.  **Qualtrics Authentication:** How to get an API token from Qualtrics and safely store it in R.
 4.  **Getting Data:** How to use the `qualtRics` package to pull survey data.
 5.  **Analysis:** Some common methods of analysis, including helpful functions from `tntpr`
 6.  **Advanced Tools:** A brief overview of the `QualtricsInR` and `httr2` packages and how they can be used to automate even more in Qualtrics.

From e1bd5ee06e8246e48ab57317d8613df68c829019 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 8 Jan 2024 11:58:32 -0500
Subject: [PATCH 26/30] Added tntp_cred_set() and an initial test

---
 NAMESPACE                       |  1 +
 R/tntp_cred.R                   | 91 ++++++++++++++++++++++-----------
 man/tntp_cred.Rd                | 26 +++++++---
 tests/testthat/test-tntp_cred.R | 14 +++++
 4 files changed, 97 insertions(+), 35 deletions(-)
 create mode 100644 tests/testthat/test-tntp_cred.R

diff --git a/NAMESPACE b/NAMESPACE
index ea5daa8..645be9e 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -34,6 +34,7 @@ export(theme_tntp_2018)
 export(tntp_colors)
 export(tntp_cred)
 export(tntp_cred_list)
+export(tntp_cred_set)
 export(tntp_palette)
 export(tntp_style)
 export(update_geom_font_defaults)
diff --git a/R/tntp_cred.R b/R/tntp_cred.R
index 6fef80d..868bf94 100644
--- a/R/tntp_cred.R
+++ b/R/tntp_cred.R
@@ -3,18 +3,22 @@
 #' @description
 #' A wrapper around the `keyring` package for secure credential management.
 #'
-#' `tntp_cred()` will attempt to get a key, and if no credential is found it
-#' will prompt you to add it (and then return it). You can also use this to
-#' just set (or overwrite) values by using the `.set` parameter.
+#' `tntp_cred()` will attempt to get a credential, and if no credential is found
+#' it will prompt you to add it (and then return it).
 #'
-#' `tntp_cred_list()` will list all current credentials by service and username
+#' `tntp_cred_set()` will set a credential. By default it will prompt before
+#' overwriting any current credentials.
+#'
+#' `tntp_cred_list()` will list all current credentials by sorted by service
+#' and username.
 #'
 #' @md
 #'
 #' @param service The identifier for the credential you are pulling or setting
 #' @param username OPTIONAL. Can be used to specify different usernames for the same service
 #' @param keyring OPTIONAL. Can be used to specify a specific keyring
-#' @param .set Logical. If `TRUE`, will prompt the user to set a credential and will not return a value. Essentially the same as `keyring::key_set()`.
+#' @param prompt OPTIONAL. What text should be displayed above the input box for the key while setting?
+#' @param overwrite OPTIONAL. By default, `tntp_cred_set()` will prompt if it finds a credential already saved. Set this to `TRUE` to overwrite without prompting or `FALSE` to throw an error if a current credential is found.
 #'
 #' @return A stored (or newly created) credential
 #' @export
@@ -33,44 +37,73 @@
 #' tntp_cred("QUALTRICS_TOKEN", .set = TRUE)
 #' }
 #'
-tntp_cred <- function(service, username = NULL, keyring = NULL, .set = FALSE) {
+tntp_cred <- function(service, username = NULL, keyring = NULL, prompt = NULL) {
+
+  # Pull with key_get, or return an error
+  cred <- tryCatch(keyring::key_get(service, username, keyring),
+                   error = function(e) e)
+
+  # If a credential isn't found, prompt user to create it
+  if(("error" %in% attr(cred, "class"))) {
+
+    cli::cli_inform(c("i" = "No credentials found for {.val {service}}",
+                      "i" = "To list all current credentials stop the script and run {.run tntpr::tntp_cred_list()}",
+                      "","Would you like to set new credentials for {.val {service}} now?"))
+
+    input <- utils::select.list(c("Yes","No"))
+
+    # If not, end with an error
+    if(input != "Yes") {
+      cli::cli_abort("No credentials found for {.val {service}}.")
+    }
+
+    # If yes, set and then re-pull the credential
+    tntp_cred_set(service, username, keyring, prompt, overwrite = TRUE)
+    cred <- keyring::key_get(service, username, keyring)
+
+  }
+
+  # Return the credential
+  cred
 
-  # Check for and return a value for that key
-  if(!.set) {
-    # Pull with key_get, or return an error
+}
+
+#' @export
+#' @rdname tntp_cred
+tntp_cred_set <- function(service = NULL, username = NULL, keyring = NULL, prompt = NULL, overwrite = NULL) {
+
+  if(is.null(prompt)) prompt <- paste0("Enter credential for '", service, "': ")
+
+  # If overwrite is TRUE, skip to writing
+  if(!isTRUE(overwrite)) {
+
+    # Check for existence of key by looking for an error in key_get()
     cred <- tryCatch(keyring::key_get(service, username, keyring),
                      error = function(e) e)
 
-    # If a credential is found, return it!
+    # If a credential is found
     if(!("error" %in% attr(cred, "class"))) {
-      return(cred)
-
-      # If no credential is found, ask if a user wants to create it
-    } else {
-      cli::cli_inform(c("i" = "No credentials found for {.val {service}}",
-                        "i" = "To list all current credentials stop the script and run {.run tntpr::tntp_cred_list()}",
-                        "","Would you like to set new credentials for {.val {service}} now?"))
 
-      input <- utils::select.list(c("Yes","No"))
+      # If overwrite == FALSE, end with error
+      if(isFALSE(overwrite)) cli::cli_abort(c("x" = "Credential already found for this service and username.",
+                                             "i" = "To overwrite, run with parameter {.code overwrite = TRUE}"))
 
-      # If not, end with an error
-      if(input != "Yes") {
-        cli::cli_abort("No credentials found for {.val {service}}.")
-      }
+      # If overwrite is anything else (NA), warn about duplicate and prompt to overwrite
+      cli::cli_inform(c("i" = "Credential already found for this service and username. Overwrite?"))
+      if(select.list(c('Overwrite with new credential','Cancel')) == 'Cancel') cli::cli_abort("Credentials not updated")
     }
   }
 
-  # If no value exists, ask if they would like to set a value, then set a value
-  keyring::key_set(service, username, keyring,
-                   prompt = paste0("Enter credential for '", service, "': "))
-
-  # Return the newly set value
-  if(!.set) keyring::key_get(service, username, keyring)
+  keyring::key_set(service, username, keyring, prompt)
 
 }
 
 #' @export
 #' @rdname tntp_cred
 tntp_cred_list <- function(service = NULL, keyring = NULL) {
-  keyring::key_list(service, keyring)
+  # Pull with key_list
+  list <- keyring::key_list(service, keyring)
+
+  # Sort by service, then username
+  list[order(list$service, list$username),]
 }
diff --git a/man/tntp_cred.Rd b/man/tntp_cred.Rd
index 006a429..4ab42fb 100644
--- a/man/tntp_cred.Rd
+++ b/man/tntp_cred.Rd
@@ -2,10 +2,19 @@
 % Please edit documentation in R/tntp_cred.R
 \name{tntp_cred}
 \alias{tntp_cred}
+\alias{tntp_cred_set}
 \alias{tntp_cred_list}
 \title{TNTP Credential Get/Set Command}
 \usage{
-tntp_cred(service, username = NULL, keyring = NULL, .set = FALSE)
+tntp_cred(service, username = NULL, keyring = NULL, prompt = NULL)
+
+tntp_cred_set(
+  service = NULL,
+  username = NULL,
+  keyring = NULL,
+  prompt = NULL,
+  overwrite = NA
+)
 
 tntp_cred_list(service = NULL, keyring = NULL)
 }
@@ -16,7 +25,9 @@ tntp_cred_list(service = NULL, keyring = NULL)
 
 \item{keyring}{OPTIONAL. Can be used to specify a specific keyring}
 
-\item{.set}{Logical. If \code{TRUE}, will prompt the user to set a credential and will not return a value. Essentially the same as \code{keyring::key_set()}.}
+\item{prompt}{OPTIONAL. What text should be displayed above the input box for the key while setting?}
+
+\item{overwrite}{OPTIONAL. By default, \code{tntp_cred_set()} will prompt if it finds a credential already saved. Set this to \code{TRUE} to overwrite without prompting or \code{FALSE} to throw an error if a current credential is found.}
 }
 \value{
 A stored (or newly created) credential
@@ -24,11 +35,14 @@ A stored (or newly created) credential
 \description{
 A wrapper around the \code{keyring} package for secure credential management.
 
-\code{tntp_cred()} will attempt to get a key, and if no credential is found it
-will prompt you to add it (and then return it). You can also use this to
-just set (or overwrite) values by using the \code{.set} parameter.
+\code{tntp_cred()} will attempt to get a credential, and if no credential is found
+it will prompt you to add it (and then return it).
+
+\code{tntp_cred_set()} will set a credential. By default it will prompt before
+overwriting any current credentials.
 
-\code{tntp_cred_list()} will list all current credentials by service and username
+\code{tntp_cred_list()} will list all current credentials by sorted by service
+and username.
 }
 \examples{
 \dontrun{
diff --git a/tests/testthat/test-tntp_cred.R b/tests/testthat/test-tntp_cred.R
new file mode 100644
index 0000000..445c4c5
--- /dev/null
+++ b/tests/testthat/test-tntp_cred.R
@@ -0,0 +1,14 @@
+test_that("Credentials can be retrieved with tntp_cred()", {
+  cred <- "tntp_cred TEST CREDENTIAL"
+  pw <- "abc"
+
+  # set programmatically
+  keyring::key_set_with_value(cred, password = pw)
+
+  # Test that pulling works
+  expect_equal(tntp_cred(cred), pw)
+
+  # Remove test key
+  keyring::key_delete(cred)
+
+})

From c8289ca4c773eac3db13b05ca1c49258dfaadcc8 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Mon, 8 Jan 2024 12:24:54 -0500
Subject: [PATCH 27/30] Fixed all testing warnings

---
 R/survey_utils.R                    |  4 ++--
 R/theme_tntp.R                      |  4 ++--
 R/theme_tntp_2018.R                 | 22 +++++++++++-----------
 tests/testthat/test-date-to-sy.R    |  4 ----
 tests/testthat/test-show-in-excel.R |  2 --
 tests/testthat/test-survey-utils.R  | 11 ++++++-----
 6 files changed, 21 insertions(+), 26 deletions(-)

diff --git a/R/survey_utils.R b/R/survey_utils.R
index 4d07bd2..db40a27 100644
--- a/R/survey_utils.R
+++ b/R/survey_utils.R
@@ -106,7 +106,7 @@ convert_to_top_2_agree <- function(x, custom_vals = NULL) {
 #'   check_all_recode(contains("q1"))
 #'
 check_all_recode <- function(dat, ..., set_labels = TRUE) {
-  dat <- dplyr::as_data_frame(dat) # so that single bracket subsetting behaves as expected later and returns a data.frame
+  dat <- tibble::as_tibble(dat) # so that single bracket subsetting behaves as expected later and returns a data.frame
   original_order <- names(dat)
   cols_of_interest <- dat %>%
     dplyr::select(...) %>%
@@ -128,7 +128,7 @@ check_all_recode <- function(dat, ..., set_labels = TRUE) {
   cols_of_interest[responded, ][!is.na(cols_of_interest[responded, ])] <- 1
   cols_of_interest[responded, ][is.na(cols_of_interest[responded, ])] <- 0
   # convert columns to numeric
-  cols_of_interest <- lapply(cols_of_interest, as.numeric) %>% dplyr::as_data_frame()
+  cols_of_interest <- lapply(cols_of_interest, as.numeric) %>% as.data.frame()
 
   # restore labels
   if (set_labels) {
diff --git a/R/theme_tntp.R b/R/theme_tntp.R
index e354fa5..09f4aa5 100644
--- a/R/theme_tntp.R
+++ b/R/theme_tntp.R
@@ -73,8 +73,8 @@ theme_tntp <- function(show_legend_title = TRUE,
       legend.key = ggplot2::element_blank(), # Remove border from legend boxes
       panel.grid.major = ggplot2::element_line(color = grid_color),
       panel.grid.minor = ggplot2::element_blank(), # Remove minor gridlines entirely
-      axis.line.y = ggplot2::element_line(color = "black", size = 0.25),
-      axis.line.x = ggplot2::element_line(color = "black", size = 0.25),
+      axis.line.y = ggplot2::element_line(color = "black", linewidth = 0.25),
+      axis.line.x = ggplot2::element_line(color = "black", linewidth = 0.25),
       plot.title = ggplot2::element_text(
         hjust = title_h_just,
         colour = title_color,
diff --git a/R/theme_tntp_2018.R b/R/theme_tntp_2018.R
index 33b3d0a..20cfd35 100644
--- a/R/theme_tntp_2018.R
+++ b/R/theme_tntp_2018.R
@@ -92,9 +92,9 @@ theme_tntp_2018 <- function(base_family = "Segoe UI", base_size = 11.5,
   ret <- ret + ggplot2::theme(legend.key = ggplot2::element_blank())
 
   if (inherits(grid, "character") | grid == TRUE) {
-    ret <- ret + ggplot2::theme(panel.grid = ggplot2::element_line(color = grid_col, size = 0.2))
-    ret <- ret + ggplot2::theme(panel.grid.major = ggplot2::element_line(color = grid_col, size = 0.2))
-    ret <- ret + ggplot2::theme(panel.grid.minor = ggplot2::element_line(color = grid_col, size = 0.15))
+    ret <- ret + ggplot2::theme(panel.grid = ggplot2::element_line(color = grid_col, linewidth = 0.2))
+    ret <- ret + ggplot2::theme(panel.grid.major = ggplot2::element_line(color = grid_col, linewidth = 0.2))
+    ret <- ret + ggplot2::theme(panel.grid.minor = ggplot2::element_line(color = grid_col, linewidth = 0.15))
 
     if (inherits(grid, "character")) {
       if (regexpr("X", grid)[1] < 0) ret <- ret + ggplot2::theme(panel.grid.major.x = ggplot2::element_blank())
@@ -123,22 +123,22 @@ theme_tntp_2018 <- function(base_family = "Segoe UI", base_size = 11.5,
   }
 
   if (inherits(axis, "character") | axis == TRUE) {
-    ret <- ret + ggplot2::theme(axis.line = ggplot2::element_line(color = "#2b2b2b", size = 0.15))
+    ret <- ret + ggplot2::theme(axis.line = ggplot2::element_line(color = "#2b2b2b", linewidth = 0.15))
     if (inherits(axis, "character")) {
       axis <- tolower(axis)
       if (regexpr("x", axis)[1] < 0) {
         ret <- ret + ggplot2::theme(axis.line.x = ggplot2::element_blank())
       } else {
-        ret <- ret + ggplot2::theme(axis.line.x = ggplot2::element_line(color = axis_col, size = 0.15))
+        ret <- ret + ggplot2::theme(axis.line.x = ggplot2::element_line(color = axis_col, linewidth = 0.15))
       }
       if (regexpr("y", axis)[1] < 0) {
         ret <- ret + ggplot2::theme(axis.line.y = ggplot2::element_blank())
       } else {
-        ret <- ret + ggplot2::theme(axis.line.y = ggplot2::element_line(color = axis_col, size = 0.15))
+        ret <- ret + ggplot2::theme(axis.line.y = ggplot2::element_line(color = axis_col, linewidth = 0.15))
       }
     } else {
-      ret <- ret + ggplot2::theme(axis.line.x = ggplot2::element_line(color = axis_col, size = 0.15))
-      ret <- ret + ggplot2::theme(axis.line.y = ggplot2::element_line(color = axis_col, size = 0.15))
+      ret <- ret + ggplot2::theme(axis.line.x = ggplot2::element_line(color = axis_col, linewidth = 0.15))
+      ret <- ret + ggplot2::theme(axis.line.y = ggplot2::element_line(color = axis_col, linewidth = 0.15))
     }
   } else {
     ret <- ret + ggplot2::theme(axis.line = ggplot2::element_blank())
@@ -149,9 +149,9 @@ theme_tntp_2018 <- function(base_family = "Segoe UI", base_size = 11.5,
     ret <- ret + ggplot2::theme(axis.ticks.x = ggplot2::element_blank())
     ret <- ret + ggplot2::theme(axis.ticks.y = ggplot2::element_blank())
   } else {
-    ret <- ret + ggplot2::theme(axis.ticks = ggplot2::element_line(size = 0.15))
-    ret <- ret + ggplot2::theme(axis.ticks.x = ggplot2::element_line(size = 0.15))
-    ret <- ret + ggplot2::theme(axis.ticks.y = ggplot2::element_line(size = 0.15))
+    ret <- ret + ggplot2::theme(axis.ticks = ggplot2::element_line(linewidth = 0.15))
+    ret <- ret + ggplot2::theme(axis.ticks.x = ggplot2::element_line(linewidth = 0.15))
+    ret <- ret + ggplot2::theme(axis.ticks.y = ggplot2::element_line(linewidth = 0.15))
     ret <- ret + ggplot2::theme(axis.ticks.length = grid::unit(5, "pt"))
   }
 
diff --git a/tests/testthat/test-date-to-sy.R b/tests/testthat/test-date-to-sy.R
index a9a9a55..0febb6c 100644
--- a/tests/testthat/test-date-to-sy.R
+++ b/tests/testthat/test-date-to-sy.R
@@ -1,9 +1,5 @@
 # Tests for date-to-school year function
 
-library(dplyr)
-library(lubridate)
-context("date_to_sy")
-
 test_that("conversion is accurate", {
   expect_equal(date_to_sy(as.Date("2014-05-05"), as.Date("2000-07-01")), "2013 - 2014")
   expect_equal(date_to_sy(as.Date("2014-07-05"), as.Date("2000-07-01")), "2014 - 2015")
diff --git a/tests/testthat/test-show-in-excel.R b/tests/testthat/test-show-in-excel.R
index 20feab9..139597f 100644
--- a/tests/testthat/test-show-in-excel.R
+++ b/tests/testthat/test-show-in-excel.R
@@ -1,4 +1,2 @@
-# Tests for date-to-school year function
 
-context("show_in_excel")
 
diff --git a/tests/testthat/test-survey-utils.R b/tests/testthat/test-survey-utils.R
index 8f9d81f..c3edd3c 100644
--- a/tests/testthat/test-survey-utils.R
+++ b/tests/testthat/test-survey-utils.R
@@ -4,7 +4,6 @@ library(testthat)
 library(janitor)
 library(labelled)
 library(dplyr)
-context("survey utilities")
 
 
 x <- data.frame( # 4th person didn't respond at all
@@ -165,8 +164,10 @@ test_that("bad inputs error or warn appropriately", {
     "input vectors should only have values of 0, 1, and NA; run check_all_recode() before calling this function",
     fixed = TRUE
   )
-  expect_warning(mtcars %>% check_all_recode(cyl:carb),
-    "column 1 has multiple values besides NA; not sure which is the question text.  Guessing this an \"Other (please specify)\" column.",
-    fixed = TRUE
-  )
+  mtcars %>%
+    check_all_recode(cyl:disp) |>
+    expect_warning("column 1 has multiple values besides NA; not sure which is the question text.  Guessing this an \"Other (please specify)\" column.",
+                   fixed = TRUE) |>
+    expect_warning("column 2 has multiple values besides NA; not sure which is the question text.  Guessing this an \"Other (please specify)\" column.",
+                   fixed = TRUE)
 })

From f552e4996c9a84555ff85eee43adaad724a5c3f0 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Wed, 24 Jan 2024 13:50:04 -0500
Subject: [PATCH 28/30] Removed qualtrics-vignette files from branch

---
 tests/testthat/test-tntp_colors.R  |   3 -
 tests/testthat/test-tntp_style.R   |   3 -
 vignettes/qr-question_code.PNG     | Bin 5656 -> 0 bytes
 vignettes/qr-recode_values.png     | Bin 2390 -> 0 bytes
 vignettes/qr-survey_id.png         | Bin 3192 -> 0 bytes
 vignettes/qualtrics-r-cookbook.Rmd | 187 -----------------------------
 6 files changed, 193 deletions(-)
 delete mode 100644 tests/testthat/test-tntp_colors.R
 delete mode 100644 tests/testthat/test-tntp_style.R
 delete mode 100644 vignettes/qr-question_code.PNG
 delete mode 100644 vignettes/qr-recode_values.png
 delete mode 100644 vignettes/qr-survey_id.png
 delete mode 100644 vignettes/qualtrics-r-cookbook.Rmd

diff --git a/tests/testthat/test-tntp_colors.R b/tests/testthat/test-tntp_colors.R
deleted file mode 100644
index 8849056..0000000
--- a/tests/testthat/test-tntp_colors.R
+++ /dev/null
@@ -1,3 +0,0 @@
-test_that("multiplication works", {
-  expect_equal(2 * 2, 4)
-})
diff --git a/tests/testthat/test-tntp_style.R b/tests/testthat/test-tntp_style.R
deleted file mode 100644
index 8849056..0000000
--- a/tests/testthat/test-tntp_style.R
+++ /dev/null
@@ -1,3 +0,0 @@
-test_that("multiplication works", {
-  expect_equal(2 * 2, 4)
-})
diff --git a/vignettes/qr-question_code.PNG b/vignettes/qr-question_code.PNG
deleted file mode 100644
index e97573a87be046f7680342cb6e2ba10c62b1c573..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 5656
zcmdT|cTiL7w%^K;a1IzbQi2+37TQ6KfDmbdAgEM9subY}1Oz0Mgc>x0APOQabWjLI
z%0W635Cx*4DNRL4JYc|3git~axf}4#+&6dT&Yk!EdV3~i@4eRgR{Pdk-!I10SbzU-
zhkpYAVE-ip-Kzk=1p)up@o<CR`oWTg;LjevtNJ=Xc@LZc-u&XGZKMqVmGQirH}-+|
zzuq>m@dE(po9)jYvQN>U03cL$Nmttf>o7aY@f!)qg3NEMg*R=OeCOlqN}7%yJAJGx
zYc|VVM5t%V7c1}BfgTakKL1?1o-dO$B{YRP8oRf^v{JA%f+$_U%3!U!Hl$olS3+fQ
zAC%Um)m30viQzA9^>v@k_%nm-GEw|aDrdAeq;sZgx*>->v!%Be0E$eZ01#n_1l2o3
z2fyAXaRGq1`G5T|V*x!ssl~C;-M(y-EIk_G19nBx+gFz%@pV2$o1~YtSg6Imv`dj0
zT!lq;d(^{|4hZuO`?*Vdjg00rb27#mtzP6El0VZ0s<2((5E&m+qFgg8K|+3rI$~AZ
z;rt&HcgmX+HXE&W=!j~ALF%rHgbyy3S{YAH-#|*!Q1IgmpUMTEL2%DjNK1du&*vWi
zqm`LOXmt^ePiw+5HC>mTy%l;F9v!ZOC(V_rzWSj8(T{C~h{=NSIo<DkGX8UuG!LRm
z#g6~*DTrA3>J4v6-(hFYhlCZSJpiDnu)AJ-nuhC&j2win7Nd4lRMc23bY9zb<8|dG
zm3TmN^{+-LP}q^ShoV)%T{DQ6WInCWcjpt(rp>;`e<-Dsi_Hts0yc}!vum|HO$D>Z
zD%-Uj)SKUK%(ZBxuTVoO3S`8dtA>}J7_um>80D1h0SKZ9m5x$T#gMM#c0(IAn#rH9
z(WZPKe94Gc7X{X+e)=ULwH4Uw%a^tJX7G6Yv!InxjQ(Pe+T6FKI-`@z-j14<X2Kp<
z?xF$U{4-}uQ2PnWQ+S)YO*T`i&lDMbBf#Cg$QDX1|M9tbOicD*yj;`*_7)-+#<lq_
zQA)p`Mx#ARiZ_F+4Dox$D7Ozk2-pjpKei*tl|qo}ErBQb2+BCz(E3Qx_U#Zqe2wp$
z{YzG%31`}*&oON53qyf3VW;>+HLz4-=%A-;k7S$e9w7Jk8oIda+Ax~`P;WgwSJjgr
zBZBuZgEnu>G?+mjC~_kna+V8L29ADmldMd!HZPSQDuM&R`y#?%Ec$(yT`U+NrU$Fx
zDo88Aw9LlVXhtoZpkXCRjU3Y{1|uz@t<q)xPfiifeL%!TL3%D$ijtIqudni}gty5p
zFtOa++!tw=t2tj2KH%EY4B%=%O?0*^6#{_6W)*PVllD-GntsnRn!lop9NCI^s6WOO
znq%g~Y|C#CcJ`{g2yUE+i^{f8$>jlgi0?S)+podp$$0D^2yBk3ud}~MJlR_9FB6RO
zE`5i!8~`Xit%bKev`NAb-!(P4Ko@r)#r4v)QYqS@_r5d7$!=cA=$iJ!$y`A0sQO~8
zBeAR{w0!+Yf3Y-VJEO!DiRjzhdPvp4nNOwikjk^53hw%})uB<;O|r%yjbKdC78t8+
z3t8V-Uw7S=<x&O!Ro#hNI9c{m!u~;8M{wbpmZlAFHcS<_F#im-Xl`PKb19L57`f-e
z;opy@rzFJ}gD#(Se$ye<M`N?c21ZBCN71hLY2j)#*KvW25<7wixXuF;S&#c@e$dB+
zM-CzE_`#fuOK^?!@YQExg?2tIijx~!n`WA^rj{W`h?ZYc@yGPz^7kJ(n;$YqQVH<)
zHza(LVm<njxgWH_$wTAC4Hr$hzvdOK3T~>%_pU8zT~E^tS$;B5GaEVOP;G0MiWgaM
z`ATc>bGtzM1-{YN?3+;~!^5<8p8qjBn*}D-kg(^&n!P}mYcHon4u%goH)q1dRp|I>
zW_J3@N1DIisb3*bc&T?m@^B-(%_c&GB_-!AQ0J8bZjaN-&VidV%8rIA;q(-Bt)T}m
z=G$=&>6Rmb`T@LU14DH29zY4*k!v|}()&y4rDS|+UBQNr%@fT)rXHhd5tbis&mQ#W
z^!q$IG=E@;Ram}!6vZURhMnu<Qdo}P3Zuow6NRjBvi7&bH`xM=2S<kTjVc~(mW3K_
z$4>=93suZf#-bNfrc&aAXP8DoIf-0cgYwmvL96TIa&6rFzC?AlHtY94iG}4y)|Hvq
zu~@{g4Vr=7)?|70UoX7gt*czT&nd6D(ibGwf-DRFyNsggQ{eWI`uJ3R{V}iLmkTSL
zFDaJc-j^DK*wpF}&fBnC^`5@x<{I_;y|;Bx^gZcBuWQy=KjEg(vfv@QiTN>{g{zpv
zsA1?~4xI6~?QfYUP)rS;8kn3PD+zy6$r4JveBe69tnn7Tb}6{#7r~$~Pq)UI&5Zs=
zHZue_RU#ObY-f@qqxzmCA2z#bQW)Z(9+rU!YF5m`gu4x2U2E8}o-jN1<|-PAWvy*)
zB>ecHzUmX?>bXVAR(;OD0oNGLz~Nk{s~X@BSL}KE|0W+`D}_yz^n&Rnwh>skT0eN=
zV>oiMjM96v(g%!<n%#C57r~oqW#o|@Kh$#1xi?{Rov7t&u!0j>#bF_4${Q*L(>*N`
zWzU-f+zqLsNWa^9lX2J2QOFihAR=(7U^<0}YuF;HD-IooAEw}1ygxr0lvkYVR-sXD
z78p#jpO@e+F~nN@XTP&n8~8Vpd<0eyM|M|Dav0^jjc|NNOokQk%5rV#Zw;|820JnC
z`s<P3&TBQY>H2avkCh|qrNd@w3;TckNSLL&$U=bgYQZRS&t{A+CvbW;h$z$6TUS~y
zk85INlUgdgvw|utXun<imVu#}v#(HKR<JMQlR7iz%|;{STlsLM8)xWF<^j=S8C%tV
z$DO0+Zj^;ue!W`|PlS2;d>qYT&CVIU#Av2kI*`P>IV*+z%@o!GV!OWBdr=n*MbmRu
zKPL{#%V=!1^)A%Pn{b{s-eg%Xk8+H8<sv86Gg7ST9<Gj-YcNWB72d_<bUM@OjYa}%
zuR_z`n<7Q#yz~%Dm^q`B(5a{XY!^~N%W|Ro(Q!fia1u4pLX!yYt?H_Zkr$Gq%w-=-
z+?BOSdfkXE`w=4-u9TODHeLJDn9<?zcypcCv+s4JXJ2Cg6Q%2Dbb!wL<QThHPBYK_
zhTAZ@=#yo4-sOaPudpduSX5ok6**b@*E^}85no4qr)M$5=bD_zO%6RLO%p6jhvgv2
z63wh<hASFbmZ4|Lk634Vhi@*mzf~x&5X75MlSPMNV%KahhbA%djxs!X6)sziEME^s
z)RH#QwlJ}qwlar$Eq}YPMxg8g-uEQo(>@N-bLCrp@nY;pG23JNKV~avHdde6v{Fzi
z?|!m8xR*Ix>)*RSwtur}G&Oe*FiGUp&#A3_c^n(Gz{^>p4+L>ACAgdCssoUp{<?8t
z7_4B+bsg<qW3}Ds7RaJR*hgBjclgXwYHpU%&opFhXw7uO#2s<{-6+O>$9G!f)O<u3
zShwIv^zocM(KlKW6nQF5W{%Xwd^tOPtFzUDxLZmvFIQ%|-FPL<gb5B__D~(ZHD6(I
z?ydSbr>AY2m2;m3@%*$I7#`#3NZW27wbm{>{q6&c?sQTboN6;;!L8lqf=b;f>k${F
zcbY<%?)G%p6NP?%ueG(+f8pCZ|CvvfHg-_33GOyE9i+RC88l8zOVhJcyVM9AE1k}4
zOL}z_ww|r(E6E;|YR<aPe4`=N!8fItV0{4`a|AtOmBH)>lrDqJ>e*ugv0H&_>*|kj
zzI5Ue>%$h}&AR`|xTBuYHErqtV<GiytX{a2lek99c+H0@NR`CD&I!`=++UeSofj@#
zSW8~RI&%CJNa>DcIq#nEljD@zY@Lm^jXp+$?*{;Fa9t*WvQL6KE|$YDC?*lS^!>v?
ze}7{C=xCMzjdFc+<Q8ScYy=0Fi#r5zC&g+r#RS3eAP=r2A!^<vDV77ZxSk338IM_6
zBS(nl2wDh64ll7-XOn|hgvik@?TGPDl~LALN@c*_1lAY8JqdIn_IiRy^LS<Z^Ci7Y
z(mlroWAaEsGGfnEy-V{{UHCoahJFQrN2btp)9_n}doZ`($9y{?9FB|nB{)YY_+%JP
zjW&mtss{SjieKG2@RO83-V2LWEp)gfeK7uIGB`)p3JOlgg3a*!vHvvJ+vd+PZ=$G8
zK`x4%K7YE^x&99Out5?SJeDcc_RoCy_3V^Ul5Cl+eK$$2PdU||5c~S6S}pO-o53up
zyty<XM&DW%%48V>00dczcI?9>{7saLNx+30SaH(A`xpK<1n<>USg4%!{uT~yR)Cm|
zelIzmf}gRNT6fLVwoa&pTBt<+-CP~ky-@xANkW~3ymh_0#_E?bd4n+2cwc&*O!5_-
zq&TwL#a_ef*w4zv<4hG<{k=d$hcra~j4!h2(_mV!sQ<0!adY^PtCO!OuW;{b7_Ei1
zg|jWA*=H-7i7$F12g8gD-h{|~`9XStZt3iAq|oX(tVc?H^2P-kEAp2YCmho(H=P#W
zdf`lE4kd3mRtLx51t;bUNqAwT3-bGCLdvzMm7DQay?lIP#z$J3WxW(~z`zNQ)Hf`c
z2V5c53C)I_w%4?kG*)YpVA*G%%_;H*2g6^tRb-$~$7!rwqqO!t5=g;Y4LM}jc~y{J
zt<87%d#%m<0sw~Rk?skul-5_zGx|#^9MpolTitt1q3Ao(bB>9MLi_;013EUd7@j#i
zWVW^uS?p)Eyh3`upuCs2eA@6x4(`NJO~hkvSw`c_GhbCKpbw_`HPbcjXMsELYZqui
zT0PvN;sk+~P-`{GQvXU`fekb%yKj)(PC<_O$d#;pI|jz?I6YUdLmu*m3)MTEU?O45
z`o^f+_=di{hDUX&i17s$#I0@9!;be}={yTB_bxiugcxn;C=>z<qzK4+F={p4$G~AU
zAw`JxI22<wC6{$V1nUuWb0d<GK6p$_uaR9GfLeR4hcXLoLN&nEZAi45WOnv&I_q22
zzQOo2S#{#}A+(NxYYkx^-(ZMxa_wWU+Yb;mhQY(v{@qlx;NC#kJQlXElPo*JcCLD&
z`i!4uWV*h$Isgo<r4^-Z^IBoAAYb#7p;0VqEAC!UYN>%;?8}nyUx#aWVGrTcPxMf0
z>9a1s@qkX({a>GZ|N9g2zfpqegq?R9uJN=Qu5`H%9+cl^8gywQxIQ$4af+5|zrzJt
z7>57^IcHYPAp>o9M~XJDuBRm*5YZs*noEduHvu2Cp_IXU${z#UO!M~uVB$=b>Bd#4
z?JI%30HL!>XZ8xxeUAwb;B-onw?=`UyH8yLWa#?;!w|yC?+MCE<|y;lDE?D@x<7))
zHIG#Qua1!V1vrg)D9_#cFBV0`3*()HJ+>W&)d7IX=3(cr>3F|8==XcG`GHprUYpMR
zyPmmY|1ywHh61;Lq}7YG@d;M(&t5{h-@!u;5V;^wX&&HJ=D{kHuJZ`q580rDW2E$|
zCsfN$N=izefgP-hcYaU(PxbWwgsA*mzJLYu-vAjR2_8C!1P6A&^%-HXkOb#DaKOrE
z9{_Z5Bc7RfBCTJRRiIxTL%Dw^O@YV0h|l7#ON2oe*PIme{M)$Z>Io|i2JXPoUK}Xg
z)uC$w@r=9;FkGQ%XQoT1;$e<j*(T=d3w<93aA<K3*dqx@L?Zc?sA6!}6rw7%Q@d-)
z97GIo9JZ3GDuJ6@7V@YH(xRCzN~I=l-Og3n-?V5<b!!5p1LktBbGrb{PqbzSJt6#E
zm=D)|faWihFwQ!c92FJSr<RNtn?h!bh8L@dsh`5GR+QcE!(?kd-dZeXGq$>MhAZsN
zfZw+-l$rBH+-Eh{c|yC($zBDj)vj^zpEX=p3G`UBsoLB}MO&y&&?E>i6rLD6&t|h3
zpDJA#Diy42hc9O~et!qkY<nun{9FP?R8q1pUC<BH^%W6IHWaN2>iUj&PVN$|+R&vt
zse{$pVB|(-Tr^i3BL=Ol8ocCgjKN^ep}*~5T+xQ+&fE$UOf(`ojZ{ws0S)JJh2HgX
zuwg_Kf5%+U)QFBfG8Sg&J3mg2pNw2uUM`?gsf{wif9x!rXhJ%qc2E)9HTKiHz7puJ
zABiNY_(MCWq#jbbN3>0EfBT_(s#vpw51yJD|6#F<eVwdX3`E?A`33oQ<ks^CHPs2~
zbtn?y_ZA*KNHNRQkp4~Q`d9uK*Mo(p9_$lB1})_8Xlv-}G5KTLX9^RGPepW3h75@-
zSwKB_bux+4ASxsIv>-`<S8&_I3B^XUBS)*SzO}hnIWsRrbduX<jG;ADl8)w=p*jmf
z6fWx^D^<5ie@7X4OwKu<ia$gGNgLn;Ju3oh21uS7jA@0qpv>?kGZ7D%+>W{CsZV(X
zWqK#v%=vUi(fl5BMXIl`C-Mw}@^)UIsVP>$e@wY+Fsn|Bj_TCT5B<w|5B;BTqM_GR
z_ZZ!VME!#n?c1qcgej!sg^TNc>Hxl+Saw~#Xk-o5A*m@`^+D{4Bo(VXhowDKOu_4r
zxCV(-9ldP_{^?=vBV1vm2x3TiRPEhIfdw{+vXGn0!V){2iiySV{gEOjq{s)`zI!{6
dA8>UYSN6d9Yk1!JQ!uZAOM1q-<vLDx{{a%SWcUC8

diff --git a/vignettes/qr-recode_values.png b/vignettes/qr-recode_values.png
deleted file mode 100644
index aed19a48cd6370b0780dc5b1b1903841003841dd..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 2390
zcmcgu`9Bj510ISo*Rn{ij7(!mLM+P6RhgsQXC;m1O9_)?^wOBCd#;H^%Q2LpNN(yg
z_D&4bCX}3M7+T@={txfx{oy(Pfamk1yJ8&VWDd#z0022BN3=TtAa;1yBY~2;Y{e|p
z-xaZFcLx-JKA=9g8}?kYakc>f>T*DTFYVpU(ov2+(Exya=YJvA8%YZR0DuclXq$`p
zz$LE2`Nuyrq<$HxC&}B%lYym!)cPy%2cbRT5$1kABtP|rcVqo0Kl=BW`DoKF$(f#b
zJruzVZ#%8Vs2nyuI>nsnx5yiZ_tYOQ_mHJYz41?$a5)eag<lqvO5kq<3Toe_myNvq
zxbdh(!2k1pqji}Y7gRhEt#Sf-D{kYEp58$;x|k8X<pPBsIrf<72$ww!eJEp_PJGef
z3WdJ<A65HmU2m?*m-JiEmU)+#Rl9_(+KG{+x2QM$5YW}Fh7{kb3Tz5vq*6=C+w{-%
zy7CIY2~Z|$Dj!{Zu?_WV)>}<;Cq}~84#*oCv?9P7%!5fZUVkL()|3iNL&V<<vC0Gd
zVO_X0K65g}GQl`0&gADZ4h;c{fyz=c!<r^l?K%9)*$XY)hADHcaMpK3QMs1zhPh;#
z;L`-XWYcI#WHNp1h-^8{al%XoY%xJXJ)M>ew-j1}onXNwkDp?@+LuogdKNTK?Yxs?
zWt<T;;{S4PzwvA?$O<Y*`vRM;oz@x=4DOKKc+FtqsWsKul66O`<7R(+TQa@W+!i?3
z;R&F#Nj@Y9V{7~l_^kuI-D1(;h?ZFiwlZibH?dxFt<(2vH+-w55{_#+{`}bq+u9;!
zAu1?w+tZ+eyFBFi&ecONFjC;+W)!Xvfc|8Sga}4|-_<c|T|~Nko3Vrx%?;)>2dJH0
zU2vT{?c6eYC~$;uFi|CTe3tAkv&AY4d@1(Uu65xBghO4sb-&4)-36LO#myAzFaG76
zFATd?(i1C@(24}PuqdTo$@FdQD*nj7t~S%N$HM)1KzZ>`+r!B#jmR}>@5j%n71N2e
zUG`tuc%ifrt{3M$7SffCh@Rw9GBrXKJb%9a%|*t6G8*D0&xVUz>lcv*N?$of#7v=T
zXu=azte4i~ZWGrJCK_}^DQ7hOi3rAzFISzQN!~Oo>tLAdPxuiZ_3NSMpuTBV-)1vS
zWpf@zIcT45iOIR!Msqau!F8o>6xGhLf}13URg(YqDh02djQTpHs9f!oR%s|#6c4V|
zi0Bk+zPpIWPA{bj@_a6z52G0o#WD4z^_VP8DLCIfmxB1&h&yV%*{-|he{+(H1u8ig
z64C}?V2G}JSfL>-KhXpjV}NTf_te=IrKpBhbEVH^sf?+HzHqn?C~<QP`ln-c{ciR9
zXi9X6e|=&%tGg4TDSib9T|pBK)0G*dEj%JtW`#nLp^D58AbdNoUZR21Jq$w4my5L8
zI$%?|76DAay)0tVq8Nn5J_>Jg-Qq_GYcO^gnwm$JNc(Q)D)a$wT!A#)SVJVhLB*L>
z7LtejzkDXWsk8Lh1C%|c*F80cH&WjbXdpGY_--=CO4*=Ccfiz2+5(iE0h-5sB+L@Q
z7mF4MjA+I3p%C17uI%cM8J=x1Of1o_sA}1+UCU4K<UW*v*ib;6jCt!)BVPB&*7bL1
zNZ}prtIVg?CgS`_@He9@TmFR`BKFS2EUIxcC@BUD%t$IsIb1i@StUS$t9|F%EkAsn
zN4>>X(}_pjZjfTb%iR=e>*{?`qvU*JRN)B1*H*S;OySNEj9f-R=CQOn1>w80itn75
z)$!bM3IE!O$%5Cv_EdQT)U9g<Iw0UXGMagjD**|k>G?X(>g*#cp{oUT+tywJhH=a~
zG-8bs{vh`Dp6t*ZGOSzYNB5o((isGNKcX0`WbR9^OQgEk?T!ZB*=D^!YjQGd5{hSX
z*K_eL>vC#U+07r`4>Mj^y+qbC%Dg;v=UIGe0f;xF3o+7Y7j5;|W;Li^Hd7RX(9bC$
z(y{G-8#>}|_tnE2xq7GLD#EnpiHE?a+mB_Wk35lQu$o_~WV6dCu4Fw@8?#VYx1jkc
zlbs{Dc1EN#Wk2jgZkF(f(e6_=F?h0yQ#(GO_KVsd?pH?9k&eVx&+%kCml{LMd2cXk
zpNI5^c(E?@(h#r{>f))_oPi#;J6rFcj1+-})Tf2|XZxIKgw%%zkGf4|MULgB9I?OG
zpz-J9Ju*boFgz{@mJd<ReAY@KJdDJQ6u;GyBtPrE!U{IZ!0^xCf7R!UZA(`2a^oFE
z-SAGH_LsQ1Q3>iJgxTn>+z!zH{YV0nBVP77SpvD>Hum$q2a+v))tlM$Zc+cV8G+et
z?08@LoTgmz_bQ+wTL%8~?kGRP!RO6#1=o@dWzQGIJRhu(98oOf=;6NbzNwHK^OUj*
zqs-;CAPCOA3-!wGW%w>ohnyo>eZF}ou7*0*kmv4P3BojrkhRCUdb7WN9gm&B583^l
zmS}AQ*Bi$OOIprmdTkBc=QMrbJ!1$ucxi)0a;+a=2&QeWBK>_PwqtJ=kjJwkrn4vJ
ziuVb7AMqc6b@RKV`f^0mA6;z~%bmfWNz&A9{A<-DO7V%<^-B@xo<If8ex`kc4^wt1
zaw5C&`8Ot@qD#uyltV18&PyIva1dpCeaO1aOYemCs+ZXGZLg@*E+I{V-KlrZ_Y>5O
z6XN6JQ)<d78?z4HI|GVUQ1hX^+lIz|@I3YVmDh*I_=>n|HKkpp&j%&QcH{Z0{?HZW
zFJa~1uDlu2UMdcR(4FlB;#=cqH%wbRXWDAG-B!c}dLXW&)BrO|aq4bJwbzf4^A;k_
zD=u9A_wUcTU)^=gTH<Y+L+96kivgM$uM_X}8U2AOSNyneZ+;_y=E{1R)3`Zqq8J&~
ze*05)^{|X#sSvUg%*8ieJxt8gW_QVW>x02O5`htkMsK8)pwaG^^uZ4<9yp8E-JiA(
h?3DU{s?dZT@tX#>PA!W4*53U>04F;PnvM!i`43IIeCYrH

diff --git a/vignettes/qr-survey_id.png b/vignettes/qr-survey_id.png
deleted file mode 100644
index 4f5e90c213f81db88f1150b3e6140d1ea65e4454..0000000000000000000000000000000000000000
GIT binary patch
literal 0
HcmV?d00001

literal 3192
zcmai%c{CJm7snCBU`UoMk&Lp9vem@Q*c-CM82eHh*^+%3g~}2$WF6Ue*^(u@k;yV9
zlL$>H+4r$cC|Q4g|GwwE@B7DdpXZ+MJ>PSlbMCq4bFn7I2u^?yfPsO5Q(sR9$-uz4
zfAW@OWjcwJiV@F~i_s5>&|;|S7g;_@m|ZlDG#MCb6W9+NSx#~`Z#`>21_of)zlV|R
zRp!LNz`?1nqlv;etYsQ`*dzGJMkdc$W(@RDa)4N;Q|5q*NUMvWK#vMm@#oy^r~pQS
zyh+MM{>l$Y$XaP-UA^x7&NnD=o2ctL;OmmSu@t0`qqpu%u_w~j*zSkE$gEK5LiSB1
zKlu9ipLM@A0b<+Mu&Mt*Uxt#)df)yeE$v4AG9-SM<8;+-{469QT(*4{(w{$t+knI?
zNj1-?ok)NaX_(A$A=jUVh}|FYv!h=qO;Avs`F556PxazSjj<Tozx(Z7x%ImPKBS;*
zc+XOdEzxS6m^*u76B;*owkfQ(`6-OdH|eu?zDUCJ@V?LSV`DYa@fKyZmQ?<<(n0)B
z3#~5U^FZQZ*fiLk*}=+6UGY7D|FEPlK@<iV`V`d_i9jqCMHt3!H$IE+YXFM4e%5vQ
zAt)y5o_N9CmFJs5;0Qe6iD$tcFIU<g^R31M(+}eVXIQMWaYi4$`?zLU{jjqSw$kGm
z?HU%&+KPSm+T)7FE2-Y;v0Ccqa<-rQo^eV=j<76Y^p&z4>&#qEM#z&W2sBO-B0lC5
z9Gg`s@X{;a{_41XPd}+7E#I?!1wc#1O_Jyfr$EN$LG@+_BNGl2PmY!c^3+=D>BNkN
z9m2rD{HGKb;^qnwzTMP&CmY@rCi`Ly)&Sj(CjEgna37X@74;i7{iCqVpA}u|CLh%`
zJ2)1W&sux~N9=kyX3;1Yt=3H_D_xiJQji4he;4P$mr1yulbsflG>o-G|8=&X&?g}z
zjYi(VP`NsHGo^0D=`Onjb9RDJN4p`$KYFhDWt&d+ZEkW4UjF93@xq2lSe;rn-%UZK
zORZk~LY)xcG6`ZDo3_mn>pv2XJVK<&!~NHxtcSY|)cw1`v!Pe}#{=Af4r}65ojaUg
z_Fxj0zoCPee!VrM5&60_yx6p^Lr!{a%`yc4<m1oE#J59vxU0Y2g1%4@sJiz!vGqQ(
zhR*Hkt$Sq_zc`z2B?Eer)Jk@3tR6k8DWniu4o>MhWVst8;EYRLqW5p<Z`T#4WJo6V
zmS$dW!M;rR(=Q8e`?-;W*_pk1d~WXOM@o9Y@iK`kuRCoo!o@3m|IP7%K>d*fd0}FI
zDa%pEZz)~7MMq9`|HDU64@isQZ9h;8a}R(LyR;b_p71@5^|9Xl7@odIe>tJgkou<3
zX1TokC_oLCS1Sb!^=wX^w_$JEY`&&oK=CwSoxLXg)<Qr$T>H{*_EemkS#@P3!lYc<
zQs&aVA<CV|u^CKw*_~i+jK9CK&T--EZWQzM15o{vM+YA{wg4iULyolGdbWyflL@y}
zQj{rO=)0@}*6Yz!#B&wpj@6G#rOKu6+MsRRmcB9{2@`(F2ENi#Q3G{6%w#{7tW+h}
zjDB1j1moSeQHGR`%P)*zO>+^6H2g4$8i4tZ-H7ijem%C;RphRmd_AdZK8gEfh-l~8
z7#JOe?Ycy+FW5RBhld4Y9adbvZN5I5PzP_o8V<%>CR+cv9mpKp4uC`V=q-opc?8-S
zCGobKD7mNnz9b(7Y$qACQ-~P3<Qm2!W;7m^j=x+!1WC@7N-5Jv65c&V;#U=K>!QsL
z?B1l#DU$h4muoSr@{N?<=9#d2*ld#VvFh}TIA}HN@Kz^}6OK+-4o@_D6yLNd<J7+u
z<53`?I-0$hrgZ6ko{X(WpgE@b@3IZcyvS%~9f_5%T!iKKQkPIQHDkz(WGM2SuVfpa
z2u<qez>@{BErsFv&9sg9L6hzj=U!SxuftFf&(&7rl|I!^$wu$`?_wi`P-wkQ#w=k2
zb4hbwYj6Xo9Rf-u*}$Xg*^J0@e>GWg9BvPJ^G2*x4o9u@aRZS%jZd5-rQqCqdUJun
zqD#Cw)tHLRFV=LTk8|)+g25*8m~dm_^htx65$$)6?pAjh97fTEgShU7l{I)z-jNTT
zdLkgzu2AT#foavg`ms_zdge1XnuEJ!gDo=FwEzveRe7`1?1Cz#Si^(ieuPYf3}>X<
z!q>;iL-=>5#ij+$c0k#=i1rm;or1uuXQ9-h<P~M#yb4>pC*fbEr5k8T!9t=gOrS<t
zE@U15Vg=iLVrHucG_kcf#x+M5?O0){tvvi`@1cq;u|C=2MeNJk<y}b*UXAxELKIx}
zW3(C?#Z#9t^Pt1qh}vi^F*m@{R~`3uVUZuWYD52fRPVJ~yc_&<*~UXbgn8S2z=n=e
zDU6sQ*3<xPj!6P(lgD%B+<U^bjn(7Ne3<g5%R4HV@-uJG6sQOPUPuEvv@X&FX46ZS
zsH_8WX5f!izyn@Dnw}#)(WD7y8iN!BoBjKDnO&O=A=Y~h1=m=m`uIYBO2ANqh910Q
zRE-q%=+rmZ3^jRR8R#QtU>ML0-3K27SHU#7uiSvXp7vKrdNwnx;d5U{N+n~qx7O`i
z(t9oYDBcz=ZD|z-PW*?Zm{3h)MSN<jtHm#?wn}Gn<xn3PoJ6;F4TgS$t!}DE&nm#D
z2j`e(I??IJ`t!Pea)`Dgx1c2>Mby29+VlJIdwICc?YgFxHQ#fLP^QyMb^HBc(<qgq
zoSEv$&JAx3+O&PH!wMJCf6Y%l>qpR>qJQYGsXl~QTg^s?U~||M!E53;^=-(T6ahKd
z&jJA_3l}X$4+UCNP_d$3dE6`cY3o!ZljYeP!p}x8#tcTtShEgucpARF(wiG6AYN$A
z`PCZIS1((0C(RwFBg1y_MTnYu0<T*|mcbnO8)Ijk8W6tyg~%AA5)IOlct|)4dy{TB
zkog{IugYr=D9;-0j>X?Xe5j`+dQgc~$%1UBZs066ZPC6w%~%!Rh=t^Jw3ViI>WsDo
zJfpearnZMkrqH@*_mQ%yMLVQX$ocuQg=KtcX_|GILy^61<NXFw&rF?oIt)=m`h_}s
z`Sec=P$%K0$OYHZUG<!{mPKr^NpN#}V<0V8B269RdOGq*DcWRQ>}FuV<f&@)U$bw#
z4|BZwLwDK@ASLYE?vXC9%K0PnUXJ(PxEJORit6^}D26oijCD%+Mc}R6GI(;$rRlls
zY>{|VzZgBb?VhN*i%R*fthYj~D_NHBbB8p6V=$g0C8ERa<<>FRoKzJ<weJpRJ9%Jj
zYO^9Zu<i~OTrzwSXcXwH!8Gt826`sMp94ZO4LFi>EP;N*Cw{NJsXFRG1Kb=E>A>dp
ziGN`a&tEMFDa+$1OukLk9%FL%zams&E*jNZeqxILtFK`%Y_R-Vv~^0AhE7*jN9*V#
z`R9vuTZ*BtDdvPqKsEJT_|qKh455}+_A4p+L64~ww!)5&+bf_M+%|du3kzTqM>dw;
zb)gt>#H4iJLj%u6S70iH294=?k00%%xmb8s61CT51xCVPffrWChGnN5vaO#kj0p=2
z%syQ_I{Zr=yh1Nk`+3p*G+y9U30&W;+%aIgh^0GTql{Cylh1BWs@S*mdA^}(HU7LC
zm!v_3%waoAFD`10f}LwjKh^t4@Rgd5RIy$_zDm4bR;It&9p8Hx$eA~*3ZQDqc_l|@
zwrnfVd<WGtL&LDJgc(8AHGXh1iR0#aii%R!;HS=8x>CG*yuW|NDnzE>h*jcF-!RDM
zn-a<^06Mi5Vv*`lWdQ6>T1||p|I3s8Shl*CZx$qsK4;x#Qqy@S2${C4t=a2&KDV?-
z{-6~KoE>{9=luNonv-2J=tWdCpr8V$n8VF(IiQ6}8W~82Qk>Y61Vy!wqWQOM!B-J@
zfXV(R7Qq<_#yJN#*NjQ8S!$2@FTUji^(F#)z_##3FT?yF%qr(oSEZZ$)^lr(_P@eX
z&(;0-67)j(L6fz~!O$OZPp4>6f)RP&*fL~ycg6cW5iI6nd64sf@VngBWW#G1Q7gXC
zZza9#N)=eVkmziA@Vl|;FfU21H|HpxXx2P4>C;Vo8MLz>$|oU7=(eM)*_;sUu-CsN
td@^tTKhVbi7j*s~RQ;dQc@NJcF=LF1>wH9I@yWKpps#DJQ>Aq;{2$ayHd+7x

diff --git a/vignettes/qualtrics-r-cookbook.Rmd b/vignettes/qualtrics-r-cookbook.Rmd
deleted file mode 100644
index 89a38de..0000000
--- a/vignettes/qualtrics-r-cookbook.Rmd
+++ /dev/null
@@ -1,187 +0,0 @@
----
-title: "TNTP Qualtrics/R Cookbook"
-output: html_document
-vignette: >
-  %\VignetteIndexEntry{TNTP Qualtrics/R Cookbook}
-  %\VignetteEngine{knitr::rmarkdown}
-  %\VignetteEncoding{UTF-8}
----
-
-```{r, include = FALSE}
-knitr::opts_chunk$set(
-  collapse = TRUE,
-  fig_caption = FALSE,
-  comment = "#>"
-)
-```
-## Introduction
-
-This vignette is designed to showcase best practices for setting up, pulling, and processing Qualtrics data in R. There are *many* different ways to accomplish these tasks, but we will lay out a recommended workflow that we believe to be the simplest and most flexible. This document will go through the following big ideas:
-
-1.  **Setup:** Installing the necessary packages
-2.  **Building Surveys:** Best practices in Qualtrics for creating surveys in a way that will help you analyze efficiently
-3.  **Qualtrics Authentication:** How to get an API token from Qualtrics and safely store it in R.
-4.  **Getting Data:** How to use the `qualtRics` package to pull survey data.
-5.  **Analysis:** Some common methods of analysis, including helpful functions from `tntpr`
-6.  **Advanced Tools:** A brief overview of the `QualtricsInR` and `httr2` packages and how they can be used to automate even more in Qualtrics.
-
-## Setup
-
-The main package you'll be using for interacting with Qualtrics is named `qualtRics` (get it?). We'll also be using some basic functionality from the tidyverse packages, and from `tntpr`. Make sure you've installed these packages first using `install.packages()` (or `devtools::install_github('tntp/tntpr')` for the `tntpr` package).
-
-```{r warning = FALSE, message = FALSE}
-library(qualtRics)
-library(tntpr)
-
-# NOTE: We are not simply loading `tidyverse` in this vignette due to how vignettes
-# are built to create the documentation website. In other contexts, however, we
-# would simply use `library(tidyverse)` instead of loading the following packages individually.
-library(dplyr)
-library(tidyr)
-library(purrr)
-library(forcats)
-library(lubridate)
-```
-
-## Building Surveys
-
-### General Survey-Building Advice
-
-*What makes a good survey question? How long should my survey be? How do I deal with distribution lists? Authentication?*
-
-These are all great questions, and they will **not** be answered in this vignette. For more guidance, check out the "Survey Resources" category in the Documents of the TNTP Data Analytics Sharepoint site. This vignette will focus only on the aspects of survey design that interact directly with R, specifically...
-
-### Question Codes
-
-When you create surveys in Qualtrics each question will come with a standard question code in the form `Q7` or `Q192`.
-
-![](qr-question_code.png "A bad question code")
-
-These question codes will eventually become the column headers of your data-frame in R, so we recommend setting them up in advance to be usable:
-
--   Follow tidyverse naming conventions (snake case, e.g. `styled_like_this`)
--   Avoid spaces and special characters (except for \_ and -)
--   Use standard prefixes or suffixes for questions you will want to group together in analysis. For example, using `id_name`, `id_school`, `id_district`, `id_email`, etc. allows you to easily pull all of those columns with the tidy-select statement `starts_with('id_')`
-
-For simple multiple choice and text-entry questions, you'll only need to edit the main question code as seen in the image above. However for more complicated question types you may need to adjust the Recode Values, Variable Naming, or Question Export Tags. You can access these settings by clicking on the question and finding the Recode Values button under Question Behavior:
-
-![](qr-recode_values.png "Recode values")
-
-Here's a quick rundown of how each question type behaves with recode values:
-
-- **Check all:** fill this out later...
-
-Once your survey is built and ready to go, you'll want to get data from it (well, after you collect responses of course). You *could* download the data as a .csv and then import that into R, but with a little bit of time on setup you can make the process much easier by just pulling directly from the **Qualtrics API**. The first step to getting your data is to get set up with...
-
-## Qualtrics Authentication
-
-This section will cover:
-1.  Getting a Qualtrics API Token
-1.  Storing your token securely in R
-1.  Accessing your token in R
-
-### Qualtrics API Token
-
-Follow these steps to get your API token:
-
-1. Log in to the TNTP Qualtrics site
-1. Click on your bubble in the top-right, and select "Account Settings"
-1. Go to the "Qualtrics IDs" tab
-1. Under the "API" heading click "Generate Token" and copy the resulting string of characters
-
-### Storing Credentials in R
-
-Your API Token should be treated and protected like a password. Just like you wouldn't write your computer password down on a post-it note next to your trackpad (you wouldn't do that, right?), you **should NOT** hard-code your token (or any other passwords / secrets) directly into your scripts, since they may be seen and used by other people.
-
-```{r}
-# BAD! DO NOT DO THIS!!!
-api_token <- 'abcdefghijklmnopqrstuvwxyz'
-```
-
-Instead we're going to save our token in a local file called `.Renviron` (which lives in your home directory and is not synced by Github, Bitbucket, or Sharepoint), and then pull it in from there.
-
-The qualtRics package provides an automated way to do this saving. Note that you should run the script below only one time and from the Console. **DON'T put it in your analysis script(s)** (otherwise you're defeating the whole point):
-
-```{r, eval = FALSE}
-# Run this ONCE from the console to save your credentials
-qualtrics_api_credentials(
-  api_key = "YOUR KEY HERE",
-  base_url = "tntp.co1.qualtrics.com",
-  install = TRUE
-)
-```
-
-### Accessing Credentials in R
-
-Once you've saved your credentials, you'll need to restart R (either close and re-open RStudio or run `.rs.restartR()`) and then you should be able to access your credentials using the `Sys.getenv()` command:
-
-```{r, eval = FALSE}
-Sys.getenv('QUALTRICS_API_KEY')
-Sys.getenv('QUALTRICS_BASE_URL')
-```
-
-From now on, these environmental variables will be available every time you open R. You can use this same process to store other tokens or passwords:
-
-```{r, eval = FALSE}
-# Open the .Renviron file
-usethis::edit_r_environ()
-
-# Add any values you want to the file in the format below and then save the file
-# MY_KEY_NAME = 'keyvalue'
-
-# Restart R / RStudio
-
-# Access variables from the .Renviron file
-my_key <- Sys.getenv('MY_KEY_NAME')
-```
-
-Congrats! You've now securely saved your Qualtrics credentials, and you're ready to start pulling down survey data!
-
-## Getting Data
-
-### Survey ID
-In addition to your survey data, you'll need the survey ID for the survey you are trying to pull. This ID will be in the form "SV_**********", and the easiest way to get it is by navigating to the survey in your browser and copying it from the URL bar:
-![](qr-survey_id.png "Survey ID in URL bar")
-
-You can also pull down all surveys you have access to using the `all_surveys()` function from `qualtRics`, and then filter that by name:
-```{r, eval = FALSE}
-surveys <- all_surveys()
-surveys |> 
-  filter(name == "FY24_tntpr_Example Survey")
-
-```
-
-Your survey ID is *not* a secret, so you can happily keep that value hard-coded at the top of your script
-
-### Pulling Survey Data
-Now that you have your authentication details saved in `.Renviron` and your survey id ready to go, it's time to pull a survey!
-
-```{r, eval = FALSE}
-survey_id <- 'SV_dbwpKPZ8Cw0CcEC'
-survey <- fetch_survey(survey_id, force_request = TRUE)
-```
-
-It's worth noting a few of the useful optional arguments in `fetch_survey()` (one of which we used above):
-
--   `force_request = TRUE` by default qualtRics saves the survey data for the session and will use that data when you call `fetch_survey()` again for the same id. This argument forces a fresh pull, which is useful when you're testing a script or if you want to make sure you have the most up-to-date data.
--   `start_date` and `end_date` can be used to limit the responses pulled by `RecordedDate`
--   `include_metadata = NA` or `include_embedded = NA` can be used to exclude metadata or embedded data columns. You can also run them with a character vector to include only certain columns: `include_metadata = c('RecipientEmail', 'RecordedDate')`
--   `label = FALSE` Enabling this option will pull recode values instead of text (e.g. `6` instead of `Strongly Agree`)
-
-# Pulling other data
-There are a bunch of other functions within the qualtRics package to pull other types of data, including:
-
--   `fetch_description()` for full survey data, including survey flow, options, scoring, etc.
--   `fetch_distributions()` to pull distributions for a survey
--   `fetch_distribution_history()` to pull history for an individual distribution
--   `fetch_mailinglist()` to pull a mailing list by mailing list ID
--   `survey_questions()` to pull information on each question in a survey. Similar to the `column_map` that is downloaded by `fetch_survey()` by default.
-
-## Analysis
-
-Finally it's time to dig into the data! We'll cover a few different common analysis tasks here, including:
-
-1.  Likert Matrix questions
-1.  
-
-## Advanced Tools

From dffc96870304070753f0f97061972dc421fbf38a Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Wed, 24 Jan 2024 14:02:32 -0500
Subject: [PATCH 29/30] Minor updates to comply with Roxygen 7.3

---
 DESCRIPTION      | 2 +-
 NAMESPACE        | 2 +-
 R/theme_tntp.R   | 2 +-
 R/tntpr.R        | 3 +--
 man/tntp_cred.Rd | 2 +-
 man/tntpr.Rd     | 8 ++++++++
 6 files changed, 13 insertions(+), 6 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 8509637..8e54765 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -50,5 +50,5 @@ VignetteBuilder:
     knitr
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.0
 Config/testthat/edition: 3
diff --git a/NAMESPACE b/NAMESPACE
index 645be9e..41521cd 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -40,6 +40,6 @@ export(tntp_style)
 export(update_geom_font_defaults)
 export(update_tntpr)
 importFrom(formattable,percent)
-importFrom(ggplot2,'%+replace%')
+importFrom(ggplot2,"%+replace%")
 importFrom(ggplot2,theme_minimal)
 importFrom(magrittr,"%>%")
diff --git a/R/theme_tntp.R b/R/theme_tntp.R
index e354fa5..46e6536 100644
--- a/R/theme_tntp.R
+++ b/R/theme_tntp.R
@@ -19,7 +19,7 @@
 #' @param caption_align alignment of caption, defaults to "right"; also accepts "left" or "center"
 #' @param caption_color color of caption text
 #' @param caption_size size of caption text
-#' @importFrom ggplot2 '%+replace%'
+#' @importFrom ggplot2 %+replace%
 #' @export
 #' @rdname theme_tntp
 
diff --git a/R/tntpr.R b/R/tntpr.R
index ff258ff..d15aa3f 100644
--- a/R/tntpr.R
+++ b/R/tntpr.R
@@ -3,9 +3,8 @@
 #' @description An in-house TNTP R package. Includes tools for data manipulation,
 #' analysis, and reporting, including making TNTP-themed charts and documents.
 #' By and for TNTP data-using staff, though available to the broader public.
-#' @docType package
 #' @aliases tntpr tntpr-package
 #' @importFrom ggplot2 theme_minimal
 #' @importFrom magrittr %>%
 #' @importFrom formattable percent
-NULL
+"_PACKAGE"
diff --git a/man/tntp_cred.Rd b/man/tntp_cred.Rd
index 4ab42fb..721da86 100644
--- a/man/tntp_cred.Rd
+++ b/man/tntp_cred.Rd
@@ -13,7 +13,7 @@ tntp_cred_set(
   username = NULL,
   keyring = NULL,
   prompt = NULL,
-  overwrite = NA
+  overwrite = NULL
 )
 
 tntp_cred_list(service = NULL, keyring = NULL)
diff --git a/man/tntpr.Rd b/man/tntpr.Rd
index 8fd0f48..e3d7e04 100644
--- a/man/tntpr.Rd
+++ b/man/tntpr.Rd
@@ -10,3 +10,11 @@ An in-house TNTP R package. Includes tools for data manipulation,
 analysis, and reporting, including making TNTP-themed charts and documents.
 By and for TNTP data-using staff, though available to the broader public.
 }
+\seealso{
+Useful links:
+\itemize{
+  \item \url{https://github.com/tntp/tntpr}
+  \item \url{https://tntp.github.io/tntpr/}
+}
+
+}

From 058957b42000905ea4dfff857b0b405f41158574 Mon Sep 17 00:00:00 2001
From: Sam Talcott <sam.talcott@tntp.org>
Date: Wed, 24 Jan 2024 14:08:10 -0500
Subject: [PATCH 30/30] Clarified comments, fixed one note

---
 R/tntp_cred.R | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/R/tntp_cred.R b/R/tntp_cred.R
index 868bf94..6cf340a 100644
--- a/R/tntp_cred.R
+++ b/R/tntp_cred.R
@@ -74,7 +74,7 @@ tntp_cred_set <- function(service = NULL, username = NULL, keyring = NULL, promp
 
   if(is.null(prompt)) prompt <- paste0("Enter credential for '", service, "': ")
 
-  # If overwrite is TRUE, skip to writing
+  # If overwrite is not TRUE, check for existing credential first
   if(!isTRUE(overwrite)) {
 
     # Check for existence of key by looking for an error in key_get()
@@ -88,12 +88,13 @@ tntp_cred_set <- function(service = NULL, username = NULL, keyring = NULL, promp
       if(isFALSE(overwrite)) cli::cli_abort(c("x" = "Credential already found for this service and username.",
                                              "i" = "To overwrite, run with parameter {.code overwrite = TRUE}"))
 
-      # If overwrite is anything else (NA), warn about duplicate and prompt to overwrite
+      # If overwrite is anything else (NULL), warn about duplicate and prompt to overwrite
       cli::cli_inform(c("i" = "Credential already found for this service and username. Overwrite?"))
-      if(select.list(c('Overwrite with new credential','Cancel')) == 'Cancel') cli::cli_abort("Credentials not updated")
+      if(utils::select.list(c('Overwrite with new credential','Cancel')) == 'Cancel') cli::cli_abort("Credentials not updated")
     }
   }
 
+  # Write credential
   keyring::key_set(service, username, keyring, prompt)
 
 }