Browse code

Support terminal_threshold parameter, and use different defaults for DNA vs. RNA. This means a big improvement in alignment quality for DNA.

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/gmapR@78423 bc3139a8-67e5-0310-9ffc-ced21a209358

Michael Lawrence authored on 14/07/2013 00:37:00
Showing 1 changed files

... ...
@@ -26,6 +26,8 @@ setClass("GsnapParam",
26 26
                         quiet_if_excessive = "logical",
27 27
                         nofails = "logical", 
28 28
                         split_output = "logical",
29
+                        terminal_threshold = "integer",
30
+                        gmap_mode = "character",
29 31
                         extra = "list"))
30 32
 
31 33
 ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
... ...
@@ -145,7 +147,7 @@ gsnap_extra <- function(x) {
145 147
 ### Constructor
146 148
 ###
147 149
 
148
-GsnapParam <- function(genome, unique_only = FALSE,
150
+GsnapParam <- function(genome, unique_only = FALSE, molecule = c("RNA", "DNA"),
149 151
                        max_mismatches = NULL,
150 152
                        suboptimal_levels = 0L, mode = "standard",
151 153
                        snps = NULL,
... ...
@@ -153,9 +155,12 @@ GsnapParam <- function(genome, unique_only = FALSE,
153 155
                        quiet_if_excessive = unique_only, nofails = unique_only,
154 156
                        split_output = !unique_only,
155 157
                        novelsplicing = FALSE, splicing = NULL, 
156
-                       nthreads = 1L, part = NULL, batch = "2", ...) {
158
+                       nthreads = 1L, part = NULL, batch = "2",
159
+                       terminal_threshold = if (molecule == "DNA") 1000L else 2L,
160
+                       gmap_mode = if (molecule == "DNA") "none", ...) {
157 161
   if (missing(genome))
158 162
     stop("The 'genome' must be specified (should be coercible to GmapGenome)")
163
+  molecule <- match.arg(molecule)
159 164
   args <- formals(sys.function())
160 165
   params <- mget(names(args), environment())
161 166
   params$unique_only <- NULL