R/GsnapParam-class.R

In gmapR: An R interface to the GMAP/GSNAP/GSTRUCT suite

### =========================================================================
### GsnapParam class
### -------------------------------------------------------------------------
###
### High-level interface to gsnap. As a complex operation, we need a
### formal parameter object. It should only formally represent the
### most commonly used parameters. The rest fall into the 'extra'
### list.
###

setClass("GsnapParam",
         representation(max_mismatches = "integer_OR_NULL",
                        suboptimal_levels = "integer",
                        novelsplicing = "logical",
                        splicing = "character_OR_NULL",
                        terminal_threshold = "integer",
                        gmap_mode = "character",
                        clip_overlap = "logical"),
         contains="GmapAlignerParam")

### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Accessors
###

gsnap_part <- function(x) {
  x@part
}
gsnap_batch <- function(x) {
  x@batch
}
gsnap_max_mismatches <- function(x) {
  x@max_mismatches
}
gsnap_suboptimal_levels <- function(x) {
  x@suboptimal_levels
}
gsnap_use_snps <- function(x) {
  x@use_snps
}
gsnap_snpsdir <- function(x) {
  x@snpsdir
}
gsnap_mode <- function(x) {
  x@mode
}
gsnap_nthreads <- function(x) {
  x@nthreads
}
gsnap_novelsplicing <- function(x) {
  x@novelsplicing
}
gsnap_splicing <- function(x) {
  x@splicing
}
gsnap_npaths <- function(x) {
  x@npaths
}
gsnap_quiet_if_excessive <- function(x) {
  x@quiet_if_excessive
}
gsnap_nofails <- function(x) {
  x@nofails
}
gsnap_split_output <- function(x) {
  x@split_output
}
gsnap_extra <- function(x) {
  x@extra
}

`gsnap_part<-` <- function(x, value) {
  x@part <- value
  x
}
`gsnap_batch<-` <- function(x, value) {
  x@batch <- value
  x
}
`gsnap_max_mismatches<-` <- function(x, value) {
  x@max_mismatches <- value
  x
}
`gsnap_suboptimal_levels<-` <- function(x, value) {
  x@suboptimal_levels <- value
  x
}
`gsnap_use_snps<-` <- function(x, value) {
  x@use_snps <- value
  x
}
`gsnap_snpsdir<-` <- function(x, value) {
  x@snpsdir <- value
  x
}
`gsnap_mode<-` <- function(x, value) {
  x@mode <- value
  x
}
`gsnap_nthreads<-` <- function(x, value) {
  x@nthreads <- value
  x
}
`gsnap_novelsplicing<-` <- function(x, value) {
  x@novelsplicing <- value
  x
}
`gsnap_splicing<-` <- function(x, value) {
  x@splicing <- value
  x
}
`gsnap_npaths<-` <- function(x, value) {
  x@npaths <- value
  x
}
`gsnap_quiet_if_excessive<-` <- function(x, value) {
  x@quiet_if_excessive <- value
  x
}
`gsnap_nofails<-` <- function(x, value) {
  x@nofails <- value
  x
}
`gsnap_split_output<-` <- function(x, value) {
  x@split_output <- value
  x
}
`gsnap_extra<-` <- function(x, value) {
  x@extra <- value
  x
}

## etc..

### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Constructor
###

newGmapAlignerParam <- function(Class, genome, snps) {
    if (missing(genome))
        stop("The 'genome' must be specified (and coercible to GmapGenome)")
    args <- formals(sys.function(sys.parent(1L)))
    params <- mget(names(args), parent.frame())
    params$unique_only <- NULL
    paramClasses <- getSlots(Class)
    paramClasses <- paramClasses[setdiff(names(paramClasses),
                                         c("extra", "snps"))]
    params <- mapply(as, params[names(paramClasses)], paramClasses,
                     SIMPLIFY = FALSE)
    if (!is.null(snps)) {
        if (!is(snps, "GmapSnps")) {
            snps <- GmapSnps(snps, genome)
        }
        params$snps <- snps
    }
    params$extra <- evalq(list(...), parent.frame())
    do.call(new, c(Class, params))
}

GsnapParam <- function(genome, unique_only = FALSE, molecule = c("RNA", "DNA"),
                       max_mismatches = NULL,
                       suboptimal_levels = 0L, mode = "standard",
                       snps = NULL,
                       npaths = if (unique_only) 1L else 100L,
                       quiet_if_excessive = unique_only, nofails = unique_only,
                       split_output = !unique_only,
                       novelsplicing = FALSE, splicing = NULL, 
                       nthreads = 1L, part = NULL, batch = "2",
                       terminal_threshold =
                           if (molecule == "DNA") 1000L else 2L,
                       gmap_mode = if (molecule == "DNA") "none"
                                   else "pairsearch,terminal,improve",
                       clip_overlap = FALSE, ...)
{
  molecule <- match.arg(molecule)
  newGmapAlignerParam("GsnapParam", genome, snps)
}

### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Coercion
###

GmapAlignerParam_asList <- function(from) {
  to <- lapply(slotNames(from), slot, object = from)
  names(to) <- slotNames(from)
  to$split_output <- if (to$split_output) tolower(sub("Param", "", class(from)))
  to$db <- genome(to$genome)
  to$dir <- path(directory(to$genome))
  to$genome <- NULL
  to$use_snps <- name(to$snps)
  to$snpsdir <- path(directory(to$snps))
  extras <- to$extra
  to <- c(to, extras)
  to$extra <- NULL  
  to
}

setAs("GsnapParam", "list", function(from) {
          to <- GmapAlignerParam_asList(from)
          to$novelsplicing <- as.integer(to$novelsplicing)
          to <- rename(to, splicing = "use_splicing")
          to
      })

as.list.GmapAlignerParam <- function(x, ...) as(x, "list")

setAs("ANY", "character_OR_NULL", function(from) {
  if (is.null(from))
    NULL
  else as.character(from)
})
setAs("ANY", "integer_OR_NULL", function(from) {
  if (is.null(from))
    NULL
  else as.integer(from)
})


### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
### Show
###

setMethod("show", "GmapAlignerParam", function(object) {
  slots <- lapply(slotNames(object), slot, object = object)
  names(slots) <- slotNames(object)
  slots$genome <- paste0(slots$genome@name,
                         " (", path(directory(slots$genome)), ")")
  if (!is.null(slots$snps)) {
    slots$snps <- paste0(name(slots$snps),
                         " (", path(directory(slots$snps)), ")")
  }
  cat("A ", class(object), " object\n",
      paste0(names(slots), ": ", slots, collapse = "\n"), "\n", sep = "")
})