@@ -2,6 +2,20 @@

 title: "NEWS"

 output: github_document

 ---

+# ISAnalytics <version>

+

+## BUG FIXES AND MINOR CHANGES

+

+* Fixed minor issue in `compute_near_integrations()` - function errored when

+`report_path` argument was set to `NULL`

+* Fixed dplyr warning in `integration_alluvial_plot()` internals

+* Fixed issue with report of VISPA2 stats - report failed due to minor error

+in rmd fragment

+* Internals of `remove_collisions()` use again dplyr internally for joining

+and grouping operations - needed because of performance issues with data.table

+* `fisher_scatterplot()` has 2 new arguments that allow the disabling of 

+highlighting for some genes even if their p-value is under the threshold

+

 # ISAnalytics 1.5.4 (2022-04-20)

 ## MAJOR CHANGES

@@ -146,11 +146,14 @@ remove_collisions <- function(x,

     replicate_n_col <- req_tag_cols[eval(sym("tag")) ==

         "pcr_replicate"][["names"]]

     pool_col <- req_tag_cols[eval(sym("tag")) == "pool_id"][["names"]]

-    joined <- association_file[pre_process, on = pcr_col]

-    joined <- joined[, mget(c(

-        colnames(pre_process), date_col,

-        replicate_n_col, independent_sample_id, pool_col

-    ))]

+    joined <- pre_process %>%

+      dplyr::left_join(association_file, by = pcr_col) %>%

+      dplyr::select(dplyr::all_of(

+        c(

+          colnames(pre_process), date_col,

+          replicate_n_col, independent_sample_id, pool_col

+        )

+      ))

     if (verbose) {

         rlang::inform("Identifying collisions...")

     }

@@ -2893,7 +2893,8 @@

     distinct_is <- purrr::map2_int(matrices, correct, ~ {

         if (.y) {

             .x %>%

-                dplyr::distinct(dplyr::across(dplyr::all_of(mandatory_IS_vars()))) %>%

+                dplyr::distinct(dplyr::across(

+                  dplyr::all_of(mandatory_IS_vars()))) %>%

                 nrow()

         } else {

             NA_integer_

@@ -3102,17 +3103,19 @@

 #' @importFrom rlang .data sym

 .check_same_info <- function(association_file, df, req_tag_cols,

     indep_sample_id) {

-    association_file <- data.table::setDT(association_file)

-    df <- data.table::setDT(df)

-    req_tag_cols <- data.table::setDT(req_tag_cols)

-    joined <- df[association_file, on = pcr_id_column()]

-    predicate <- purrr::map(mandatory_IS_vars(), ~ {

-        rlang::expr(!is.na(!!sym(.x)))

-    }) %>% purrr::reduce(~ rlang::expr(!!.x & !!.y))

+    data.table::setDT(req_tag_cols)

+    joined <- association_file %>%

+      dplyr::left_join(df, by = pcr_id_column())

     proj_col_name <- req_tag_cols[eval(rlang::expr(

         !!sym("tag") == "project_id"

     ))][["names"]]

-    projects <- unique(joined[eval(predicate), ][[proj_col_name]])

+    projects <- joined %>%

+      dplyr::filter(!dplyr::if_all(

+        .cols = dplyr::all_of(mandatory_IS_vars()),

+        .fns = is.na

+      )) %>%

+      dplyr::distinct(.data[[proj_col_name]]) %>%

+      dplyr::pull(.data[[proj_col_name]])

     wanted_tags <- c(

         "subject", "tissue", "cell_marker", "tp_days"

     )

@@ -3121,15 +3124,22 @@

     wanted <- wanted[eval(sym("tag")) %in% wanted_tags &

         eval(sym("names")) %in% colnames(association_file), ]

     wanted <- data.table::rbindlist(list(req_tag_cols, wanted))

-    predicate <- purrr::map(mandatory_IS_vars(), ~ {

-        rlang::expr(is.na(!!sym(.x)))

-    }) %>% purrr::reduce(~ rlang::expr(!!.x & !!.y))

-    predicate <- rlang::expr(!!predicate & !!sym(proj_col_name) %in% projects)

-    missing_in_df <- unique(joined[

-        eval(predicate),

-        mget(unique(c(wanted$names, indep_sample_id)))

-    ])

-    reduced_af <- association_file[eval(sym(proj_col_name)) %in% projects]

+    missing_in_df <- joined %>%

+      dplyr::filter(

+        dplyr::if_all(

+          .cols = dplyr::all_of(mandatory_IS_vars()),

+          .fns = is.na

+          ) & .data[[proj_col_name]] %in% projects

+      ) %>%

+      dplyr::distinct(dplyr::across(

+        dplyr::all_of(c(wanted$names, indep_sample_id))

+        ))

+    reduced_af <- association_file %>%

+      dplyr::filter(

+        .data[[proj_col_name]] %in% projects

+      )

+    data.table::setDT(reduced_af)

+    data.table::setDT(missing_in_df)

     list(miss = missing_in_df, reduced_af = reduced_af)

 }

@@ -3141,14 +3151,21 @@

 # @return A named list containing the splitted joined_df for collisions and

 # non-collisions

 .identify_independent_samples <- function(joined, indep_sample_id) {

-    temp <- joined[, mget(c(mandatory_IS_vars(), indep_sample_id))]

-    temp <- temp[, unique(.SD, by = indep_sample_id),

-        by = eval(mandatory_IS_vars())

-    ]

-    temp <- temp[, .N, by = eval(mandatory_IS_vars())]

-    temp <- temp[eval(sym("N")) > 1, mget(mandatory_IS_vars())]

-    non_collisions <- joined[!temp, on = mandatory_IS_vars()]

-    collisions <- joined[temp, on = mandatory_IS_vars()]

+    indep_syms <- purrr::map(indep_sample_id, rlang::sym)

+    temp <- joined %>%

+      dplyr::select(dplyr::all_of(

+        c(mandatory_IS_vars(), indep_sample_id)

+      )) %>%

+      dplyr::group_by(dplyr::across(dplyr::all_of(mandatory_IS_vars()))) %>%

+      dplyr::summarise(N = dplyr::n_distinct(!!!indep_syms),

+                       .groups = "drop") %>%

+      dplyr::filter(.data$N > 1)

+    non_collisions <- joined %>%

+      dplyr::anti_join(temp, by = mandatory_IS_vars())

+    collisions <- joined %>%

+      dplyr::semi_join(temp, by = mandatory_IS_vars())

+    data.table::setDT(non_collisions)

+    data.table::setDT(collisions)

     list(collisions = collisions, non_collisions = non_collisions)

 }

@@ -3183,7 +3200,9 @@

     }

     winning_sample <- x[1, mget(ind_sample_key)]

     # Filter the winning rows

-    x <- x[winning_sample, on = ind_sample_key]

+    x <- x %>%

+      dplyr::semi_join(winning_sample, by = ind_sample_key)

+    data.table::setDT(x)

     return(list(data = x, check = TRUE))

 }

@@ -3207,14 +3226,18 @@

 # * $check: a logical value indicating whether the analysis was successful or

 # not (and therefore there is the need to perform the next step)

 .discriminate_by_replicate <- function(x, repl_col, ind_sample_key) {

-    temp <- x[, .N, by = eval(ind_sample_key)]

-    temp <- dplyr::arrange(temp, dplyr::desc(.data$N))

-

+    temp <- x %>%

+      dplyr::group_by(dplyr::across(dplyr::all_of(ind_sample_key))) %>%

+      dplyr::summarise(N = dplyr::n(), .groups = "drop") %>%

+      dplyr::arrange(dplyr::desc(.data$N))

+    data.table::setDT(temp)

     if (length(temp$N) != 1 & !temp$N[1] > temp$N[2]) {

         return(list(data = x, check = FALSE))

     }

     temp <- temp[1, mget(ind_sample_key)]

-    x <- x[temp, on = ind_sample_key]

+    x <- x %>%

+      dplyr::semi_join(temp, by = ind_sample_key)

+    data.table::setDT(x)

     return(list(data = x, check = TRUE))

 }

@@ -3243,14 +3266,19 @@

     reads_ratio,

     seqCount_col,

     ind_sample_key) {

-    temp <- x[, list(sum = sum(.SD[[seqCount_col]])), by = eval(ind_sample_key)]

-    temp <- dplyr::arrange(temp, dplyr::desc(.data$sum))

+    temp <- x %>%

+      dplyr::group_by(dplyr::across(dplyr::all_of(ind_sample_key))) %>%

+      dplyr::summarise(sum = sum(.data[[seqCount_col]]), .groups = "drop") %>%

+      dplyr::arrange(dplyr::desc(.data$sum))

+    data.table::setDT(temp)

     ratio <- temp$sum[1] / temp$sum[2]

     if (!ratio > reads_ratio) {

         return(list(data = x, check = FALSE))

     }

     temp <- temp[1, mget(ind_sample_key)]

-    x <- x[temp, on = ind_sample_key]

+    x <- x %>%

+      dplyr::semi_join(temp, by = ind_sample_key)

+    data.table::setDT(x)

     return(list(data = x, check = TRUE))

 }

@@ -137,7 +137,12 @@ outlier_filter <- function(metadata,

         call_test <- function(test, vargs, df, test_name) {

             test_args_names <- do.call(rlang::fn_fmls_names, args = list(test))

             test_args_names <- test_args_names[test_args_names != "metadata"]

-            test_args <- vargs[names(vargs) %in% test_args_names]

+            test_args <- if ("report_path" %in% test_args_names) {

+              append(vargs[names(vargs) %in% test_args_names],

+                     list(report_path = report_path))

+            } else {

+              vargs[names(vargs) %in% test_args_names]

+            }

             f_call <- rlang::call2(test, metadata = metadata, !!!test_args)

             result <- rlang::eval_tidy(f_call)

             .validate_outlier_output_format(

@@ -281,6 +281,31 @@ clinical_relevant_suspicious_genes <- function() {

 #' Plots results of Fisher's exact test on gene frequency obtained via

 #' `gene_frequency_fisher()` as a scatterplot.

 #'

+#' @details

+#' ## Specifying genes to avoid highlighting

+#'

+#' In some cases, users might want to avoid highlighting certain genes

+#' even if their p-value is below the threshold. To do so, use the

+#' argument `do_not_highlight`: character vectors are appropriate for specific

+#' genes that are to be excluded, expressions or lambdas allow a finer control.

+#' For example we can supply:

+#' ```{r eval=FALSE}

+#' expr <- rlang::expr(!stringr::str_starts(GeneName, "MIR") &

+#'                       average_TxLen_1 >= 300)

+#' ```

+#'

+#' with this expression, genes that have a p-value < threshold and start with

+#' "MIR" or have an average_TxLen_1 lower than 300 are excluded from the

+#' highlighted points.

+#' NOTE: keep in mind that expressions are evaluated inside a `dplyr::filter`

+#' context.

+#'

+#' Similarly, lambdas are passed to the filtering function but only operate

+#' on the column containing the gene symbol.

+#' ```{r eval=FALSE}

+#' lambda <- ~ stringr::str_starts(.x, "MIR")

+#' ```

+#'

 #' @param fisher_df Test results obtained via `gene_frequency_fisher()`

 #' @param p_value_col Name of the column containing the p-value to consider

 #' @param annot_threshold Annotate with a different color if a point is below

@@ -288,6 +313,14 @@ clinical_relevant_suspicious_genes <- function() {

 #' @param annot_color The color in which points below the threshold should be

 #' annotated

 #' @param gene_sym_col The name of the column containing the gene symbol

+#' @param do_not_highlight Either `NULL`, a character vector, an expression

+#' or a purrr-style lambda. Tells the function to ignore the highlighting

+#' and labeling of these genes even if their p-value is below the threshold.

+#' See details.

+#' @param keep_not_highlighted If present, how should not highlighted genes

+#' be treated? If set to `TRUE` points are plotted and colored with the

+#' chosen color scale. If set to `FALSE` the points are removed entirely from

+#' the plot.

 #'

 #' @family Plotting functions

 #' @return A plot

@@ -310,11 +343,51 @@ fisher_scatterplot <- function(fisher_df,

     p_value_col = "Fisher_p_value_fdr",

     annot_threshold = 0.05,

     annot_color = "red",

-    gene_sym_col = "GeneName") {

-    below_threshold <- fisher_df %>%

+    gene_sym_col = "GeneName",

+    do_not_highlight = NULL,

+    keep_not_highlighted = TRUE) {

+    stopifnot(is.null(do_not_highlight) || is.character(do_not_highlight)

+              || rlang::is_expression(do_not_highlight))

+    if (is.null(do_not_highlight)) {

+      below_threshold <- fisher_df %>%

         dplyr::filter(.data[[p_value_col]] < annot_threshold)

-    above_threshold <- fisher_df %>%

+      above_threshold <- fisher_df %>%

         dplyr::filter(.data[[p_value_col]] >= annot_threshold)

+    } else if (is.character(do_not_highlight)) {

+      below_threshold <- fisher_df %>%

+        dplyr::filter(.data[[p_value_col]] < annot_threshold &

+                        !.data[[gene_sym_col]] %in% do_not_highlight)

+      if (keep_not_highlighted) {

+        above_threshold <- fisher_df %>%

+          dplyr::anti_join(below_threshold, by = gene_sym_col)

+      } else {

+        above_threshold <- fisher_df %>%

+          dplyr::filter(.data[[p_value_col]] >= annot_threshold)

+      }

+    } else if (rlang::is_formula(do_not_highlight)) {

+      below_threshold <- fisher_df %>%

+        dplyr::filter(.data[[p_value_col]] < annot_threshold &

+                        !rlang::as_function(do_not_highlight)(

+                          .data[[gene_sym_col]]))

+      if (keep_not_highlighted) {

+        above_threshold <- fisher_df %>%

+          dplyr::anti_join(below_threshold, by = gene_sym_col)

+      } else {

+        above_threshold <- fisher_df %>%

+          dplyr::filter(.data[[p_value_col]] >= annot_threshold)

+      }

+    } else {

+      below_threshold <- fisher_df %>%

+        dplyr::filter(.data[[p_value_col]] < annot_threshold &

+                        (rlang::eval_tidy(do_not_highlight)))

+      if (keep_not_highlighted) {

+        above_threshold <- fisher_df %>%

+          dplyr::anti_join(below_threshold, by = gene_sym_col)

+      } else {

+        above_threshold <- fisher_df %>%

+          dplyr::filter(.data[[p_value_col]] >= annot_threshold)

+      }

+    }

     plot <- ggplot2::ggplot(

         above_threshold,

         ggplot2::aes_(

@@ -323,7 +396,7 @@ fisher_scatterplot <- function(fisher_df,

             color = ggplot2::sym(p_value_col)

         )

     ) +

-        ggplot2::geom_point() +

+        ggplot2::geom_point(alpha = 0.65) +

         ggplot2::geom_point(data = below_threshold, color = annot_color) +

         ggplot2::theme_bw() +

         ggplot2::labs(

@@ -879,9 +952,7 @@ top_abund_tableGrob <- function(df,

     tops_by_x <- purrr::map(distinct_x, function(x) {

         tmp <- top %>%

             dplyr::filter(

-                dplyr::across(

-                    dplyr::all_of(by), ~ .x == x

-                )

+              dplyr::if_all(.cols = dplyr::all_of(by), .fns = ~ .x == x)

             ) %>%

             dplyr::select(-dplyr::all_of(by))

         if (nrow(tmp) < top_n) {

@@ -324,7 +324,7 @@ compute_near_integrations <- function(x,

             maps <- data.table::rbindlist(list(maps, map_fine))

         }

     }

-    if (map_as_file) {

+    if (map_as_file & !is.null(file_path)) {

         ### Manage file

         withCallingHandlers(

             {

@@ -6,7 +6,6 @@ output: html_document

 ```{r include=FALSE}

 knitr::opts_chunk$set(echo = FALSE, warning = FALSE)

 options(DT.warn.size = FALSE)

-utils::globalVariables("where")

 ```

 VISPA2 stats info {data-orientation=rows}

@@ -62,7 +61,8 @@ cat("*Nothing to report*")

 ```{r eval=!is.null(iss_stats_miss) && nrow(iss_stats_miss) > 0, echo=FALSE}

 iss_stats_miss <- iss_stats_miss %>%

-  dplyr::mutate(dplyr::across(where(is.character), as.factor))

+  dplyr::mutate(dplyr::across(

+    tidyselect::vars_select_helpers$where(is.character), as.factor))

 datatable(iss_stats_miss,

           class = "stripe",

@@ -9,7 +9,9 @@ fisher_scatterplot(

   p_value_col = "Fisher_p_value_fdr",

   annot_threshold = 0.05,

   annot_color = "red",

-  gene_sym_col = "GeneName"

+  gene_sym_col = "GeneName",

+  do_not_highlight = NULL,

+  keep_not_highlighted = TRUE

 )

 }

 \arguments{

@@ -24,6 +26,16 @@ the significance threshold. Single numerical value.}

 annotated}

 \item{gene_sym_col}{The name of the column containing the gene symbol}

+

+\item{do_not_highlight}{Either \code{NULL}, a character vector, an expression

+or a purrr-style lambda. Tells the function to ignore the highlighting

+and labeling of these genes even if their p-value is below the threshold.

+See details.}

+

+\item{keep_not_highlighted}{If present, how should not highlighted genes

+be treated? If set to \code{TRUE} points are plotted and colored with the

+chosen color scale. If set to \code{FALSE} the points are removed entirely from

+the plot.}

 }

 \value{

 A plot

@@ -33,6 +45,28 @@ A plot

 Plots results of Fisher's exact test on gene frequency obtained via

 \code{gene_frequency_fisher()} as a scatterplot.

 }

+\details{

+\subsection{Specifying genes to avoid highlighting}{

+

+In some cases, users might want to avoid highlighting certain genes

+even if their p-value is below the threshold. To do so, use the

+argument \code{do_not_highlight}: character vectors are appropriate for specific

+genes that are to be excluded, expressions or lambdas allow a finer control.

+For example we can supply:\if{html}{\out{<div class="sourceCode r">}}\preformatted{expr <- rlang::expr(!stringr::str_starts(GeneName, "MIR") &

+                      average_TxLen_1 >= 300)

+}\if{html}{\out{</div>}}

+

+with this expression, genes that have a p-value < threshold and start with

+"MIR" or have an average_TxLen_1 lower than 300 are excluded from the

+highlighted points.

+NOTE: keep in mind that expressions are evaluated inside a \code{dplyr::filter}

+context.

+

+Similarly, lambdas are passed to the filtering function but only operate

+on the column containing the gene symbol.\if{html}{\out{<div class="sourceCode r">}}\preformatted{lambda <- ~ stringr::str_starts(.x, "MIR")

+}\if{html}{\out{</div>}}

+}

+}

 \examples{

 data("integration_matrices", package = "ISAnalytics")

 data("association_file", package = "ISAnalytics")

@@ -113,13 +113,13 @@ test_that(".check_same_info reports only projects of interest", {

 # Tests .identify_independent_samples

 #------------------------------------------------------------------------------#

 test_that(".identify_independent_samples splits joined_df", {

-    joined <- minimal_test_coll_meta[minimal_test_coll,

-        on = "CompleteAmplificationID"

-    ]

-    joined <- joined[, mget(c(

+    joined <- minimal_test_coll %>%

+      dplyr::left_join(minimal_test_coll_meta,

+                       by = "CompleteAmplificationID") %>%

+      dplyr::select(dplyr::all_of(c(

         colnames(minimal_test_coll), "SequencingDate",

         "ReplicateNumber", "ProjectID", "SubjectID"

-    ))]

+      )))

     split <- .identify_independent_samples(joined,

         indep_sample_id = c(

@@ -795,7 +795,8 @@ test_that(".collisions_check_input_af works as expected", {

     expect_error(

         {

             checks <- .collisions_check_input_af(minimal_test_coll_meta %>%

-                dplyr::mutate(SequencingDate = as.character(.data$SequencingDate)),

+                dplyr::mutate(SequencingDate = as.character(

+                  .data$SequencingDate)),

             date_col = "SequencingDate",

             independent_sample_id = c("SubjectID")

             )