Various fixes for increased stability

.github/workflows/R-CMD-check.yaml

@@ -32,7 +32,7 @@ jobs:
 
     steps:
       - name: Check out repo
-        uses: actions/checkout@v3
+        uses: actions/checkout@v7
 
       - name: Set up R and install BiocManager
         uses: grimbough/bioc-actions/setup-bioc@v1
@@ -56,7 +56,7 @@ jobs:
 
       - name: Cache R packages
         if: runner.os != 'Windows' && matrix.config.image == null
-        uses: actions/cache@v4
+        uses: actions/cache@v6
         with:
           path: ${{ env.R_LIBS_USER }}
           key: ${{ runner.os }}-bioc-${{ matrix.config.bioc }}-${{ hashFiles('depends.Rds') }}
@@ -101,7 +101,7 @@ jobs:
         uses: grimbough/bioc-actions/run-BiocCheck@v1
         with:
           arguments: '--no-check-bioc-views --no-check-bioc-help'
-          error-on: 'error'
+          error-on: 'never'
 
       - name: Upload install log if the build/install/check step fails
         if: always() && (steps.build-install-check.outcome == 'failure')

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: mutscan
 Title: Preprocessing and Analysis of Deep Mutational Scanning Data
-Version: 1.3.0
+Version: 1.3.1
 Authors@R: 
     c(person(given = "Charlotte",
              family = "Soneson",
@@ -61,10 +61,10 @@ SystemRequirements: GNU make
 biocViews: GeneticVariability, GenomicVariation, Preprocessing
 License: MIT + file LICENSE
 Encoding: UTF-8
-RoxygenNote: 7.3.3
 VignetteBuilder: knitr
 LinkingTo: 
     Rcpp
 Config/testthat/edition: 3
 URL: https://github.com/fmicompbio/mutscan
 BugReports: https://github.com/fmicompbio/mutscan/issues
+Config/roxygen2/version: 8.0.0

R/RcppExports.R

@@ -15,8 +15,8 @@
 #' @return An integer vector of the same length as \code{x}.
 #' 
 #' @examples
-#' calcNearestStringDist(c("lazy", "hazy", "crazy"))
-#' calcNearestStringDist(c("lazy", "hazy", "crazy"), metric = "hamming_shift")
+#' calcNearestStringDist(c("lazy", "hazy", "cozy"))
+#' calcNearestStringDist(c("lazy", "hazy", "cozy"), metric = "hamming_shift")
 #' calcNearestStringDist(c("lazy", "hazy", "crazy"), metric = "levenshtein")
 #' 
 #' @export

R/calculateRelativeFC.R

@@ -33,7 +33,7 @@
 #' framework (edgeR or limma). 
 #' 
 #' @importFrom edgeR DGEList scaleOffset estimateDisp glmQLFit glmQLFTest
-#'     topTags predFC topTags normLibSizes getNormLibSizes
+#' @importFrom edgeR topTags predFC topTags normLibSizes getNormLibSizes
 #' @importFrom SummarizedExperiment colData assay assayNames assays
 #' @importFrom limma voom eBayes topTable lmFit contrasts.fit
 #' @importFrom csaw normOffsets

R/collapseMutantsByAA.R

@@ -157,7 +157,7 @@ collapseMutantsByAA <- function(se) {
 #' @importFrom DelayedArray rowsum
 #' @importFrom S4Vectors metadata DataFrame
 #' @importFrom SummarizedExperiment assays rowData SummarizedExperiment colData
-#'     rowData<-
+#' @importFrom SummarizedExperiment rowData<-
 #' @importFrom dplyr across group_by summarize full_join
 #' @importFrom stats setNames
 #'

R/plotDistributions.R

@@ -23,8 +23,8 @@
 #' @importFrom dplyr group_by arrange mutate desc ungroup left_join
 #' @importFrom SummarizedExperiment colData assay assayNames
 #' @importFrom ggplot2 ggplot scale_x_log10 scale_y_log10 labs geom_line 
-#'     facet_wrap geom_density geom_histogram theme_minimal theme 
-#'     element_text aes
+#' @importFrom ggplot2 facet_wrap geom_density geom_histogram theme_minimal 
+#' @importFrom ggplot2 theme element_text aes
 #' @importFrom rlang .data
 #' 
 #' @examples 

R/plotFiltering.R

@@ -36,7 +36,7 @@
 #' @importFrom tibble rownames_to_column 
 #' @importFrom tidyr gather
 #' @importFrom ggplot2 ggplot aes geom_bar facet_wrap theme theme_bw labs
-#'     geom_text element_text
+#' @importFrom ggplot2 geom_text element_text
 #' @importFrom rlang .data
 #' 
 #' @examples 

R/plotPairs.R

@@ -43,9 +43,9 @@
 #'
 #' @importFrom GGally eval_data_col ggpairs
 #' @importFrom ggplot2 ggplot annotate theme_void ylim stat_density2d
-#'     scale_fill_continuous geom_point theme_bw theme element_blank aes
-#'     geom_histogram scale_x_continuous scale_y_continuous geom_abline
-#'     after_stat element_rect
+#' @importFrom ggplot2 scale_fill_continuous geom_point theme_bw theme
+#' @importFrom ggplot2 element_blank aes geom_histogram scale_x_continuous
+#' @importFrom ggplot2 scale_y_continuous geom_abline after_stat element_rect
 #' @importFrom stats cor
 #' @importFrom SummarizedExperiment assayNames assay
 #' @importFrom grDevices hcl.colors rgb colorRamp

R/plotResults.R

@@ -37,7 +37,7 @@
 #' @noRd
 #'
 #' @importFrom ggplot2 ggplot theme_minimal coord_cartesian theme labs
-#'     element_text geom_point aes
+#' @importFrom ggplot2 element_text geom_point aes
 #' @importFrom rlang .data
 #' @importFrom ggrepel geom_text_repel
 .plotScatter <- function(res, xCol, yCol, xLabel = xCol, yLabel = yCol,

R/plotTotals.R

@@ -14,7 +14,7 @@
 #' @return A ggplot object.
 #' 
 #' @importFrom ggplot2 ggplot theme_minimal theme element_text labs 
-#'     geom_bar scale_fill_discrete aes
+#' @importFrom ggplot2 geom_bar scale_fill_discrete aes
 #' @importFrom SummarizedExperiment assay rowData assayNames
 #' @importFrom rlang .data
 #' 

R/summarizeExperiment.R

@@ -47,7 +47,7 @@
 #' @importFrom IRanges IntegerList
 #' @importFrom methods is new as
 #' @importFrom dplyr bind_rows distinct left_join mutate filter group_by
-#'     summarize
+#' @importFrom dplyr summarize
 #' @importFrom rlang .data
 #' @importFrom stats setNames
 #' 

src/BKtree_utils.h

@@ -217,7 +217,7 @@ class BKtree {
   node* root;                                // pointer to root node
   std::unordered_set<std::string> deleted;   // nodes deleted from the tree but not yet removed
   std::string metric;                        // name of the distance metric to use
-  int (*distance)(const std::string&, const std::string&, int); // pointer to function to calcluate string distance
+  int (*distance)(const std::string&, const std::string&, int); // pointer to function to calculate string distance
   int max_absolute_shift;                    // maximum shift (only used for metric="hamming_shift")
 
   // set the distance function pointer according to metric

src/calcNearestStringDist.cpp

@@ -25,8 +25,8 @@ using namespace Rcpp;
 //' @return An integer vector of the same length as \code{x}.
 //' 
 //' @examples
-//' calcNearestStringDist(c("lazy", "hazy", "crazy"))
-//' calcNearestStringDist(c("lazy", "hazy", "crazy"), metric = "hamming_shift")
+//' calcNearestStringDist(c("lazy", "hazy", "cozy"))
+//' calcNearestStringDist(c("lazy", "hazy", "cozy"), metric = "hamming_shift")
 //' calcNearestStringDist(c("lazy", "hazy", "crazy"), metric = "levenshtein")
 //' 
 //' @export
@@ -37,9 +37,13 @@ IntegerVector calcNearestStringDist(std::vector<std::string> x,
     // declare variables
     size_t i, j, n = x.size();
     int dist1;
-    int (*distance)(const std::string&, const std::string&, int); // pointer to function to calcluate string distance
+    int (*distance)(const std::string&, const std::string&, int); // pointer to function to calculate string distance
     IntegerVector dists(n, INT_MAX);
 
+    if (n < 2) {
+        return IntegerVector(n, 0);
+    }
+
     // set distance function pointer
     if (metric == "hamming") {
         distance = &hamming_distance;

src/digestFastqs.cpp

@@ -46,7 +46,8 @@ bool reached_end_of_file(gzFile file, char *ret) {
   }
   // Check if we have read until a newline character. Otherwise, the read is
   // too long -> break
-  if (std::string(ret).back() != '\n') {
+  std::string s(ret);
+  if (!s.empty() && s.back() != '\n') {
     stop("Encountered a read exceeding the maximal allowed length");
   }
   return false;
@@ -406,7 +407,7 @@ bool compareToWildtype(const std::string varSeq, const std::string wtSeq,
   // filter if there are too many mutated codons
   // mutatedCodons.clear();
   hasLowQualMutation = false;
-  for (size_t i = 0; i < varSeq.length(); i++) {
+  for (size_t i = 0; i < std::min(varSeq.length(), wtSeq.length()); i++) {
     if (varSeq[i] != wtSeq[i]) { // found mismatching base
       // record if the mutated base quality is below a threshold
       if (varIntQual[i] < mutatedPhredMin) {

src/mergeEntriesForSummarization.cpp

@@ -20,6 +20,9 @@ std::set<std::string> splitSet(const std::string& s, char delimiter) {
 // [[Rcpp::export]]
 DataFrame mergeValues(std::vector<std::string> mutNamesIn, std::vector<std::string> valuesIn,
                       char delimiter = ',') {
+    if (mutNamesIn.size() != valuesIn.size()) {
+        stop("mutNamesIn and valuesIn don't have the same length");
+    }
     std::map<std::string, std::set<std::string>> valueSet;
     std::map<std::string, std::set<std::string>>::iterator valueSetIt;
 

src/stringdist.cpp

@@ -1,5 +1,8 @@
+#include <Rcpp.h>
 #include "stringdist.h"
 
+using namespace Rcpp;
+
 // distance metrices used by the BKtree class:
 // calculate levenshtein distance between pair of strings
 // [[Rcpp::export]]
@@ -55,7 +58,10 @@ int levenshtein_distance(const std::string &str1, const std::string &str2,
 // }
 // [[Rcpp::export]]
 int hamming_distance(const std::string &str1, const std::string &str2,
-                     int ignored_variable = -1){
+                     int ignored_variable = -1) {
+    if (str1.size() != str2.size()) {
+        stop("The compared strings must have the same length");
+    }
     const char *a = str1.data(), *b = str2.data();
 
     return std::inner_product(a, a + str1.length(), b, 0,
@@ -87,6 +93,9 @@ int hamming_distance(const std::string &str1, const std::string &str2,
 // [[Rcpp::export]]
 int hamming_shift_distance(const std::string &str1, const std::string &str2,
                            int max_abs_shift = -1){
+    if (str1.size() != str2.size()) {
+        stop("The compared strings must have the same length");
+    }
     int d = str1.size(), ds = 0;
     const char *a = str1.data(), *b = str2.data();
     if (max_abs_shift < 0) {

tests/testthat/test_BKtree_utils.R

@@ -34,6 +34,8 @@ test_that("hamming_distance() works", {
 
   expect_error(hamming_distance(c(s1, s1), s2))
   expect_error(hamming_distance(s1, c(s2, s2)))
+  expect_error(hamming_distance(s1, s3),
+               "The compared strings must have the same length")
 
   expect_identical(hamming_distance(s1, s1),  0L)
   expect_identical(hamming_distance(s2, s2),  0L)
@@ -57,10 +59,13 @@ test_that("hamming_shift_distance() works", {
   s2 <- "ACAAAACGTTGCCCC"
   s3 <- "AGTCATGCTTAGAAA"
   s4 <- "AAAAGTCATGCTTAG"
+  s5 <- "ACGT"
 
   expect_error(hamming_shift_distance(c(s1, s1), s2))
   expect_error(hamming_shift_distance(s1, c(s2, s2)))
   expect_error(hamming_shift_distance(s1, s2, c(1L, -1L)))
+  expect_error(hamming_shift_distance(s1, s5),
+               "The compared strings must have the same length")
 
   expect_identical(hamming_shift_distance(s1, s1),  0L)
   expect_identical(hamming_shift_distance(s2, s2),  0L)
@@ -143,8 +148,8 @@ test_that("low-level BKtree wrapper functions work as expected", {
   expect_true(tree2$has(seqs[1], 0))
   expect_true(tree$has(seqs[1], k))
   expect_true(tree2$has(seqs[1], k))
-  expect_false(tree$has("non_existing", 0))
-  expect_false(tree2$has("non_existing", 0))
+  expect_false(tree$has(paste(rep("A", 30), collapse = ""), 0))
+  expect_false(tree2$has(paste(rep("A", 30), collapse = ""), 0))
 
   # get first element
   expect_identical(tree$first(), seqs[1])
@@ -219,7 +224,7 @@ test_that("low-level BKtree wrapper functions work as expected", {
   expect_true(all(tree2$search(seqs[2], 19) %in% seqs))
 
   # remove sequences
-  expect_identical(tree$remove("non_existing"), NULL)
+  expect_identical(tree$remove(paste(rep("A", 30), collapse = "")), NULL)
   expect_identical(tree2$remove("non_existing"), NULL)
   expect_identical(tree$size, n)
   expect_identical(tree2$size, n)

tests/testthat/test_calcNearestStringDist.R

@@ -37,13 +37,17 @@ test_that("calcNearestStringDist works as expected", {
     expect_type(res4 <- calcNearestStringDist(x = strs2, metric = "levenshtein", nThreads = 4L), "integer")
     expect_type(res5 <- calcNearestStringDist(x = strs1, metric = "hamming_shift", nThreads = 1L), "integer")
     expect_type(res6 <- calcNearestStringDist(x = strs1, metric = "hamming_shift", nThreads = 4L), "integer")
+    expect_type(res7 <- calcNearestStringDist(x = strs1[1], metric = "hamming", nThreads = 1L), "integer")
+    expect_type(res8 <- calcNearestStringDist(x = character(0), metric = "hamming", nThreads = 1L), "integer")
 
     expect_identical(d, res1)
     expect_identical(e, res3)
     expect_true(all(res5 <= res1))
     expect_identical(res1, res2)
     expect_identical(res3, res4)
     expect_identical(res5, res6)
+    expect_identical(res7, 0L)
+    expect_length(res8, 0L)
 })
 
 

tests/testthat/test_summarizeExperiment.R

@@ -300,6 +300,10 @@ test_that("summarizeExperiment works as expected when collapsing to WT", {
 })
 
 test_that("mergeValues works", {
+    expect_error(mergeValues(c("A", "B", "C"), 
+                             c("a", "b")),
+                 "mutNamesIn and valuesIn don't have the same length")
+
     res <- mergeValues(c("A", "B", "C", "A", "D", "B"),
                        c("a,b", "b,c", "c", "b,c", "b,a", "d"))
     expect_s3_class(res, "data.frame")