Add more tests

DESCRIPTION

@@ -31,7 +31,8 @@ Imports:
     tidyr
 Suggests:
     covr,
-    testthat
+    testthat,
+    vdiffr
 Remotes:
     stitam/breakpoint
 License: GPL (>= 3)

R/filter_comparisons.R

@@ -49,8 +49,8 @@ filter_comparisons <- function(
   if (is.null(data)) {
     out <- comps |>
       dplyr::filter(
-        .data$pattern_id %in% filter_value |
-        .data$subject_id %in% filter_value
+        !!rlang::sym("pattern_id") %in% filter_value |
+        !!rlang::sym("subject_id") %in% filter_value
       )
     return(out)
   }

R/find_adapter.R

@@ -35,6 +35,7 @@ find_adapter <- function(
     )
     stop(msg)
   }
+  class(bps) <- class(bps)[-which(class(bps) == "breakpoints")]
   if (start_threshold < 0 | start_threshold > 1) {
     stop("start_threshold must be between 0 and 1.")
   }

R/find_all_adapters.R

@@ -6,7 +6,7 @@
 #' @param data data.frame; a data frame that contains IDs and sequences
 #' @param id_var character; variable within \code{data} that stores IDs.
 #' @param seq_var character; variable within \code{data} that stores sequences.
-#' @param submat character; the substitution matrix. See 
+#' @param submat character; the substitution matrix. See
 #' \code{position_scores()} for more information.
 #' @param method character; the method to use for finding breakpoints. Either
 #' "cemean", "plateau", or "window". See \code{find_breakpoints()} for more
@@ -42,8 +42,8 @@ find_all_adapters <- function(
   ) {
 
   pairs <- data |>
-    dplyr::filter(.data[[id_var]] %in% ids) |>
-    dplyr::pull(.data[[id_var]]) |>
+    dplyr::filter(!!rlang::sym(id_var) %in% ids) |>
+    dplyr::pull(!!rlang::sym(id_var)) |>
     utils::combn(2) |>
     t() |>
     as.data.frame()
@@ -106,7 +106,5 @@ find_all_adapters <- function(
         return(adapter)
     }
   }
-
-  class(adapters) <- c("adapter", class(adapters))
   return(adapters)
 }

R/find_breakpoints.R

@@ -234,15 +234,19 @@ find_breakpoints_window <- function(
     rep(ngroups + 1, times = nrow(position_scores$position_scores) - window*ngroups)
   )
   ms <- position_scores$position_scores %>%
-    dplyr::group_by(.data$group) %>%
+    dplyr::group_by(!!rlang::sym("group")) %>%
     dplyr::summarise(
       window = dplyr::n(),
-      mean = round(mean(.data$score), 3),
+      mean = round(mean(!!rlang::sym("score")), 3),
       identity_p = suppressWarnings(
-        stats::wilcox.test(as.numeric(.data$identity), alternative = "less", mu = pident_threshold)
+        stats::wilcox.test(
+          as.numeric(!!rlang::sym("identity")), 
+          alternative = "less", mu = pident_threshold)
       )$p.value,
       score_p = suppressWarnings(
-        stats::wilcox.test(.data$score, alternative = "less", mu = score_threshold)
+        stats::wilcox.test(
+          !!rlang::sym("score"), 
+          alternative = "less", mu = score_threshold)
       )$p.value
     )
   ms$pass <- ms$score_p >= p_threshold | ms$identity_p >= p_threshold

R/plot_adapter_matrix.R

@@ -3,7 +3,7 @@
 #' Take an adapter matrix and optionally data frame of cluster designations and
 #' plot them on a simple heatmap.
 #' @import ggplot2 patchwork
-#' @param x adapter_matrix; a matrix of class "adapter_matrix". Use 
+#' @param x adapter_matrix; a matrix of class "adapter_matrix". Use
 #' adapter_matrix() to create a compatible matrix.
 #' @param clusters data.frame; a table of RBP IDs and cluster designations.
 #' @param ... additional arguments (not used).
@@ -26,10 +26,13 @@ plot.adapter_matrix <- function(x, clusters = NULL, ...) {
   mat_long <- reshape2::melt(mat, value.name = "pident")
   p_main <- ggplot2::ggplot(
       mat_long,
-      ggplot2::aes(x = .data$Var1, y = .data$Var2, fill = .data$pident)
+      ggplot2::aes(
+        x = !!rlang::sym("Var1"), 
+        y = !!rlang::sym("Var2"),
+        fill = !!rlang::sym("pident"))
     ) +
     ggplot2::geom_tile(color = "black") +
-    ggplot2::geom_text(ggplot2::aes(label = round(.data$pident, 1))) +
+    ggplot2::geom_text(ggplot2::aes(label = round(!!rlang::sym("pident"), 1))) +
     ggplot2::scale_fill_gradient(low = "white", high = "salmon") +
     ggplot2::theme_minimal() +
     ggplot2::labs(x = "", y = "", fill = "") +
@@ -39,10 +42,13 @@ plot.adapter_matrix <- function(x, clusters = NULL, ...) {
     )
   if (is.null(clusters)) return(p_main)
   row_anno <- clusters |>
-    dplyr::rename(Var2 = .data$id) |>
-    dplyr::mutate(Var2 = factor(.data$Var2, levels = unique(mat_long$Var2)))
+    dplyr::rename(Var2 = !!rlang::sym("id")) |>
+    dplyr::mutate(
+      Var2 = factor(!!rlang::sym("Var2"), levels = unique(mat_long$Var2)))
   p_row <- ggplot2::ggplot(
-    row_anno, ggplot2::aes(x = 1, y = .data$Var2, fill = .data$cluster)) +
+    row_anno, 
+    ggplot2::aes(
+      x = 1, y = !!rlang::sym("Var2"), fill = !!rlang::sym("cluster"))) +
     ggplot2::geom_tile() +
     ggplot2::scale_y_discrete(
       limits = levels(mat_long$Var2), expand = c(0, 0)) +
@@ -55,10 +61,10 @@ plot.adapter_matrix <- function(x, clusters = NULL, ...) {
       legend.position = "none"
     )
   col_anno <- clusters |>
-    dplyr::rename(Var1 = .data$id) |>
-    dplyr::mutate(Var1 = factor(.data$Var1, levels = unique(mat_long$Var1)))
+    dplyr::rename(Var1 = !!rlang::sym("id")) |>
+    dplyr::mutate(Var1 = factor(!!rlang::sym("Var1"), levels = unique(mat_long$Var1)))
   p_col <- ggplot2::ggplot(
-    col_anno, ggplot2::aes(x = .data$Var1, y = 1, fill = .data$cluster)) +
+    col_anno, ggplot2::aes(x = !!rlang::sym("Var1"), y = 1, fill = !!rlang::sym("cluster"))) +
     ggplot2::geom_tile() +
     ggplot2::scale_x_discrete(limits = levels(mat_long$Var1), expand = c(0, 0)) +
     ggplot2::scale_y_discrete(expand = c(0, 0)) +

R/plot_position_scores.R

@@ -119,16 +119,16 @@ plot.ps <- function(
       values_to = "position"
     ) %>%
     dplyr::arrange("position") %>%
-    dplyr::filter(.data$method %in% .env$method)
+    dplyr::filter(!!rlang::sym("method") %in% .env$method)
   if (is.null(highlight)) {
     highlight_value <- end_long |>
-      dplyr::pull(.data$position) |>
+      dplyr::pull(!!rlang::sym("position")) |>
       stats::na.omit() |>
       max()
   } else {
     highlight_value <- end_long |>
-      dplyr::filter(.data$method == highlight) |>
-      dplyr::pull(.data$position)
+      dplyr::filter(!!rlang::sym("method") == highlight) |>
+      dplyr::pull(!!rlang::sym("position"))
   }
   # moving averages
   avg <- vector()
@@ -153,26 +153,26 @@ plot.ps <- function(
     )
   }
   if (type == "indiv") {
-    g <- ggplot(res, aes(.data$position, .data$score))
+    g <- ggplot(res, aes(!!rlang::sym("position"), !!rlang::sym("score")))
   }
   if (type == "ma") {
-    g <- ggplot(res, aes(.data$position, .data$ma))
+    g <- ggplot(res, aes(!!rlang::sym("position"), !!rlang::sym("ma")))
   }
   if (type == "cusum") {
-    g <- ggplot(res, aes(.data$position, .data$cumsum))
+    g <- ggplot(res, aes(!!rlang::sym("position"), !!rlang::sym("cumsum")))
   }
   g <- g +
-    geom_point(aes(color = .data$domain), alpha = 0.5) +
+    geom_point(aes(color = !!rlang::sym("domain")), alpha = 0.5) +
     scale_color_manual(
       values = c("N-terminal" = "red", "C-terminal" = "blue"),
       na.translate = FALSE
     ) +
     geom_vline(
       data = end_long,
       aes(
-        xintercept = .data$position,
-        group = .data$method,
-        linetype = .data$method
+        xintercept = !!rlang::sym("position"),
+        group = !!rlang::sym("method"),
+        linetype = !!rlang::sym("method")
       ),
       key_glyph = "path"
     )

R/position_scores.R

@@ -42,7 +42,7 @@ position_scores <- function(
   if (!subject_id %in% data[[id_var]]) {
     stop(paste0("Subject ID not found: ", subject_id))
   }
-  df <- data |> dplyr::filter(.data[[id_var]] %in% c(pattern_id, subject_id))
+  df <- data |> dplyr::filter(!!rlang::sym(id_var) %in% c(pattern_id, subject_id))
   df[[seq_var]] <- gsub("\\*", "", df[[seq_var]])
   valid_input <- validate_rbps(
     df, id_var = id_var, seq_var = seq_var, verbose = verbose

README.md

@@ -8,7 +8,7 @@
 [![status](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)
 [![R build
 status](https://github.com/sbthandras/tailor/workflows/R-CMD-check/badge.svg)](https://github.com/sbthandras/tailor/actions)
-[![Coverage](https://img.shields.io/badge/coverage-12.1%25-red)](#test-coverage)
+[![Coverage](https://img.shields.io/badge/coverage-56.1%25-orange)](#test-coverage)
 [![DOI](https://img.shields.io/badge/DOI-10.64898%2F2026.02.20.706991-blue)](https://doi.org/10.64898/2026.02.20.706991)
 
 <!-- badges: end -->