update liftover_junc_id() with separate liftover_successful column

R/liftover_junc_id.R

@@ -7,12 +7,13 @@
 #' @param junc_df a data.frame with at least one column `junc_id` containing junction IDs
 #' @param chain_file path to a chain file for the UCSC liftOver tool. See also \code{\link[rtracklayer]{liftOver}}
 #' @return a data.frame like the input `junc_df` with the following additional columns:
-#'   - `junc_id_lifted_is_unique` a logical vector indicating if the liftOver was successful and unique (1-to-1 correspondence).
+#'   - `liftover_successful` a logical vector indicating if the liftOver was successful and lifted junction positions build valid genomic intervals and not single positions.
+#'   - `liftover_unique` a logical vector indicating if the liftOver was unique (1-to-1 correspondence).
 #'   - `junc_id_lifted_collapsed` a character vector with the lifted junction IDs.
 #'   Multiple IDs are separated by `|`.
 #'   NA represent junc_ids that could not be lifted.
 #'   - `junc_id_lifted` a character vector with a unique lifted junction IDs.
-#'   Potentially multiple lifted IDs are combined by the minmal start and maximal
+#'   Potentially multiple lifted IDs are combined by the minimal start and maximal
 #'   end coordinate. NA represent junc_ids that could not be lifted.
 #'
 #' @examples
@@ -41,10 +42,10 @@ liftover_junc_id <- function(junc_df, chain_file){
       junc_id_lifted_lst = as.list(junc_id_lifted_grl),
 
       # check that lifted junctions are valid intervals (not single positions)
-      valid_range = purrr::map_lgl(junc_id_lifted_lst, ~ all(BiocGenerics::width(.x) >= 2)),
+      liftover_successful = purrr::map_lgl(junc_id_lifted_lst, ~ length(.x) > 0 & all(BiocGenerics::width(.x) >= 2)),
 
-      # check if liftOver was successful and unique
-      junc_id_lifted_is_unique = valid_range & purrr::map_lgl(junc_id_lifted_lst, ~ length(.x) == 1),
+      # check if liftOver was unique
+      liftover_unique = purrr::map_lgl(junc_id_lifted_lst, ~ length(.x) == 1),
 
       # covert back to junc_id, collapse multiple IDs with `|`, and replace empty junc_id with NA
       junc_id_lifted_collapsed = junc_id_lifted_lst %>%
@@ -67,7 +68,7 @@ liftover_junc_id <- function(junc_df, chain_file){
     ) %>%
 
     # remove temporary column
-    dplyr::select(-junc_id_lifted_lst, -valid_range)
+    dplyr::select(-junc_id_lifted_lst)
 
 }
 

tests/testthat/test-liftover_junc_id.R

@@ -8,7 +8,8 @@ test_that("liftover_junc_id works on toy example data", {
   junc_df_lifted <- liftover_junc_id(junc_df, chain_file)
 
   expect_equal(nrow(junc_df_lifted), nrow(junc_df))
-  expect_true(all(c("junc_id_lifted_is_unique", "junc_id_lifted") %in% names(junc_df_lifted)))
+  expect_true(all(c("liftover_successful", "liftover_unique", "junc_id_lifted") %in% names(junc_df_lifted)))
+
 
 })
 
@@ -27,8 +28,9 @@ test_that("liftover_junc_id works with non-unique mappings", {
   junc_df_lifted <- liftover_junc_id(junc_df, chain_file)
 
   expect_equal(nrow(junc_df_lifted), nrow(junc_df))
-  expect_false(all(junc_df_lifted$junc_id_lifted_is_unique))
-  expect_true(all(junc_df_lifted$junc_id_lifted_is_unique[1:3]))
+  expect_false(all(junc_df_lifted$liftover_unique))
+  expect_false(all(junc_df_lifted$liftover_successful))
+  expect_true(all(junc_df_lifted$liftover_unique[1:3]))
   expect_true(any(is.na(junc_df_lifted$junc_id_lifted)))
 
 })
@@ -46,7 +48,7 @@ test_that("liftover_junc_id for deleted junction position", {
   junc_df_lifted <- liftover_junc_id(junc_df, chain_file)
 
   expect_equal(nrow(junc_df_lifted), nrow(junc_df))
-  expect_false(all(junc_df_lifted$junc_id_lifted_is_unique))
-
+  expect_false(all(junc_df_lifted$liftover_successful))
+  expect_true(all(junc_df_lifted$liftover_unique))
 
 })