@@ -695,6 +695,9 @@

         dplyr::group_split()

     single_type_eval <- function(sub_df) {

         tag_type <- types[[sub_df$tag[1]]]

+        if (is.null(tag_type) || purrr::is_empty(tag_type)) {

+          return(list(type = "DF", result = sub_df))

+        }

         out <- sub_df %>%

             dplyr::filter(.data$types %in% tag_type)

         if (nrow(out) == 0) {

@@ -3613,15 +3616,6 @@

 # **NOTE: this function is meant to be called on a SINGLE GROUP,

 # meaning a subset of an integration matrix in which all rows

 # share the same chr (and optionally same strand).**

-#

-# @param x An integration matrix subset (see description)

-# @param threshold The numeric value representing an absolute number

-# of bases for which two integrations are considered distinct

-# @param keep_criteria The string with selecting criteria

-# @param annotated Is `x` annotated? Logical value

-# @param num_cols A character vector with the names of the numeric columns

-# @param max_val_col The column to consider if criteria is max_value

-# @param produce_map Produce recalibration map?

 #' @importFrom dplyr arrange

 #' @importFrom purrr is_empty map_dfr

 #' @importFrom rlang expr eval_tidy .data

@@ -3635,20 +3629,30 @@

     annotated,

     num_cols,

     max_val_col,

+    sample_col,

+    req_tags,

+    add_col_lambdas,

     produce_map) {

+    locus_col <- req_tags %>%

+      dplyr::filter(.data$tag == "locus") %>%

+      dplyr::pull(.data$names)

     ## Order by integration_locus

-    x <- x %>% dplyr::arrange(.data$integration_locus)

+    x <- x %>% dplyr::arrange(.data[[locus_col]])

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

     map_recalibr <- if (produce_map == TRUE) {

-        mand_vars <- mandatory_IS_vars()

-        rec_map <- unique(x[, ..mand_vars])

+        req_vars <- req_tags$names

+        rec_map <- unique(x[, mget(req_vars)])

         data.table::setnames(

             x = rec_map,

-            old = mandatory_IS_vars(),

-            new = paste0(mandatory_IS_vars(), "_before")

+            old = req_vars,

+            new = paste0(req_vars, "_before")

         )

-        rec_map[, c("chr_after", "integration_locus_after", "strand_after") :=

-            list(NA_character_, NA_real_, NA_character_)]

+        na_type <- purrr::map(req_vars, ~ {

+          col_type <- typeof(x[, get(.x)])

+          fun_name <- paste0("as.", col_type)

+          return(do.call(what = fun_name, args = list(NA)))

+        })

+        rec_map[, c(paste(req_vars, "after", sep = "_")) := na_type]

     } else {

         NULL

     }

@@ -3657,27 +3661,27 @@

         # If index is the last row in the data frame return

         if (index == nrow(x)) {

             if (produce_map == TRUE) {

+              is_predicate <- purrr::map(req_vars, ~ {

+                var_before <- sym(paste0(.x, "_before"))

+                value <- x[index, get(.x)]

+                rlang::expr(!!var_before == !!value)

+              }) %>%

+                purrr::reduce(~ rlang::expr(!!.x & !!.y))

                 map_recalibr[

-                    chr_before == x[index, ]$chr &

-                        integration_locus_before ==

-                            x[index, ]$integration_locus &

-                        strand_before == x[index, ]$strand,

+                    eval(is_predicate),

                     c(

-                        "chr_after",

-                        "integration_locus_after",

-                        "strand_after"

+                      paste0(req_vars, "_after")

                     ) :=

-                        list(

-                            chr_before,

-                            integration_locus_before,

-                            strand_before

+                        purrr::map(

+                          req_vars,

+                          ~ eval(sym(paste0(.x, "_before")))

                         )

                 ]

             }

             return(list(recalibrated_matrix = x, map = map_recalibr))

         }

         ## Compute interval for row

-        interval <- x[index, ]$integration_locus + 1 + threshold

+        interval <- x[index, ][[locus_col]] + 1 + threshold

         ## Look ahead for every integration that falls in the interval

         near <- numeric()

         k <- index

@@ -3686,7 +3690,7 @@

                 break

             }

             k <- k + 1

-            if (x[k, ]$integration_locus < interval) {

+            if (x[k, ][[locus_col]] < interval) {

                 # Saves the indexes of the rows that are in the interval

                 near <- append(near, k)

             } else {

@@ -3694,10 +3698,10 @@

             }

         }

         window <- c(index, near)

+        row_to_keep <- index

         if (!purrr::is_empty(near)) {

             ## Change loci according to criteria

             ######## CRITERIA PROCESSING

-            row_to_keep <- index

             if (keep_criteria == "max_value") {

                 expr <- rlang::expr(`$`(x[window, ], !!max_val_col))

                 to_check <- rlang::eval_tidy(expr)

@@ -3709,54 +3713,68 @@

             }

             # Fill map if needed

             if (produce_map == TRUE) {

-                map_recalibr[

-                    chr_before %chin% x[window, ]$chr &

-                        integration_locus_before %in%

-                            x[window, ]$integration_locus &

-                        strand_before %chin% x[window, ]$strand,

-                    c(

-                        "chr_after",

-                        "integration_locus_after",

-                        "strand_after"

-                    ) :=

-                        list(

-                            x[row_to_keep, ]$chr,

-                            x[row_to_keep, ]$integration_locus,

-                            x[row_to_keep, ]$strand

-                        )

-                ]

+              is_predicate <- purrr::map(req_vars, ~ {

+                var_before <- sym(paste0(.x, "_before"))

+                value <- x[window, get(.x)]

+                if (!is.character(value)) {

+                  return(rlang::expr(!!var_before %in% !!value))

+                }

+                rlang::expr(!!var_before %chin% !!value)

+              }) %>%

+                purrr::reduce(~ rlang::expr(!!.x & !!.y))

+              map_recalibr[

+                eval(is_predicate),

+                c(

+                  paste0(req_vars, "_after")

+                ) :=

+                  purrr::map(

+                    req_vars,

+                    ~ x[row_to_keep][[.x]]

+                  )

+              ]

             }

-            # Change loci and strand of near integrations

+            # Change loci and other ids of near integrations

+            fields_to_change <- req_tags$names

             if (annotated) {

-                x[near, c(

-                    "integration_locus",

-                    "strand",

-                    annotation_IS_vars()

-                ) := list(

-                    x[row_to_keep, ]$integration_locus,

-                    x[row_to_keep, ]$strand,

-                    x[row_to_keep, ]$GeneName,

-                    x[row_to_keep, ]$GeneStrand

-                )]

+              fields_to_change <- c(fields_to_change, annotation_IS_vars())

+              x[near, c(

+                req_tags$names,

+                annotation_IS_vars()

+              ) := x[row_to_keep,

+                     mget(fields_to_change)]]

             } else {

-                x[near, c("integration_locus", "strand") := list(

-                    x[row_to_keep, ]$integration_locus,

-                    x[row_to_keep, ]$strand

-                )]

+              x[near, c(

+                req_tags$names

+              ) := x[row_to_keep,

+                     mget(fields_to_change)]]

             }

             ## Aggregate same IDs

             starting_rows <- nrow(x)

             repeat {

-                t <- x$CompleteAmplificationID[window]

+                t <- x[[sample_col]][window]

                 d <- unique(t[duplicated(t)])

                 if (purrr::is_empty(d)) {

                     break

                 }

                 dupl_indexes <- which(t == d[1])

-                values_sum <- colSums(x[window[dupl_indexes], ..num_cols],

+                values_sum <- colSums(x[window[dupl_indexes], mget(num_cols)],

                     na.rm = TRUE

                 )

                 x[window[dupl_indexes[1]], c(num_cols) := as.list(values_sum)]

+                ### Aggregate additional cols

+                if (!is.null(add_col_lambdas) &&

+                    !purrr::is_empty(add_col_lambdas)) {

+                  agg_cols <- purrr::map(names(add_col_lambdas), ~ {

+                    if (is.null(add_col_lambdas[[.x]])) {

+                      return(x[window[dupl_indexes[1]], ][[.x]])

+                    }

+                    values <- x[window[dupl_indexes], ][[.x]]

+                    return(rlang::as_function(add_col_lambdas[[.x]])(values))

+                  })

+                  x[window[dupl_indexes[1]], c(names(add_col_lambdas)) :=

+                      agg_cols]

+                }

+

                 x <- x[-window[dupl_indexes[-1]], ]

                 to_drop <- seq(

                     from = length(window),

@@ -3773,22 +3791,25 @@

             }

         } else {

             if (produce_map == TRUE) {

-                map_recalibr[

-                    chr_before == x[index, ]$chr &

-                        integration_locus_before ==

-                            x[index, ]$integration_locus &

-                        strand_before == x[index, ]$strand,

-                    c(

-                        "chr_after",

-                        "integration_locus_after",

-                        "strand_after"

-                    ) :=

-                        list(

-                            chr_before,

-                            integration_locus_before,

-                            strand_before

-                        )

-                ]

+              is_predicate <- purrr::map(req_vars, ~ {

+                var_before <- sym(paste0(.x, "_before"))

+                value <- x[window, get(.x)]

+                if (!is.character(value)) {

+                  return(rlang::expr(!!var_before %in% !!value))

+                }

+                rlang::expr(!!var_before %chin% !!value)

+              }) %>%

+                purrr::reduce(~ rlang::expr(!!.x & !!.y))

+              map_recalibr[

+                eval(is_predicate),

+                c(

+                  paste0(req_vars, "_after")

+                ) :=

+                  purrr::map(

+                    req_vars,

+                    ~ x[row_to_keep][[.x]]

+                  )

+              ]

             }

             index <- index + 1

         }

@@ -3820,23 +3841,43 @@

 #

 # @return Nothing

 .write_recalibr_map <- function(map, file_path) {

-    if (fs::is_dir(file_path)) {

-        if (!fs::dir_exists(file_path)) {

-            fs::dir_create(file_path)

-        }

-        gen_filename <- .generate_rec_map_filename()

-        file_path <- fs::path(file_path, gen_filename)

+  if (!fs::file_exists(file_path)) {

+    ext <- fs::path_ext(file_path)

+    ## if ext is empty assume it's a folder

+    if (ext == "") {

+      fs::dir_create(file_path)

+      gen_filename <- .generate_rec_map_filename()

+      tmp_filename <- fs::path(file_path, gen_filename)

     } else {

-        if (fs::path_ext(file_path) == "") {

-            file_path <- fs::path_ext_set(file_path, "tsv.gz")

+      tmp_filename <- fs::path_ext_remove(file_path)

+      if (ext %in% .compressed_formats()) {

+        ext <- paste(fs::path_ext(tmp_filename), ext, sep = ".")

+        tmp_filename <- fs::path_ext_remove(tmp_filename)

+      }

+      if (!ext %in% c("tsv", paste("tsv", .compressed_formats(), sep = "."),

+                      "csv", paste("csv", .compressed_formats(), sep = "."),

+                      "txt", paste("txt", .compressed_formats(), sep = ".")

+      )) {

+        if (getOption("ISAnalytics.verbose") == TRUE) {

+          warn <- c("Recalibration file format unsupported",

+                    i = "Writing file in 'tsv.gz' format")

+          rlang::inform(warn, class = "rec_unsupp_ext")

         }

+        tmp_filename <- paste0(tmp_filename, ".tsv.gz")

+      } else {

+        tmp_filename <- paste0(tmp_filename, ".", ext)

+      }

     }

+  } else if (fs::is_dir(file_path)) {

+    gen_filename <- .generate_rec_map_filename()

+    tmp_filename <- fs::path(file_path, gen_filename)

+  }

     withRestarts(

         {

-            data.table::fwrite(map, file = file_path, sep = "\t", na = "")

+            data.table::fwrite(map, file = tmp_filename, sep = "\t", na = "")

             saved_msg <- paste(

                 "Recalibration map saved to: ",

-                file_path

+                tmp_filename

             )

             if (getOption("ISAnalytics.verbose") == TRUE) {

                 rlang::inform(saved_msg)

@@ -71,121 +71,189 @@

 #' head(rec)

 compute_near_integrations <- function(x,

     threshold = 4,

-    keep_criteria = "max_value",

-    strand_specific = TRUE,

+    is_identity_tags = c("chromosome", "is_strand"),

+    keep_criteria = c("max_value", "keep_first"),

     value_columns = c("seqCount", "fragmentEstimate"),

     max_value_column = "seqCount",

+    sample_id_column = pcr_id_column(),

+    additional_agg_lambda = list(.default = default_rec_agg_lambdas()),

+    max_workers = 4,

     map_as_file = TRUE,

-    file_path = default_report_path()) {

-    # Check parameters

+    file_path = default_report_path(),

+    strand_specific = lifecycle::deprecated()) {

+    ## --- Check parameters

     stopifnot(is.data.frame(x))

-    ## Check tibble is an integration matrix

-    if (!.check_mandatory_vars(x)) {

-        rlang::abort(.missing_mand_vars())

-    }

-    ## Check it contains CompleteAmplificationID column

-    if (!.check_complAmpID(x)) {

-        rlang::abort(.missing_cAmp_sub_msg())

-    }

-    ## Check numeric columns

+    stopifnot(is.numeric(threshold) || is.integer(threshold))

+    threshold <- threshold[1]

     stopifnot(is.character(value_columns))

     stopifnot(is.character(max_value_column))

     num_cols <- unique(c(value_columns, max_value_column[1]))

     if (!all(num_cols %in% colnames(x))) {

-        rlang::abort(.missing_user_cols_error(

-            num_cols[!num_cols %in% colnames(x)]

-        ))

+      rlang::abort(.missing_needed_cols(

+        num_cols[!num_cols %in% colnames(x)]

+      ))

     }

-    stopifnot(is.numeric(threshold) || is.integer(threshold))

-    threshold <- threshold[1]

-    criteria <- rlang::arg_match(keep_criteria, values = c(

-        "max_value",

-        "keep_first"

-    ))

-    stopifnot(is.logical(strand_specific))

-    strand_specific <- strand_specific[1]

+    criteria <- rlang::arg_match(keep_criteria)

+    stopifnot(is.character(sample_id_column))

+    sample_id_column <- sample_id_column[1]

     stopifnot(is.logical(map_as_file))

     map_as_file <- map_as_file[1]

     if (map_as_file == TRUE) {

-        stopifnot(is.character(file_path))

-        file_path <- file_path[1]

+      stopifnot(is.character(file_path))

+      file_path <- file_path[1]

+    }

+    if (lifecycle::is_present(strand_specific)) {

+      lifecycle::deprecate_warn(

+        when = "1.5.4",

+        what = "compute_near_integrations(strand_specific)",

+        with = "compute_near_integrations(is_identity_tags)",

+        details = paste("See the documentation for details,",

+                        "the argument will be likely dropped in the next",

+                        "release cycle.")

+      )

+      stopifnot(is.logical(strand_specific))

+      strand_specific <- strand_specific[1]

+      if (!"is_strand" %in% is_identity_tags) {

+        is_identity_tags <- c(is_identity_tags, "is_strand")

+      }

+    }

+    ## --- Check tags

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

+    required_tags <- list("locus" = c("int", "numeric"))

+    if (!is.null(is_identity_tags)) {

+      is_identity_tags <- is_identity_tags[is_identity_tags != "locus"]

+      id_tags_types <- purrr::map(is_identity_tags, ~ NULL) %>%

+        purrr::set_names(is_identity_tags)

+      required_tags <- append(required_tags, id_tags_types)

+    }

+    required_tag_cols <- .check_required_cols(

+      required_tags = required_tags,

+      vars_df = mandatory_IS_vars(TRUE),

+      duplicate_politic = "error")

+    if (!all(required_tag_cols$names %in% colnames(x))) {

+      rlang::abort(.missing_needed_cols(required_tag_cols$names[

+        !required_tag_cols$names %in% colnames(x)

+      ]))

+    }

+    if (!sample_id_column %in% colnames(x)) {

+      rlang::abort(.missing_needed_cols(sample_id_column))

     }

     ## Is x annotated?

     annotated <- .is_annotated(x)

-    # Split data for parallel execution

-    split <- if (strand_specific == TRUE) {

-        x %>%

-            dplyr::group_by(.data$chr, .data$strand) %>%

-            dplyr::group_split()

-    } else {

-        x %>%

-            dplyr::group_by(.data$chr) %>%

-            dplyr::group_split()

+    ## Any additional columns present?

+    additional_cols <- colnames(x)[!colnames(x) %in% c(

+      required_tag_cols$names, sample_id_column, value_columns,

+      annotation_IS_vars()

+    )]

+    find_lambda <- function(.x) {

+      if (.x %in% names(additional_agg_lambda)) {

+        return(additional_agg_lambda[[.x]])

+      }

+      defaults <- additional_agg_lambda[[".defaults"]]

+      if (is.null(defaults)) {

+        return(NULL)

+      }

+      col_type <- typeof(x[[.x]])

+      return(defaults[[col_type]])

     }

-    ## Select only groups with 2 or more rows

-    split_to_process <- split[purrr::map_lgl(split, ~ nrow(.x) > 1)]

-    # # Set up parallel workers

-    if (.Platform$OS.type == "windows") {

+    add_cols_lambdas <- purrr::map(additional_cols, find_lambda) %>%

+      purrr::set_names(additional_cols)

+    add_cols_lambdas <- add_cols_lambdas[purrr::map_lgl(add_cols_lambdas,

+                                                        ~ !is.null(.x))]

+    # Process

+    if (is.null(is_identity_tags) || purrr::is_empty(is_identity_tags)) {

+      result <- .sliding_window(

+        x = x,

+        threshold = threshold,

+        keep_criteria = criteria,

+        annotated = annotated,

+        num_cols = num_cols,

+        max_val_col = max_value_column,

+        sample_col = sample_id_column,

+        req_tags = required_tag_cols,

+        add_col_lambdas = add_cols_lambdas,

+        produce_map = map_as_file

+      )

+      recalibr_m <- result$recalibrated_matrix

+      maps <- result$map

+

+    } else {

+      stopifnot(is.numeric(max_workers))

+      max_workers <- max_workers[1]

+      is_identity_names <- required_tag_cols %>%

+        dplyr::filter(.data$tag != "locus") %>%

+        dplyr::pull(.data$names)

+      # Split data for parallel execution

+      split <- x %>%

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

+          dplyr::group_split()

+      ## Select only groups with 2 or more rows

+      split_to_process <- split[purrr::map_lgl(split, ~ nrow(.x) > 1)]

+      # Set up parallel workers

+      if (.Platform$OS.type == "windows") {

         p <- BiocParallel::SnowParam(

-            stop.on.error = FALSE,

-            progressbar = TRUE,

-            tasks = length(split_to_process),

-            exportglobals = TRUE

+          workers = max_workers,

+          progressbar = getOption("ISAnalytics.verbose"),

+          tasks = length(split_to_process),

+          exportglobals = TRUE

         )

-    } else {

+      } else {

         p <- BiocParallel::MulticoreParam(

-            stop.on.error = FALSE,

-            progressbar = TRUE,

-            tasks = length(split_to_process),

-            exportglobals = FALSE

-        )

-    }

-    FUN <- function(x) {

-        .sliding_window(x,

-            threshold = threshold,

-            keep_criteria = criteria,

-            num_cols = num_cols,

-            annotated = annotated,

-            max_val_col = max_value_column,

-            produce_map = map_as_file

+          workers = max_workers,

+          progressbar = getOption("ISAnalytics.verbose"),

+          tasks = length(split_to_process),

+          exportglobals = FALSE

         )

-    }

-    ## Obtain result: list of lists

-    result <- BiocParallel::bptry(

-        BiocParallel::bplapply(

-            split_to_process,

-            FUN = FUN,

-            BPPARAM = p

-        )

-    )

-    BiocParallel::bpstop(p)

-    ## Obtain single list

-    recalibr_m <- purrr::map(result, ~ .x$recalibrated_matrix)

-    recalibr_m <- data.table::rbindlist(recalibr_m)

-    maps <- purrr::map(result, ~ .x$map)

-    maps <- data.table::rbindlist(maps)

-    ## Add all rows that were not part of recalibration

-    split_fine <- split[purrr::map_lgl(split, ~ !nrow(.x) > 1)]

-    if (length(split_fine) > 0) {

+      }

+      ## Obtain result: list of lists

+      result <- BiocParallel::bplapply(

+        split_to_process,

+        FUN = .sliding_window,

+        threshold = threshold,

+        keep_criteria = criteria,

+        annotated = annotated,

+        num_cols = num_cols,

+        max_val_col = max_value_column,

+        sample_col = sample_id_column,

+        req_tags = required_tag_cols,

+        add_col_lambdas = add_cols_lambdas,

+        produce_map = map_as_file,

+        BPPARAM = p

+      )

+      BiocParallel::bpstop(p)

+      ## Obtain single list

+      recalibr_m <- purrr::map(result, ~ .x$recalibrated_matrix)

+      recalibr_m <- data.table::rbindlist(recalibr_m)

+      maps <- purrr::map(result, ~ .x$map)

+      maps <- data.table::rbindlist(maps)

+      ## Add all rows that were not part of recalibration

+      split_fine <- split[purrr::map_lgl(split, ~ !nrow(.x) > 1)]

+      if (length(split_fine) > 0) {

         split_fine <- purrr::reduce(

-            split_fine,

-            function(g1, g2) {

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

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

-                data.table::rbindlist(list(g1, g2))

-            }

-        ) %>% data.table::setDT()

-        mand_vars <- mandatory_IS_vars()

-        map_fine <- unique(split_fine[, ..mand_vars])

+          split_fine,

+          function(g1, g2) {

+            g1 <- data.table::setDT(g1)

+            g2 <- data.table::setDT(g2)

+            data.table::rbindlist(list(g1, g2))

+          }

+        )

+        split_fine <- data.table::setDT(split_fine)

+        map_fine <- unique(split_fine[, mget(required_tag_cols$names)])

         data.table::setnames(

-            x = map_fine,

-            old = mandatory_IS_vars(),

-            new = paste0(mandatory_IS_vars(), "_before")

+          x = map_fine,

+          old = mget(required_tag_cols$names),

+          new = paste0(mget(required_tag_cols$names), "_before")

         )

-        map_fine[, c("chr_after", "integration_locus_after", "strand_after") :=

-            list(chr_before, integration_locus_before, strand_before)]

+        map_fine[, c(

+          paste0(required_tag_cols$names, "_after")

+        ) :=

+          purrr::map(

+            required_tag_cols$names,

+            ~ eval(sym(paste0(.x, "_before")))

+          )]

         recalibr_m <- data.table::rbindlist(list(recalibr_m, split_fine))

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

+      }

     }

     if (map_as_file) {

         ### Manage file

@@ -204,3 +272,12 @@ compute_near_integrations <- function(x,

     }

     return(recalibr_m)

 }

+

+default_rec_agg_lambdas <- function() {

+  list(

+    character = ~ paste0(.x, collapse = ";"),

+    integer = ~ sum(.x, na.rm = TRUE),

+    double = ~ sum(.x, na.rm = TRUE),

+    logical = ~ all(.x)

+  )

+}

@@ -1059,12 +1059,12 @@ test_that(paste(func_name[17], "produces report in right location"), {

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

 # Tests import_parallel_Vispa2Matrices

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

-test_that(paste(func_name[17], "executes correctly"), {

+test_that(paste(func_name[18], "executes correctly"), {

     matrices <- import_parallel_Vispa2Matrices(

         association_file = local_af_corr,

         quantification_type = c("seqCount", "fragmentEstimate"),

         mode = "AUTO", report_path = NULL

     )

-    expect_true(nrow(matrices) == 5904 & ncol(matrices) == 8)

+    expect_true(nrow(matrices) == 1689 & ncol(matrices) == 8)

     expect_true(all(c("seqCount", "fragmentEstimate") %in% colnames(matrices)))

 })

@@ -43,6 +43,7 @@ sample_group2 <- tibble::tibble(

         48

     )

 )

+

 sample_group_mult1 <- tibble::tibble(

     chr = c(rep_len("1", 6)),

     integration_locus = c(

@@ -275,10 +276,14 @@ expected_for_smplmult2_mv <- tibble::tibble(

 )

 test_that(".sliding_window produces correct output for sample1", {

+  withr::local_options(list(ISAnalytics.mandatory_is_vars = "default"))

     result <- .sliding_window(

         x = sample_group1, threshold = 4,

         keep_criteria = "keep_first", annotated = FALSE,

         num_cols = "Value", max_val_col = "Value",

+        sample_col = "CompleteAmplificationID",

+        req_tags = mandatory_IS_vars(TRUE),

+        add_col_lambdas = NULL,

         produce_map = TRUE

     )

     expect_equal(result$recalibrated_matrix, expected_for_smpl1_kf,

@@ -291,6 +296,9 @@ test_that(".sliding_window produces correct output for sample1", {

         x = sample_group1, threshold = 4,

         keep_criteria = "max_value", annotated = FALSE,

         num_cols = "Value", max_val_col = "Value",

+        sample_col = "CompleteAmplificationID",

+        req_tags = mandatory_IS_vars(TRUE),

+        add_col_lambdas = NULL,

         produce_map = TRUE

     )

     expect_equal(result$recalibrated_matrix, expected_for_smpl1_kf,

@@ -302,10 +310,14 @@ test_that(".sliding_window produces correct output for sample1", {

 })

 test_that(".sliding_window produces correct output for sample2", {

+  withr::local_options(list(ISAnalytics.mandatory_is_vars = "default"))

     result <- .sliding_window(

         x = sample_group2, threshold = 4,

         keep_criteria = "keep_first", annotated = FALSE,

         num_cols = "Value", max_val_col = "Value",

+        sample_col = "CompleteAmplificationID",

+        req_tags = mandatory_IS_vars(TRUE),

+        add_col_lambdas = NULL,

         produce_map = TRUE

     )

     expect_equal(result$recalibrated_matrix, expected_for_smpl2_kf,

@@ -318,6 +330,9 @@ test_that(".sliding_window produces correct output for sample2", {

         x = sample_group2, threshold = 4,

         keep_criteria = "max_value", annotated = FALSE,

         num_cols = "Value", max_val_col = "Value",

+        sample_col = "CompleteAmplificationID",

+        req_tags = mandatory_IS_vars(TRUE),

+        add_col_lambdas = NULL,

         produce_map = TRUE

     )

     expect_equal(result$recalibrated_matrix, expected_for_smpl2_mv,

@@ -329,11 +344,15 @@ test_that(".sliding_window produces correct output for sample2", {

 })

 test_that(".sliding_window produces correct output for sample1 - mult column", {

+  withr::local_options(list(ISAnalytics.mandatory_is_vars = "default"))

     result <- .sliding_window(

         x = sample_group_mult1, threshold = 4,

         keep_criteria = "keep_first", annotated = FALSE,

         num_cols = c("seqCount", "fragmentEstimate"),

         max_val_col = "seqCount",

+        sample_col = "CompleteAmplificationID",

+        req_tags = mandatory_IS_vars(TRUE),

+        add_col_lambdas = NULL,

         produce_map = TRUE

     )

     expect_equal(result$recalibrated_matrix, expected_for_smplmult1_kf,

@@ -347,6 +366,9 @@ test_that(".sliding_window produces correct output for sample1 - mult column", {

         keep_criteria = "max_value", annotated = FALSE,

         num_cols = c("seqCount", "fragmentEstimate"),

         max_val_col = "seqCount",

+        sample_col = "CompleteAmplificationID",

+        req_tags = mandatory_IS_vars(TRUE),

+        add_col_lambdas = NULL,

         produce_map = TRUE

     )

     expect_equal(result$recalibrated_matrix, expected_for_smplmult1_kf,

@@ -358,11 +380,15 @@ test_that(".sliding_window produces correct output for sample1 - mult column", {

 })

 test_that(".sliding_window produces correct output for sample2 - mult column", {

+  withr::local_options(list(ISAnalytics.mandatory_is_vars = "default"))

     result <- .sliding_window(

         x = sample_group_mult2, threshold = 4,

         keep_criteria = "keep_first", annotated = FALSE,

         num_cols = c("seqCount", "fragmentEstimate"),

         max_val_col = "seqCount",

+        sample_col = "CompleteAmplificationID",

+        req_tags = mandatory_IS_vars(TRUE),

+        add_col_lambdas = NULL,

         produce_map = TRUE

     )

     expect_equal(result$recalibrated_matrix, expected_for_smplmult2_kf,

@@ -376,6 +402,9 @@ test_that(".sliding_window produces correct output for sample2 - mult column", {

         keep_criteria = "max_value", annotated = FALSE,

         num_cols = c("seqCount", "fragmentEstimate"),

         max_val_col = "seqCount",

+        sample_col = "CompleteAmplificationID",

+        req_tags = mandatory_IS_vars(TRUE),

+        add_col_lambdas = NULL,

         produce_map = TRUE

     )

     expect_equal(result$recalibrated_matrix, expected_for_smplmult2_mv,

@@ -386,11 +415,212 @@ test_that(".sliding_window produces correct output for sample2 - mult column", {

     )

 })

+test_that(".sliding_window works on annotated", {

+  withr::local_options(list(ISAnalytics.mandatory_is_vars = "default"))

+  annot_group1 <- sample_group1 %>%

+    dplyr::mutate(GeneName = paste0("GENE", seq_len(nrow(sample_group1))),

+                  GeneStrand = "+", .after = "strand")

+  expected_matrix <- expected_for_smpl1_kf %>%

+    dplyr::mutate(GeneName = c("GENE4", "GENE4", "GENE4", "GENE4",

+                               "GENE5", "GENE5"),

+                  GeneStrand = "+", .after = "strand")

+  result <- .sliding_window(

+    x = annot_group1, threshold = 4,

+    keep_criteria = "max_value", annotated = TRUE,

+    num_cols = "Value",

+    max_val_col = "Value",

+    sample_col = "CompleteAmplificationID",

+    req_tags = mandatory_IS_vars(TRUE),

+    add_col_lambdas = NULL,

+    produce_map = TRUE

+  )

+  expect_equal(result$recalibrated_matrix, expected_matrix,

+               ignore_attr = TRUE

+  )

+  expect_equal(result$map, recalibr_map_smpl1_kf,

+               ignore_attr = TRUE

+  )

+  annot_group2 <- sample_group2 %>%

+    dplyr::mutate(GeneName = paste0("GENE", seq_len(nrow(sample_group2))),

+                  GeneStrand = "-", .after = "strand")

+  expected_matrix <- expected_for_smpl2_mv %>%

+    dplyr::mutate(GeneName = c("GENE1", "GENE7", "GENE6", "GENE6", "GENE3"),

+                  GeneStrand = "-", .after = "strand")

+  result <- .sliding_window(

+    x = annot_group2, threshold = 4,

+    keep_criteria = "max_value", annotated = TRUE,

+    num_cols = "Value",

+    max_val_col = "Value",

+    sample_col = "CompleteAmplificationID",

+    req_tags = mandatory_IS_vars(TRUE),

+    add_col_lambdas = NULL,

+    produce_map = TRUE

+  )

+  expect_equal(result$recalibrated_matrix, expected_matrix,

+               ignore_attr = TRUE

+  )

+  expect_equal(result$map, recalibr_map_smpl2_mv,

+               ignore_attr = TRUE

+  )

+})

+

+test_that(".sliding_window aggregates add columns correctly", {

+  withr::local_options(list(ISAnalytics.mandatory_is_vars = "default"))

+  s2_add_cols <- sample_group2 %>%

+    dplyr::mutate(ann1 = seq_len(nrow(sample_group2)),

+                  ann2 = c("a", "b", "c", "d", "e", "f", "g"),

+                  ann3 = c(TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, FALSE),

+                  .after = "strand")

+  result <- .sliding_window(

+    x = s2_add_cols, threshold = 4,

+    keep_criteria = "max_value", annotated = FALSE,

+    num_cols = "Value",

+    max_val_col = "Value",

+    sample_col = "CompleteAmplificationID",

+    req_tags = mandatory_IS_vars(TRUE),

+    add_col_lambdas = list(ann1 = ~sum(.x, na.rm = TRUE),

+                           ann2 = ~paste0(.x, collapse = ";"),

+                           ann3 = ~any(.x)),

+    produce_map = TRUE

+  )

+  expected_v1 <- expected_for_smpl2_mv %>%

+    dplyr::mutate(ann1 = c(6, 7, 6, 6, 3),

+                  ann2 = c("e;a", "g", "d;b", "f", "c"),

+                  ann3 = c(TRUE, FALSE, TRUE, TRUE, FALSE),

+                  .after = "strand")

+  expect_equal(result$recalibrated_matrix, expected_v1,

+               ignore_attr = TRUE

+  )

+  expect_equal(result$map, recalibr_map_smpl2_mv,

+               ignore_attr = TRUE

+  )

+  ## NULL lambdas correspond to keep any value

+  result <- .sliding_window(

+    x = s2_add_cols, threshold = 4,

+    keep_criteria = "max_value", annotated = FALSE,

+    num_cols = "Value",

+    max_val_col = "Value",

+    sample_col = "CompleteAmplificationID",

+    req_tags = mandatory_IS_vars(TRUE),

+    add_col_lambdas = list(ann1 = NULL,

+                           ann2 = NULL,

+                           ann3 = NULL),

+    produce_map = TRUE

+  )

+  expected_v2 <- expected_for_smpl2_mv %>%

+    dplyr::mutate(ann1 = c(5, 7, 4, 6, 3),

+                  ann2 = c("e", "g", "d", "f", "c"),

+                  ann3 = c(FALSE, FALSE, TRUE, TRUE, FALSE),

+                  .after = "strand")

+  expect_equal(result$recalibrated_matrix, expected_v2,

+               ignore_attr = TRUE

+  )

+  expect_equal(result$map, recalibr_map_smpl2_mv,

+               ignore_attr = TRUE

+  )

+})

+

+test_that(".sliding_window works with custom vars", {

+  withr::local_options(list(ISAnalytics.mandatory_is_vars = "default"))

+  customized <- sample_group2 %>%

+    dplyr::rename(chrom = "chr", locus = "integration_locus")

+  temp_vars <- mandatory_IS_vars(TRUE)

+  temp_vars[1, ]$names <- "chrom"

+  temp_vars[2, ]$names <- "locus"

+  withr::with_options(list(ISAnalytics.mandatory_is_vars = temp_vars),

+                      {

+                        result <- .sliding_window(

+                          x = customized, threshold = 4,

+                          keep_criteria = "max_value", annotated = FALSE,

+                          num_cols = "Value", max_val_col = "Value",

+                          sample_col = "CompleteAmplificationID",

+                          req_tags = mandatory_IS_vars(TRUE),

+                          add_col_lambdas = NULL,

+                          produce_map = TRUE

+                        )

+                      })

+  expected_matrix <- expected_for_smpl2_mv %>%

+    dplyr::rename(chrom = "chr", locus = "integration_locus")

+  expect_equal(result$recalibrated_matrix, expected_matrix,

+               ignore_attr = TRUE

+  )

+  expect_equal(result$map, recalibr_map_smpl2_mv %>%

+                 dplyr::rename(chrom_before = "chr_before",

+                               locus_before = "integration_locus_before",

+                               chrom_after = "chr_after",

+                               locus_after = "integration_locus_after"),

+               ignore_attr = TRUE

+  )

+})

+

+#------------------------------------------------------------------------------#

+# Tests .write_recalibr_map

+#------------------------------------------------------------------------------#

+test_that(".write_recalibr_map works if path provided is dir", {