R/05a-makeFinalTable-smallFuncs.R

In mdurbanowski/digR: Defective Interfering Genome Analysis in R

# These are small named functions that are not quite small enough to be made into anonoymous functions.
# Calling them from here declutters the main functions, and increases code readability.

# We want the indices of where the component fragments of each vRNA can be found in the "fragments"
# table.

#' Identify indices in fr which match those in fl
#'
#' @param x A numeric iterator variable, passed by calling function - Internal Function
#' @param fl A tibble of fulllength RNAs
#' @param fr A tibble of component fragments
#'
#' @return A numeric vector
#' @keywords internal
#'
.makeSeqIndices <-
  function(x, fl = NULL, fr = NULL) {
    which(((fl$vRNA_id[x] == fr$vRNA_id)
           &
             (fl$Passage_Number[x] == fr$Passage_Number)
           &
             (fl$filepath_and_index[x] == fr$filepath_and_index)
    ))
  }


#' Factory function for generating closures, which can dynamically create new columns - Internal Function
#'
#' @param y A numeric iterator variable, passed by calling function
#' @param textv A character vector of column names to add
#' @return A list of closures
#' @keywords internal
#'
.createColumns <- function(y, textv = NULL) {
  function(...) {
    purrr::map_chr(seq_along(textv), function(z)
      paste0("Fragment_", eval(y), eval(textv[z])))
  }
}


#' Pull fragment row indices for complete RNAs from fragment table
#'
#' @param x A numeric iterator variable, passed by calling function
#' @param sI A list of numerics produced by makeSeqIndices
#' @return A list of one or more numeric vectors that contain row indices of component fragments
#' @keywords internal
#'
.fill <- function(x, sI = NULL) {
  if (x == 1) {
    one <- purrr::map_dbl(sI, x)
    return(one)
  } else {
    twoOrMore <- as.character(purrr::map(sI, x))
    twoOrMoreNumeric <- suppressWarnings(as.numeric(twoOrMore))
    return(twoOrMoreNumeric)
  }
}

#' In the case where we are unable to assume/determine strand, identify duplicate RNA species within samples and
#' remove them.  Note that we require an *exact* match in order for a dupe to be called.  Configurable 
#' fuzzy matching might be implemented later.
#' 
#' @param diTable A tibble returned by makeDiTable
.dupeRemove <- function(RNATable, ignoreStrand = FALSE) {
  RNATable %>% select()
}