Merge pull request #40 from bahlolab/devel_speedy

0.88.0 tsum_test speedup 

Former-commit-id: b593684

.travis.yml

@@ -15,5 +15,3 @@ r_packages:
 
 r_github_packages:
   - rich-iannone/DiagrammeRsvg
-
-r_build_args: --no-build-vignettes

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: exSTRa
 Type: Package
 Title: Expanded STR algorithm: detecting expansions in Illumina sequencing data
-Version: 0.87.1
-Date: 2018-07-28
+Version: 0.88.0
+Date: 2018-08-31
 Author: Rick Tankard
 Maintainer: Rick Tankard <[email protected]>
 Description: Detecting expansions with paired-end Illumina sequencing data.
@@ -11,7 +11,7 @@ Imports: testit, data.table, stringr, reshape2, magrittr, RColorBrewer
 Suggests: testthat, DiagrammeR, DiagrammeRsvg, xlsx,
     knitr,
     rmarkdown
-RoxygenNote: 6.0.1
+RoxygenNote: 6.1.0
 LazyData: true
 Collate:
     'CLASS_exstra_db.R'
@@ -39,4 +39,5 @@ Collate:
     'suggested_exstra_pipeline.R'
     'tsum_p_value_summary.R'
     'tsum_test.R'
+    'tsum_test_1.R'
 VignetteBuilder: knitr

R/CLASS_exstra_score.R

@@ -1,8 +1,6 @@
 # The exstra_score class
 # Holds scores that give the proportion of a read that matches a given repeat.
 
-# TODO: inherit exstra_db, saving many rewriting of methods
-
 #' @import data.table
 #' @import stringr
 #' @import testit

R/CLASS_exstra_tsum.R

@@ -32,26 +32,43 @@ exstra_tsum_new_ <- function(strscore, tsum, p.values = NULL,
 
   setkey(tsum, locus, sample)
   if(is.null(p.values)) {
-    stats <- tsum
+    ts_fake <- structure(
+      list(stats = tsum, n_tests = tsum[!is.na(tsum), .N])
+      , class = c("exstra_tsum", "exstra_score", "exstra_db")
+    )
+    stats <- p_values(ts_fake,
+      correction = correction,
+      alpha = alpha,
+      only.signif = only.signif,
+      modify = TRUE
+    )
   } else {
     ps <- p_values(correction = correction,
       alpha = alpha,
       only.signif = only.signif,
       p.matrix = p.values)
     stats <- merge(tsum, ps, all = TRUE)
   }
+
+  out_list <- list(
+    data = strscore$data, 
+    db = strscore$db, 
+    input_type = strscore$input_type, 
+    samples = strscore$samples,
+    stats = stats,
+    args = args,
+    n_tests = sum (!is.na (stats$tsum))
+  )
+  # For old tsum_test_1() function:
+  if(!is.null(qmats)) {
+    out_list <- c(out_list, list(qmats = qmats))
+  }
+  if(!is.null(xecs)) {
+    out_list <- c(out_list, list(xecs = xecs))
+  }
+
   structure(
-    list(
-      data = strscore$data, 
-      db = strscore$db, 
-      input_type = strscore$input_type, 
-      samples = strscore$samples,
-      stats = stats,
-      qmats = qmats, 
-      xecs = xecs,
-      args = args,
-      n_tests = sum (!is.na (stats$tsum))
-    ), 
+    out_list, 
     class = c("exstra_tsum", "exstra_score", "exstra_db"))
 }
 

R/private_functions.R

@@ -457,7 +457,13 @@ trim_vector <- function(dim1, trim) {
   # takes an interger and trim value, gives indicies to keep
   # dim1: integer
   # trim: trimming proportion
-  seq(ceiling(dim1 * trim) + 1, floor(dim1 * (1 - trim)), 1)
+  ti <- trim_index_(dim1, trim)
+  seq(ti[1], ti[2], 1)
+}
+
+# gives indexes for trimming
+trim_index_ <- function(dim1, trim) {
+  c(ceiling(dim1 * trim) + 1, floor(dim1 * (1 - trim)))
 }
 
 quant_statistic <- function(qmmat, sample = 1, quant = 0.5, trim = 0.15,