Browse code

Fixed vapply bug in LSD

Koustav Pal authored on 02/09/2019 09:08:53
Showing1 changed files
... ...
@@ -393,7 +393,7 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
393 393
     chr_done_filter <- vapply(Chromosomes, function(chr){
394 394
         Brick_matrix_isdone(Brick = Brick, chr1 = chr, chr2 = chr, 
395 395
             resolution = resolution)
396
-    })
396
+    }, TRUE)
397 397
     if(!all(chr_done_filter)){
398 398
         message("Skipping intra-chromosomal maps containing no data...")
399 399
         message(paste(Chromosomes[!chr_done_filter], collapse = ", "), 
Browse code

- Bugfix to plotting function. - Fixed the bug wherein two TADs called under two different colour groups were not being considered separately. - Bugfix to LSD - If chrs is NULL, then all chromosomes are processed. In such a scenario, if a chromosome pair is not done, this will cause the entire function to fail. Now, chromosomes which are not done are removed.

Koustav Pal authored on 02/09/2019 08:33:49
Showing1 changed files
... ...
@@ -390,6 +390,15 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
390 390
     if(!is.null(chrs)){
391 391
         Chromosomes <- ChromInfo[ChromInfo[,'chr'] %in% chrs,'chr']
392 392
     }
393
+    chr_done_filter <- vapply(Chromosomes, function(chr){
394
+        Brick_matrix_isdone(Brick = Brick, chr1 = chr, chr2 = chr, 
395
+            resolution = resolution)
396
+    })
397
+    if(!all(chr_done_filter)){
398
+        message("Skipping intra-chromosomal maps containing no data...")
399
+        message(paste(Chromosomes[!chr_done_filter], collapse = ", "), 
400
+            " will be skipped")
401
+    }
393 402
     Chrom.domains.ranges.list <- lapply(Chromosomes, function(chr){
394 403
         Ranges <- Brick_get_bintable(Brick = Brick, chr = chr, 
395 404
             resolution = resolution)
Browse code

bug fixes

Koustav Pal authored on 23/08/2019 22:41:53
Showing1 changed files
... ...
@@ -1,6 +1,6 @@
1 1
 ._get_first_nonzero_bin <- function(Brick = NULL, chr = NULL, resolution = NA){
2 2
     RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, chr2 = chr, 
3
-        resolution = resolution, what = "row.sums")
3
+        resolution = resolution, what = "chr1_row_sums")
4 4
     return(min(which(RowSums > 0)))
5 5
 }
6 6
 ._get_sparsity_index <- function(Brick = NULL, chr = NULL, resolution = NA){
... ...
@@ -169,7 +169,7 @@ get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL,
169 169
         resolution = resolution)
170 170
     chr.length <- length(Ranges)
171 171
     RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, chr2 = chr, 
172
-        resolution = resolution, what = "row.sums")
172
+        resolution = resolution, what = "chr1_row_sums")
173 173
     if(sparse){
174 174
         SparsityIndex <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
175 175
             chr2 = chr, resolution = resolution, what = "sparsity")
... ...
@@ -415,7 +415,7 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
415 415
             min_sum = min_sum, force = force_retrieve)
416 416
 
417 417
         RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
418
-            chr2 = chr, resolution = resolution, what = "row.sums")
418
+            chr2 = chr, resolution = resolution, what = "chr1_row_sums")
419 419
         Ranges$row.sums <- RowSums
420 420
         message("[2] Computing DI Differences for ",chr,"\n")
421 421
         if(sparse){
Browse code

Removed the usage of the exec parameter

Koustav Pal authored on 18/08/2019 22:28:36
Showing1 changed files
... ...
@@ -364,7 +364,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
364 364
 #' 
365 365
 #' My_BrickContainer <- Create_many_Bricks(BinTable = Bintable.path, 
366 366
 #'   bin_delim = " ", output_directory = out_dir, file_prefix = "Test",
367
-#'   exec = "cat", experiment_name = "Vignette Test", resolution = 100000,
367
+#'   experiment_name = "Vignette Test", resolution = 100000,
368 368
 #'   remove_existing = TRUE)
369 369
 #' 
370 370
 #' Matrix_file <- system.file(file.path("extdata", 
... ...
@@ -372,7 +372,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
372 372
 #' package = "HiCBricks")
373 373
 #' 
374 374
 #' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr3R", 
375
-#' chr2 = "chr3R", matrix_file = Matrix_file, delim = " ", exec = "zcat",
375
+#' chr2 = "chr3R", matrix_file = Matrix_file, delim = " ",
376 376
 #' remove_prior = TRUE, resolution = 100000)
377 377
 #' 
378 378
 #' TAD_ranges <- Brick_local_score_differentiator(Brick = My_BrickContainer, 
Browse code

Bugfixes and finally all examples have passed and vignette building is complete

Koustav Pal authored on 14/08/2019 15:43:07
Showing1 changed files
... ...
@@ -356,13 +356,28 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
356 356
 #' the bintable. 
357 357
 #' 
358 358
 #' @examples
359
-#' Container_file <- system.file(file.path("extdata",
360
-#' "HiCBricks_builder_config.json"), package = "HiCBricks")
361
-#' Brick_test <- load_BrickContainer(config_file = Container_file)
359
+#' Bintable.path <- system.file(file.path("extdata", "Bintable_100kb.bins"), 
360
+#' package = "HiCBricks")
362 361
 #' 
363
-#' TAD_ranges <- Brick_local_score_differentiator(Brick = Brick_test, 
364
-#' chrs = "chr2L", di_window = 10, lookup_window = 30, strict = TRUE, 
365
-#' fill_gaps = TRUE, chunk_size = 500)
362
+#' out_dir <- file.path(tempdir(), "lsd_test")
363
+#' dir.create(out_dir)
364
+#' 
365
+#' My_BrickContainer <- Create_many_Bricks(BinTable = Bintable.path, 
366
+#'   bin_delim = " ", output_directory = out_dir, file_prefix = "Test",
367
+#'   exec = "cat", experiment_name = "Vignette Test", resolution = 100000,
368
+#'   remove_existing = TRUE)
369
+#' 
370
+#' Matrix_file <- system.file(file.path("extdata", 
371
+#' "Sexton2012_yaffetanay_CisTrans_100000_corrected_chr3R.txt.gz"), 
372
+#' package = "HiCBricks")
373
+#' 
374
+#' Brick_load_matrix(Brick = My_BrickContainer, chr1 = "chr3R", 
375
+#' chr2 = "chr3R", matrix_file = Matrix_file, delim = " ", exec = "zcat",
376
+#' remove_prior = TRUE, resolution = 100000)
377
+#' 
378
+#' TAD_ranges <- Brick_local_score_differentiator(Brick = My_BrickContainer, 
379
+#' chrs = "chr3R", resolution = 100000, di_window = 10, lookup_window = 30, 
380
+#' strict = TRUE, fill_gaps = TRUE, chunk_size = 500)
366 381
 Brick_local_score_differentiator <- function(Brick, chrs = NULL, 
367 382
     resolution = NA, all_resolutions = FALSE, min_sum = -1, di_window = 200L, 
368 383
     lookup_window = 200L, tukeys_constant=1.5, strict = TRUE, fill_gaps=TRUE, 
Browse code

Bug fixes for BrickContainer functions

Koustav Pal authored on 13/08/2019 18:48:21
Showing1 changed files
... ...
@@ -1,11 +1,11 @@
1
-._get_first_nonzero_bin <- function(Brick = NULL, chr = NULL){
1
+._get_first_nonzero_bin <- function(Brick = NULL, chr = NULL, resolution = NA){
2 2
     RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, chr2 = chr, 
3
-        what = "row.sums")
3
+        resolution = resolution, what = "row.sums")
4 4
     return(min(which(RowSums > 0)))
5 5
 }
6
-._get_sparsity_index <- function(Brick = NULL, chr = NULL){
6
+._get_sparsity_index <- function(Brick = NULL, chr = NULL, resolution = NA){
7 7
     Sparsity.index <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
8
-        chr2 = chr, what = "sparsity")
8
+        chr2 = chr, resolution = resolution, what = "sparsity")
9 9
     return(Sparsity.index)
10 10
 }
11 11
 Backwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,
... ...
@@ -160,17 +160,19 @@ ComputeDirectionalityIndex <- function(Matrix = NULL, Window.size=NULL,
160 160
     DI.Data[Sequence %in% Bins.to.process] <- DI.list
161 161
     return(DI.Data)
162 162
 }
163
-get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL, 
164
-    di_window = NULL, distance = NULL, chunk_size = 500, sparse = FALSE, 
165
-    sparsity_threshold = 0.8, min_sum = -1, force = FALSE){
166
-    Ranges <- Brick_get_bintable(Brick = Brick, chr = chr)
167
-    First.non.zero.bin <- ._get_first_nonzero_bin(Brick = Brick, chr = chr)
163
+get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL,
164
+    resolution = NA, di_window = NULL, distance = NULL, chunk_size = 500, 
165
+    sparse = FALSE, sparsity_threshold = 0.8, min_sum = -1, force = FALSE){
166
+    Ranges <- Brick_get_bintable(Brick = Brick, chr = chr, 
167
+        resolution = resolution)
168
+    First.non.zero.bin <- ._get_first_nonzero_bin(Brick = Brick, chr = chr,
169
+        resolution = resolution)
168 170
     chr.length <- length(Ranges)
169 171
     RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, chr2 = chr, 
170
-        what = "row.sums")
172
+        resolution = resolution, what = "row.sums")
171 173
     if(sparse){
172 174
         SparsityIndex <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
173
-            chr2 = chr, what = "sparsity")
175
+            chr2 = chr, resolution = resolution, what = "sparsity")
174 176
     }
175 177
     if((chunk_size - (di_window*2))/di_window < 10){
176 178
         stop("chunk_size is too small for this di_window\n")
... ...
@@ -217,7 +219,8 @@ get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL,
217 219
             extend <- extend + 1
218 220
         }
219 221
         Matrix <- Brick_get_vector_values(Brick = Brick, chr1 = chr, 
220
-            chr2 = chr, xaxis=c(Start:End), yaxis=c(Start:End), force = force)
222
+            resolution = resolution, chr2 = chr, xaxis=c(Start:End), 
223
+            yaxis=c(Start:End), force = force)
221 224
         # cat((Start - 1),"\n")
222 225
         # message(Position.start," ",Position.end,"\n")
223 226
         # message(Position.start - (Start - 1),Position.end - (Start - 1),"\n")
... ...
@@ -285,6 +288,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
285 288
 #' in a very fast way. 
286 289
 #' 
287 290
 #' @inheritParams Brick_get_chrominfo
291
+#' @inheritParams Brick_add_ranges
288 292
 #' 
289 293
 #' @param chrs \strong{Optional}. Default NULL
290 294
 #' If present, only TAD calls for elements in \emph{chrs} will be done.
... ...
@@ -360,19 +364,24 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
360 364
 #' chrs = "chr2L", di_window = 10, lookup_window = 30, strict = TRUE, 
361 365
 #' fill_gaps = TRUE, chunk_size = 500)
362 366
 Brick_local_score_differentiator <- function(Brick, chrs = NULL, 
363
-    min_sum = -1, di_window = 200L, lookup_window = 200L, tukeys_constant=1.5, 
364
-    strict = TRUE, fill_gaps=TRUE, ignore_sparse=TRUE, sparsity_threshold=0.8,
365
-    remove_empty = NULL, chunk_size = 500, force_retrieve = TRUE){
366
-    ChromInfo <- Brick_get_chrominfo(Brick = Brick)
367
+    resolution = NA, all_resolutions = FALSE, min_sum = -1, di_window = 200L, 
368
+    lookup_window = 200L, tukeys_constant=1.5, strict = TRUE, fill_gaps=TRUE, 
369
+    ignore_sparse=TRUE, sparsity_threshold=0.8, remove_empty = NULL, 
370
+    chunk_size = 500, force_retrieve = TRUE){
371
+    BrickContainer_resolution_check(resolution, all_resolutions)
372
+    ChromInfo <- Brick_get_chrominfo(Brick = Brick, 
373
+        resolution = resolution)
367 374
     Chromosomes <- ChromInfo[,'chr']
368 375
     if(!is.null(chrs)){
369 376
         Chromosomes <- ChromInfo[ChromInfo[,'chr'] %in% chrs,'chr']
370 377
     }
371 378
     Chrom.domains.ranges.list <- lapply(Chromosomes, function(chr){
372
-        Ranges <- Brick_get_bintable(Brick = Brick, chr = chr)
373
-        sparse <- Brick_matrix_issparse(Brick = Brick, chr1 = chr, chr2 = chr)
379
+        Ranges <- Brick_get_bintable(Brick = Brick, chr = chr, 
380
+            resolution = resolution)
381
+        sparse <- Brick_matrix_issparse(Brick = Brick, chr1 = chr, chr2 = chr, 
382
+            resolution = resolution)
374 383
         max.distance <- Brick_matrix_maxdist(Brick = Brick, chr1 = chr, 
375
-            chr2 = chr)
384
+            chr2 = chr, resolution = resolution)
376 385
         if(ignore_sparse){
377 386
             sparse=FALSE
378 387
         }
... ...
@@ -380,25 +389,34 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
380 389
             fill_gaps=FALSE
381 390
         }
382 391
         message("[1] Computing DI for ",chr,"\n")
383
-        Ranges <- get_directionality_index_by_chunks(Brick = Brick, chr = chr, 
392
+        Ranges <- get_directionality_index_by_chunks(Brick = Brick, 
393
+            chr = chr, 
394
+            resolution = resolution,
384 395
             di_window = di_window, 
385
-            distance = max.distance, chunk_size = chunk_size, sparse=sparse, 
396
+            distance = max.distance, 
397
+            chunk_size = chunk_size, 
398
+            sparse=sparse, 
386 399
             sparsity_threshold=sparsity_threshold,
387 400
             min_sum = min_sum, force = force_retrieve)
388 401
 
389 402
         RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
390
-            chr2 = chr, what = "row.sums")
403
+            chr2 = chr, resolution = resolution, what = "row.sums")
391 404
         Ranges$row.sums <- RowSums
392 405
         message("[2] Computing DI Differences for ",chr,"\n")
393 406
         if(sparse){
394
-            SparsityIndex <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
395
-                chr2 = chr, what = "sparsity")
407
+            SparsityIndex <- Brick_get_matrix_mcols(Brick = Brick, 
408
+                chr1 = chr, 
409
+                chr2 = chr, 
410
+                resolution = resolution, 
411
+                what = "sparsity")
396 412
             Backwards.DI.Difference <- Backwards.Difference(
397
-                Vector = Ranges$DI.Data, sparse = sparse,
413
+                Vector = Ranges$DI.Data, 
414
+                sparse = sparse,
398 415
                 sparsity.idx = SparsityIndex, 
399 416
                 sparsity_threshold = sparsity_threshold)
400 417
             Forwards.DI.Difference <- Forwards.Difference(
401
-                Vector = Ranges$DI.Data, sparse = sparse,
418
+                Vector = Ranges$DI.Data, 
419
+                sparse = sparse,
402 420
                 sparsity.idx = SparsityIndex, 
403 421
                 sparsity_threshold = sparsity_threshold)
404 422
         }else{
... ...
@@ -413,22 +431,29 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
413 431
         message("[3] Fetching Outliers ",chr,"\n")
414 432
         if(sparse){
415 433
             Domain.end.candidates <- ComputeOutlierOverIQRInsideWindow(
416
-                lookup_window=lookup_window,
417
-                diff.values=Backwards.DI.Difference, 
418
-                values=Ranges$DI.Data, sparse=sparse, 
434
+                lookup_window = lookup_window,
435
+                diff.values = Backwards.DI.Difference, 
436
+                values = Ranges$DI.Data, 
437
+                sparse = sparse, 
419 438
                 row.sums = Ranges$row.sums,
420
-                min_sum = min_sum, sparsity.idx=SparsityIndex, 
421
-                sparsity_threshold=sparsity_threshold, 
422
-                tukeys_constant=tukeys_constant, 
423
-                tail="lower.tail",strict=strict)
439
+                min_sum = min_sum, 
440
+                sparsity.idx = SparsityIndex, 
441
+                sparsity_threshold = sparsity_threshold, 
442
+                tukeys_constant = tukeys_constant, 
443
+                tail = "lower.tail",
444
+                strict = strict)
424 445
             Domain.start.candidates <- ComputeOutlierOverIQRInsideWindow(
425
-                lookup_window=lookup_window,
426
-                diff.values=Forwards.DI.Difference, values=Ranges$DI.Data, 
427
-                sparse=sparse, row.sums = Ranges$row.sums,
428
-                min_sum = min_sum, sparsity.idx=SparsityIndex, 
429
-                sparsity_threshold=sparsity_threshold,
430
-                tukeys_constant=tukeys_constant, tail="upper.tail", 
431
-                strict=strict)
446
+                lookup_window = lookup_window,
447
+                diff.values = Forwards.DI.Difference, 
448
+                values = Ranges$DI.Data, 
449
+                sparse = sparse, 
450
+                row.sums = Ranges$row.sums,
451
+                min_sum = min_sum, 
452
+                sparsity.idx = SparsityIndex, 
453
+                sparsity_threshold = sparsity_threshold,
454
+                tukeys_constant = tukeys_constant, 
455
+                tail = "upper.tail", 
456
+                strict = strict)
432 457
         }else{
433 458
             Domain.end.candidates <- ComputeOutlierOverIQRInsideWindow(
434 459
                 lookup_window=lookup_window,
... ...
@@ -462,7 +487,7 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
462 487
             Domain.end.candidates <- c(Domain.end.candidates,length(Ranges))
463 488
         }
464 489
         Domain.list <- CreateDomainlist(start.vector=Domain.start.candidates,
465
-            end.vector=Domain.end.candidates,fill_gaps=fill_gaps)
490
+            end.vector=Domain.end.candidates, fill_gaps=fill_gaps)
466 491
         Domain.Ranges <- Brick_make_ranges(chrom=rep(chr,nrow(Domain.list)),
467 492
             start=start(Ranges[Domain.list$startbin]),
468 493
             end=end(Ranges[Domain.list$endbin]))
Browse code

Made major changes to the Brick workflow. Now bricks are stored as separate files. Functions for parallelization has been added. This is an unstable build.

Koustav Pal authored on 09/08/2019 15:18:42
Showing1 changed files
... ...
@@ -9,16 +9,16 @@
9 9
     return(Sparsity.index)
10 10
 }
11 11
 Backwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,
12
-    sparsity.threshold=NULL){
12
+    sparsity_threshold=NULL){
13 13
         if(is.null(Vector)){
14 14
             stop("Vector variable cannot be empty.")
15 15
         }
16 16
         if(sparse){
17 17
             VectorDiff <- rep(NA,length(Vector))
18 18
             temp.diff <- rev(diff(
19
-                rev(Vector[sparsity.idx > sparsity.threshold])))
19
+                rev(Vector[sparsity.idx > sparsity_threshold])))
20 20
             temp.diff[length(temp.diff)+1] <- 0
21
-            VectorDiff[sparsity.idx > sparsity.threshold] <- temp.diff
21
+            VectorDiff[sparsity.idx > sparsity_threshold] <- temp.diff
22 22
         }else{
23 23
             VectorDiff<-rev(diff(rev(Vector)))
24 24
             VectorDiff[length(Vector)]=0
... ...
@@ -26,45 +26,45 @@ Backwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,
26 26
         return(VectorDiff)
27 27
 }
28 28
 Forwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,
29
-    sparsity.threshold=NULL){
29
+    sparsity_threshold=NULL){
30 30
         if(is.null(Vector)){
31 31
             stop("Vector variable cannot be empty.")
32 32
         }
33 33
         if(sparse){
34 34
             VectorDiff <- rep(NA,length(Vector))
35
-            temp.diff <- diff(Vector[sparsity.idx > sparsity.threshold])
35
+            temp.diff <- diff(Vector[sparsity.idx > sparsity_threshold])
36 36
             temp.diff <- c(0,temp.diff)
37
-            VectorDiff[sparsity.idx > sparsity.threshold] <- temp.diff
37
+            VectorDiff[sparsity.idx > sparsity_threshold] <- temp.diff
38 38
         }else{
39 39
         VectorDiff<-diff(Vector)
40 40
         VectorDiff=c(0,VectorDiff)
41 41
         }
42 42
         return(VectorDiff)
43 43
 }
44
-ComputeOutlierOverIQRInsideWindow <- function(lookup.window=NULL,
44
+ComputeOutlierOverIQRInsideWindow <- function(lookup_window=NULL,
45 45
     diff.values=NULL,values=NULL, row.sums = NULL,
46
-        min.sum = NULL, tukeys.constant=NULL,tail=NULL,
47
-        sparse=FALSE,strict = FALSE,sparsity.idx=NULL,sparsity.threshold=NULL){
46
+        min_sum = NULL, tukeys_constant=NULL,tail=NULL,
47
+        sparse=FALSE,strict = FALSE,sparsity.idx=NULL,sparsity_threshold=NULL){
48 48
         seq.over.value <- seq_along(diff.values)
49
-        Filter <- row.sums > min.sum
49
+        Filter <- row.sums > min_sum
50 50
         if(sparse){
51
-            Filter <- Filter & sparsity.idx > sparsity.threshold
51
+            Filter <- Filter & sparsity.idx > sparsity_threshold
52 52
         }
53 53
         seq.over.value <- seq.over.value[Filter]
54 54
         seq.over.seq <- seq_along(seq.over.value)
55 55
         outlier.list <- lapply(seq.over.seq,function(x.seq){
56
-            lookup.window.range <- (
57
-                (x.seq - lookup.window) : (x.seq + lookup.window))
58
-            lookup.window.range <- seq.over.value[lookup.window.range[
59
-            lookup.window.range>0 & lookup.window.range<=max(seq.over.seq)]]
60
-            offset <- (min(lookup.window.range)-1)
61
-            diff.value.window <- diff.values[lookup.window.range]
62
-            value.window <- values[lookup.window.range]
56
+            lookup_window.range <- (
57
+                (x.seq - lookup_window) : (x.seq + lookup_window))
58
+            lookup_window.range <- seq.over.value[lookup_window.range[
59
+            lookup_window.range>0 & lookup_window.range<=max(seq.over.seq)]]
60
+            offset <- (min(lookup_window.range)-1)
61
+            diff.value.window <- diff.values[lookup_window.range]
62
+            value.window <- values[lookup_window.range]
63 63
             value.quartile<-quantile(diff.value.window,na.rm=TRUE)
64 64
             InterQuartile <- value.quartile[4]-value.quartile[2]
65 65
             if(tail=="lower.tail"){
66 66
                 #Calculate Inner fences based on accepted formula
67
-                fences <- value.quartile[2] - (InterQuartile*tukeys.constant)
67
+                fences <- value.quartile[2] - (InterQuartile*tukeys_constant)
68 68
                 Outlier.Filter <- !is.na(value.window) &
69 69
                 diff.value.window <= fences &
70 70
                 diff.value.window < value.window
... ...
@@ -72,7 +72,7 @@ ComputeOutlierOverIQRInsideWindow <- function(lookup.window=NULL,
72 72
                     Outlier.Filter <- Outlier.Filter & (value.window < 0)
73 73
                 }
74 74
             }else if(tail=="upper.tail"){
75
-                fences <- value.quartile[4] + (InterQuartile*tukeys.constant)
75
+                fences <- value.quartile[4] + (InterQuartile*tukeys_constant)
76 76
                 Outlier.Filter <- !is.na(value.window) &
77 77
                 diff.value.window >= fences &
78 78
                 diff.value.window > value.window
... ...
@@ -82,7 +82,7 @@ ComputeOutlierOverIQRInsideWindow <- function(lookup.window=NULL,
82 82
             }
83 83
             outliers<-which(Outlier.Filter)
84 84
             if(length(outliers)>0){
85
-                outliers <- lookup.window.range[outliers]
85
+                outliers <- lookup_window.range[outliers]
86 86
             }
87 87
             outliers
88 88
         })
... ...
@@ -90,7 +90,7 @@ ComputeOutlierOverIQRInsideWindow <- function(lookup.window=NULL,
90 90
         outlier.vector.uniq.sorted <- sort(unique(outlier.vector.dups))
91 91
         return(outlier.vector.uniq.sorted)
92 92
 }
93
-CreateDomainlist <- function(start.vector=NULL,end.vector=NULL,fill.gaps=NULL){
93
+CreateDomainlist <- function(start.vector=NULL,end.vector=NULL,fill_gaps=NULL){
94 94
     Domains.by.start.list <- lapply(start.vector,function(x){
95 95
         data.frame(startbin=x, endbin=min(end.vector[end.vector > x]))
96 96
     })
... ...
@@ -99,7 +99,7 @@ CreateDomainlist <- function(start.vector=NULL,end.vector=NULL,fill.gaps=NULL){
99 99
     Domains.by.start.df$level <- 2
100 100
     Domains.by.end.df <- NULL
101 101
     Domains.by.assumption.df <- NULL
102
-    if(fill.gaps){
102
+    if(fill_gaps){
103 103
         uncurated.ends <- end.vector[
104 104
         !(end.vector %in% Domains.by.start.df[,"endbin"])]
105 105
         if(length(uncurated.ends) > 0){
... ...
@@ -161,8 +161,8 @@ ComputeDirectionalityIndex <- function(Matrix = NULL, Window.size=NULL,
161 161
     return(DI.Data)
162 162
 }
163 163
 get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL, 
164
-    di.window = NULL, distance = NULL, chunk.size = 500, sparse = FALSE, 
165
-    sparsity.threshold = 0.8, min.sum = -1, force = FALSE){
164
+    di_window = NULL, distance = NULL, chunk_size = 500, sparse = FALSE, 
165
+    sparsity_threshold = 0.8, min_sum = -1, force = FALSE){
166 166
     Ranges <- Brick_get_bintable(Brick = Brick, chr = chr)
167 167
     First.non.zero.bin <- ._get_first_nonzero_bin(Brick = Brick, chr = chr)
168 168
     chr.length <- length(Ranges)
... ...
@@ -172,15 +172,15 @@ get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL,
172 172
         SparsityIndex <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
173 173
             chr2 = chr, what = "sparsity")
174 174
     }
175
-    if((chunk.size - (di.window*2))/di.window < 10){
176
-        stop("chunk.size is too small for this di.window\n")
175
+    if((chunk_size - (di_window*2))/di_window < 10){
176
+        stop("chunk_size is too small for this di_window\n")
177 177
     }
178
-    if(any(di.window > distance)){
179
-        stop("di.window cannot be larger than distance\n")
178
+    if(any(di_window > distance)){
179
+        stop("di_window cannot be larger than distance\n")
180 180
     }
181 181
     Span <- (chr.length - First.non.zero.bin)
182
-    Iterations <- Span/chunk.size
183
-    Starts <- seq(from = First.non.zero.bin, to = chr.length, by = chunk.size)
182
+    Iterations <- Span/chunk_size
183
+    Starts <- seq(from = First.non.zero.bin, to = chr.length, by = chunk_size)
184 184
     Starts <- Starts[Starts != chr.length]
185 185
     Ends <- c(Starts[-1] -1, chr.length)
186 186
     DI.data.list <- lapply(seq_along(Starts), function(x){
... ...
@@ -188,15 +188,15 @@ get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL,
188 188
         End <- Ends[x]
189 189
         Position.start <- Start
190 190
         Position.end <- End
191
-        Start <- ifelse((Start - di.window) < First.non.zero.bin, 
192
-            First.non.zero.bin, (Start - di.window))
193
-        End <- ifelse((End + di.window) > chr.length, 
194
-            chr.length, (End + di.window))
191
+        Start <- ifelse((Start - di_window) < First.non.zero.bin, 
192
+            First.non.zero.bin, (Start - di_window))
193
+        End <- ifelse((End + di_window) > chr.length, 
194
+            chr.length, (End + di_window))
195 195
         RowSums.subset <- RowSums[Start:End]
196
-        Filter <- RowSums.subset > min.sum
196
+        Filter <- RowSums.subset > min_sum
197 197
         if(sparse){
198 198
             Sparsity.index.subset <- SparsityIndex[Start:End]
199
-            Filter <- Filter & (Sparsity.index.subset > sparsity.threshold)
199
+            Filter <- Filter & (Sparsity.index.subset > sparsity_threshold)
200 200
         }
201 201
         Total.length <- length(Filter)
202 202
         Filter.extend.length <- length(which(!Filter))
... ...
@@ -208,10 +208,10 @@ get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL,
208 208
             End <- ifelse((End + extend) > chr.length, 
209 209
                 chr.length, (End + extend))
210 210
             RowSums.subset <- RowSums[Start:End]
211
-            Filter <- RowSums.subset > min.sum
211
+            Filter <- RowSums.subset > min_sum
212 212
             if(sparse){
213 213
                 Sparsity.index.subset <- SparsityIndex[Start:End]
214
-                Filter <- Filter & (Sparsity.index.subset > sparsity.threshold)
214
+                Filter <- Filter & (Sparsity.index.subset > sparsity_threshold)
215 215
             }
216 216
             True.length <- length(which(Filter))
217 217
             extend <- extend + 1
... ...
@@ -222,7 +222,7 @@ get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL,
222 222
         # message(Position.start," ",Position.end,"\n")
223 223
         # message(Position.start - (Start - 1),Position.end - (Start - 1),"\n")
224 224
         DI.data <- ComputeDirectionalityIndex(Matrix = Matrix, 
225
-            Window.size = di.window, filter = Filter, 
225
+            Window.size = di_window, filter = Filter, 
226 226
             start = Position.start - (Start - 1), 
227 227
             end = Position.end - (Start - 1))
228 228
         return(DI.data)
... ...
@@ -239,9 +239,9 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
239 239
     Starts <- Starts[seq_len(length(Starts))[-1]] - 1 
240 240
     Domain.boundaries <- unique(Starts,Ends)
241 241
     Boundary.ranges <- Brick_make_ranges(
242
-        Chrom=rep(chr,length(Domain.boundaries)),
243
-        Start=(Domain.boundaries-(Binsize/2))+1,
244
-        End=Domain.boundaries+(Binsize/2))
242
+        chrom=rep(chr,length(Domain.boundaries)),
243
+        start=(Domain.boundaries-(Binsize/2))+1,
244
+        end=Domain.boundaries+(Binsize/2))
245 245
 }
246 246
 
247 247
 #' Do TAD Calls with Local Score Differentiator on a Hi-C matrix
... ...
@@ -263,10 +263,10 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
263 263
 #' and the original directionality index, we define domain borders as outliers.
264 264
 #' 
265 265
 #' To define an outlier, fences are first defined. The fences are defined using
266
-#' tukeys.constant x inter-quartile range of the directionality index. The upper
266
+#' tukeys_constant x inter-quartile range of the directionality index. The upper
267 267
 #' fence used for detecting domain starts is the 75th quartile + 
268
-#' (IQR x tukeys.constant), while the lower fence is the 
269
-#' 25th quartile - (IQR x tukeys.constant). For domain starts the DI difference
268
+#' (IQR x tukeys_constant), while the lower fence is the 
269
+#' 25th quartile - (IQR x tukeys_constant). For domain starts the DI difference
270 270
 #' must be greater than or equal to the upper fence, it must be greater than the
271 271
 #' DI and the DI must be a finite real value. If strict is TRUE, DI will also
272 272
 #' be required to be greater than 0. Similarly, for domain ends the 
... ...
@@ -275,7 +275,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
275 275
 #' DI will also be required to be lower than 0. 
276 276
 #' 
277 277
 #' After defining outliers, each domain start will be associated to its 
278
-#' nearest downstream domain end. If \emph{fill.gaps} is defined as TRUE and
278
+#' nearest downstream domain end. If \emph{fill_gaps} is defined as TRUE and
279 279
 #' there are domain ends which remain unassociated to a domain start, These 
280 280
 #' domain ends will be associated to the bin adjacent to their nearest upstream
281 281
 #' domain end. This associations will be marked by metadata columns, gap.fill= 1
... ...
@@ -289,18 +289,18 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
289 289
 #' @param chrs \strong{Optional}. Default NULL
290 290
 #' If present, only TAD calls for elements in \emph{chrs} will be done.
291 291
 #' 
292
-#' @param min.sum \strong{Optional}. Default -1
293
-#' Process bins in the matrix with row.sums greater than \emph{min.sum}.
292
+#' @param min_sum \strong{Optional}. Default -1
293
+#' Process bins in the matrix with row.sums greater than \emph{min_sum}.
294 294
 #' 
295
-#' @param di.window \strong{Optional}. Default 200
296
-#' Use \emph{di.window} to define the directionality index.
295
+#' @param di_window \strong{Optional}. Default 200
296
+#' Use \emph{di_window} to define the directionality index.
297 297
 #' 
298
-#' @param lookup.window \strong{Optional}. Default 200
299
-#' Use \emph{lookup.window} local window to call borders. At smaller 
300
-#' \emph{di.window} values we recommend setting this to 2*\emph{di.window}
298
+#' @param lookup_window \strong{Optional}. Default 200
299
+#' Use \emph{lookup_window} local window to call borders. At smaller 
300
+#' \emph{di_window} values we recommend setting this to 2*\emph{di_window}
301 301
 #' 
302
-#' @param tukeys.constant \strong{Optional}. Default 1.5
303
-#' \emph{tukeys.constant}*IQR (inter-quartile range) defines the lower and upper
302
+#' @param tukeys_constant \strong{Optional}. Default 1.5
303
+#' \emph{tukeys_constant}*IQR (inter-quartile range) defines the lower and upper
304 304
 #' fence values.
305 305
 #' 
306 306
 #' @param strict \strong{Optional}. Default TRUE
... ...
@@ -308,11 +308,11 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
308 308
 #' index requiring it to be either greater than or less than 0 on the right tail
309 309
 #' or left tail respectively.  
310 310
 #' 
311
-#' @param fill.gaps \strong{Optional}. Default TRUE
311
+#' @param fill_gaps \strong{Optional}. Default TRUE
312 312
 #' If TRUE, this will affect the TAD stiching process. All Border starts are 
313 313
 #' stiched to the next downstream border ends. Therefore, at times border ends 
314 314
 #' remain unassociated to a border start. These border ends are stiched to the 
315
-#' adjacent downstream bin from their upstream border end when \emph{fill.gaps} 
315
+#' adjacent downstream bin from their upstream border end when \emph{fill_gaps} 
316 316
 #' is true. 
317 317
 #' 
318 318
 #' TADs inferred in this way will be annotated with two metadata columns in the 
... ...
@@ -320,27 +320,27 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
320 320
 #' hold a value 1. TADs which were not filled in will hold a gap.fill value of
321 321
 #' 0 and a level value of 2.
322 322
 #' 
323
-#' @param ignore.sparse \strong{Optional}. Default TRUE
323
+#' @param ignore_sparse \strong{Optional}. Default TRUE
324 324
 #' If TRUE, a matrix which has been defined as sparse during the matrix loading
325
-#' process will be treated as a dense matrix. The \emph{sparsity.threshold} 
325
+#' process will be treated as a dense matrix. The \emph{sparsity_threshold} 
326 326
 #' filter will not be applied. Please note, that if a matrix is defined as 
327
-#' sparse and fill.gaps is TRUE, fill.gaps will be turned off.
327
+#' sparse and fill_gaps is TRUE, fill_gaps will be turned off.
328 328
 #' 
329
-#' @param sparsity.threshold \strong{Optional}. Default 0.8
329
+#' @param sparsity_threshold \strong{Optional}. Default 0.8
330 330
 #' Sparsity threshold relates to the sparsity index, which is computed as the 
331 331
 #' number of non-zero bins at a certain distance from the diagonal. If a matrix
332
-#' is sparse and ignore.sparse is FALSE, bins which have a sparsity index value
332
+#' is sparse and ignore_sparse is FALSE, bins which have a sparsity index value
333 333
 #' below this threshold will be discarded from DI computation.
334 334
 #' 
335
-#' @param remove.empty Not implemented.
335
+#' @param remove_empty Not implemented.
336 336
 #' After implementation, this will ensure that the presence of centromeric 
337 337
 #' regions is accounted for.
338 338
 #' 
339
-#' @param chunk.size \strong{Optional}. Default 500
339
+#' @param chunk_size \strong{Optional}. Default 500
340 340
 #' The size of the matrix chunk to process. This value should be larger than 2x
341
-#' di.window.
341
+#' di_window.
342 342
 #' 
343
-#' @param force.retrieve \strong{Optional}. Default TRUE
343
+#' @param force_retrieve \strong{Optional}. Default TRUE
344 344
 #' If TRUE, this will force the retrieval of a matrix chunk even when the 
345 345
 #' retrieval includes interaction points which were not loaded into a Brick 
346 346
 #' store (larger chunks). Please note, that this does not mean that DI can be 
... ...
@@ -352,14 +352,17 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
352 352
 #' the bintable. 
353 353
 #' 
354 354
 #' @examples
355
-#' Brick.file <- system.file("extdata", "test.hdf", package = "HiCBricks")
356
-#' TAD_ranges <- Brick_local_score_differentiator(Brick = Brick.file, 
357
-#' chrs = "chr19", di.window = 10, lookup.window = 30, strict = TRUE, 
358
-#' fill.gaps = TRUE, chunk.size = 500)
355
+#' Container_file <- system.file(file.path("extdata",
356
+#' "HiCBricks_builder_config.json"), package = "HiCBricks")
357
+#' Brick_test <- load_BrickContainer(config_file = Container_file)
358
+#' 
359
+#' TAD_ranges <- Brick_local_score_differentiator(Brick = Brick_test, 
360
+#' chrs = "chr2L", di_window = 10, lookup_window = 30, strict = TRUE, 
361
+#' fill_gaps = TRUE, chunk_size = 500)
359 362
 Brick_local_score_differentiator <- function(Brick, chrs = NULL, 
360
-    min.sum = -1, di.window = 200L, lookup.window = 200L, tukeys.constant=1.5, 
361
-    strict = TRUE, fill.gaps=TRUE, ignore.sparse=TRUE, sparsity.threshold=0.8,
362
-    remove.empty = NULL, chunk.size = 500, force.retrieve = TRUE){
363
+    min_sum = -1, di_window = 200L, lookup_window = 200L, tukeys_constant=1.5, 
364
+    strict = TRUE, fill_gaps=TRUE, ignore_sparse=TRUE, sparsity_threshold=0.8,
365
+    remove_empty = NULL, chunk_size = 500, force_retrieve = TRUE){
363 366
     ChromInfo <- Brick_get_chrominfo(Brick = Brick)
364 367
     Chromosomes <- ChromInfo[,'chr']
365 368
     if(!is.null(chrs)){
... ...
@@ -370,18 +373,18 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
370 373
         sparse <- Brick_matrix_issparse(Brick = Brick, chr1 = chr, chr2 = chr)
371 374
         max.distance <- Brick_matrix_maxdist(Brick = Brick, chr1 = chr, 
372 375
             chr2 = chr)
373
-        if(ignore.sparse){
376
+        if(ignore_sparse){
374 377
             sparse=FALSE
375 378
         }
376
-        if(sparse & fill.gaps){
377
-            fill.gaps=FALSE
379
+        if(sparse & fill_gaps){
380
+            fill_gaps=FALSE
378 381
         }
379 382
         message("[1] Computing DI for ",chr,"\n")
380 383
         Ranges <- get_directionality_index_by_chunks(Brick = Brick, chr = chr, 
381
-            di.window = di.window, 
382
-            distance = max.distance, chunk.size = chunk.size, sparse=sparse, 
383
-            sparsity.threshold=sparsity.threshold,
384
-            min.sum = min.sum, force = force.retrieve)
384
+            di_window = di_window, 
385
+            distance = max.distance, chunk_size = chunk_size, sparse=sparse, 
386
+            sparsity_threshold=sparsity_threshold,
387
+            min_sum = min_sum, force = force_retrieve)
385 388
 
386 389
         RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
387 390
             chr2 = chr, what = "row.sums")
... ...
@@ -393,11 +396,11 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
393 396
             Backwards.DI.Difference <- Backwards.Difference(
394 397
                 Vector = Ranges$DI.Data, sparse = sparse,
395 398
                 sparsity.idx = SparsityIndex, 
396
-                sparsity.threshold = sparsity.threshold)
399
+                sparsity_threshold = sparsity_threshold)
397 400
             Forwards.DI.Difference <- Forwards.Difference(
398 401
                 Vector = Ranges$DI.Data, sparse = sparse,
399 402
                 sparsity.idx = SparsityIndex, 
400
-                sparsity.threshold = sparsity.threshold)
403
+                sparsity_threshold = sparsity_threshold)
401 404
         }else{
402 405
             Backwards.DI.Difference <- Backwards.Difference(
403 406
                 Vector=Ranges$DI.Data)
... ...
@@ -410,38 +413,38 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
410 413
         message("[3] Fetching Outliers ",chr,"\n")
411 414
         if(sparse){
412 415
             Domain.end.candidates <- ComputeOutlierOverIQRInsideWindow(
413
-                lookup.window=lookup.window,
416
+                lookup_window=lookup_window,
414 417
                 diff.values=Backwards.DI.Difference, 
415 418
                 values=Ranges$DI.Data, sparse=sparse, 
416 419
                 row.sums = Ranges$row.sums,
417
-                min.sum = min.sum, sparsity.idx=SparsityIndex, 
418
-                sparsity.threshold=sparsity.threshold, 
419
-                tukeys.constant=tukeys.constant, 
420
+                min_sum = min_sum, sparsity.idx=SparsityIndex, 
421
+                sparsity_threshold=sparsity_threshold, 
422
+                tukeys_constant=tukeys_constant, 
420 423
                 tail="lower.tail",strict=strict)
421 424
             Domain.start.candidates <- ComputeOutlierOverIQRInsideWindow(
422
-                lookup.window=lookup.window,
425
+                lookup_window=lookup_window,
423 426
                 diff.values=Forwards.DI.Difference, values=Ranges$DI.Data, 
424 427
                 sparse=sparse, row.sums = Ranges$row.sums,
425
-                min.sum = min.sum, sparsity.idx=SparsityIndex, 
426
-                sparsity.threshold=sparsity.threshold,
427
-                tukeys.constant=tukeys.constant, tail="upper.tail", 
428
+                min_sum = min_sum, sparsity.idx=SparsityIndex, 
429
+                sparsity_threshold=sparsity_threshold,
430
+                tukeys_constant=tukeys_constant, tail="upper.tail", 
428 431
                 strict=strict)
429 432
         }else{
430 433
             Domain.end.candidates <- ComputeOutlierOverIQRInsideWindow(
431
-                lookup.window=lookup.window,
434
+                lookup_window=lookup_window,
432 435
                 diff.values=Backwards.DI.Difference,
433 436
                 values=Ranges$DI.Data, 
434 437
                 row.sums = Ranges$row.sums,
435
-                min.sum = min.sum, 
436
-                tukeys.constant=tukeys.constant,
438
+                min_sum = min_sum, 
439
+                tukeys_constant=tukeys_constant,
437 440
                 tail="lower.tail",strict=strict)
438 441
             Domain.start.candidates <- ComputeOutlierOverIQRInsideWindow(
439
-                lookup.window=lookup.window,
442
+                lookup_window=lookup_window,
440 443
                 diff.values=Forwards.DI.Difference,
441 444
                 values=Ranges$DI.Data, 
442 445
                 row.sums = Ranges$row.sums,
443
-                min.sum = min.sum, 
444
-                tukeys.constant=tukeys.constant,
446
+                min_sum = min_sum, 
447
+                tukeys_constant=tukeys_constant,
445 448
                 tail="upper.tail",
446 449
                 strict=strict)
447 450
         }
... ...
@@ -459,15 +462,15 @@ Brick_local_score_differentiator <- function(Brick, chrs = NULL,
459 462
             Domain.end.candidates <- c(Domain.end.candidates,length(Ranges))
460 463
         }
461 464
         Domain.list <- CreateDomainlist(start.vector=Domain.start.candidates,
462
-            end.vector=Domain.end.candidates,fill.gaps=fill.gaps)
463
-        Domain.Ranges <- Brick_make_ranges(Chrom=rep(chr,nrow(Domain.list)),
464
-            Start=start(Ranges[Domain.list$startbin]),
465
-            End=end(Ranges[Domain.list$endbin]))
465
+            end.vector=Domain.end.candidates,fill_gaps=fill_gaps)
466
+        Domain.Ranges <- Brick_make_ranges(chrom=rep(chr,nrow(Domain.list)),
467
+            start=start(Ranges[Domain.list$startbin]),
468
+            end=end(Ranges[Domain.list$endbin]))
466 469
         message("[4] Done\n")
467 470
         Domain.Ranges$gap.fill <- Domain.list$gap.fill
468 471
         Domain.Ranges$level <- Domain.list$level
469
-        Domain.Ranges$window.size <- di.window
470
-        Domain.Ranges$lookup.window <- lookup.window
472
+        Domain.Ranges$window.size <- di_window
473
+        Domain.Ranges$lookup_window <- lookup_window
471 474
         return(Domain.Ranges)
472 475
     })
473 476
     Chrom.domains.ranges <- do.call(c,unlist(Chrom.domains.ranges.list, 
Browse code

- All required arguments are now without NULL values. - HDF file locking options have been removed.

Koustav Pal authored on 03/02/2019 10:03:30
Showing1 changed files
... ...
@@ -356,7 +356,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
356 356
 #' TAD_ranges <- Brick_local_score_differentiator(Brick = Brick.file, 
357 357
 #' chrs = "chr19", di.window = 10, lookup.window = 30, strict = TRUE, 
358 358
 #' fill.gaps = TRUE, chunk.size = 500)
359
-Brick_local_score_differentiator <- function(Brick = NULL, chrs = NULL, 
359
+Brick_local_score_differentiator <- function(Brick, chrs = NULL, 
360 360
     min.sum = -1, di.window = 200L, lookup.window = 200L, tukeys.constant=1.5, 
361 361
     strict = TRUE, fill.gaps=TRUE, ignore.sparse=TRUE, sparsity.threshold=0.8,
362 362
     remove.empty = NULL, chunk.size = 500, force.retrieve = TRUE){
Browse code

Better reporting of logs - Previously, Bioconductor repository guidelines required us to migrate all logs from cat to message. The function cat inserts a space after each independent argument of the message, this is not done by message - Spaces have now been introduced into all logs that are being reported through message.

Koustav Pal authored on 06/11/2018 09:14:55
Showing1 changed files
... ...
@@ -219,8 +219,8 @@ get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL,
219 219
         Matrix <- Brick_get_vector_values(Brick = Brick, chr1 = chr, 
220 220
             chr2 = chr, xaxis=c(Start:End), yaxis=c(Start:End), force = force)
221 221
         # cat((Start - 1),"\n")
222
-        message(Position.start,Position.end,"\n")
223
-        message(Position.start - (Start - 1),Position.end - (Start - 1),"\n")
222
+        # message(Position.start," ",Position.end,"\n")
223
+        # message(Position.start - (Start - 1),Position.end - (Start - 1),"\n")
224 224
         DI.data <- ComputeDirectionalityIndex(Matrix = Matrix, 
225 225
             Window.size = di.window, filter = Filter, 
226 226
             start = Position.start - (Start - 1), 
... ...
@@ -376,7 +376,7 @@ Brick_local_score_differentiator <- function(Brick = NULL, chrs = NULL,
376 376
         if(sparse & fill.gaps){
377 377
             fill.gaps=FALSE
378 378
         }
379
-        message("[1] Computing DI for",chr,"\n")
379
+        message("[1] Computing DI for ",chr,"\n")
380 380
         Ranges <- get_directionality_index_by_chunks(Brick = Brick, chr = chr, 
381 381
             di.window = di.window, 
382 382
             distance = max.distance, chunk.size = chunk.size, sparse=sparse, 
... ...
@@ -386,7 +386,7 @@ Brick_local_score_differentiator <- function(Brick = NULL, chrs = NULL,
386 386
         RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
387 387
             chr2 = chr, what = "row.sums")
388 388
         Ranges$row.sums <- RowSums
389
-        message("[2] Computing DI Differences for",chr,"\n")
389
+        message("[2] Computing DI Differences for ",chr,"\n")
390 390
         if(sparse){
391 391
             SparsityIndex <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
392 392
                 chr2 = chr, what = "sparsity")
... ...
@@ -450,7 +450,7 @@ Brick_local_score_differentiator <- function(Brick = NULL, chrs = NULL,
450 450
         Domain.end.candidates <- Domain.end.candidates[
451 451
         Domain.end.candidates != 1]
452 452
         message("[3] Done\n")
453
-        message("[4] Creating Domain list for",chr,"\n")
453
+        message("[4] Creating Domain list for ",chr,"\n")
454 454
 
455 455
         if(!(1 %in% Domain.start.candidates)){
456 456
             Domain.start.candidates <- c(1,Domain.start.candidates)
Browse code

- Changed the package name to HiCBricks - Fixed some minor message formatting

Koustav Pal authored on 20/10/2018 14:54:14
Showing1 changed files
... ...
@@ -1,10 +1,10 @@
1
-._get_first_nonzero_bin <- function(Block = NULL, chr = NULL){
2
-    RowSums <- Block_get_matrix_mcols(Block = Block, chr1 = chr, chr2 = chr, 
1
+._get_first_nonzero_bin <- function(Brick = NULL, chr = NULL){
2
+    RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, chr2 = chr, 
3 3
         what = "row.sums")
4 4
     return(min(which(RowSums > 0)))
5 5
 }
6
-._get_sparsity_index <- function(Block = NULL, chr = NULL){
7
-    Sparsity.index <- Block_get_matrix_mcols(Block = Block, chr1 = chr, 
6
+._get_sparsity_index <- function(Brick = NULL, chr = NULL){
7
+    Sparsity.index <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
8 8
         chr2 = chr, what = "sparsity")
9 9
     return(Sparsity.index)
10 10
 }
... ...
@@ -160,16 +160,16 @@ ComputeDirectionalityIndex <- function(Matrix = NULL, Window.size=NULL,
160 160
     DI.Data[Sequence %in% Bins.to.process] <- DI.list
161 161
     return(DI.Data)
162 162
 }
163
-get_directionality_index_by_chunks <- function(Block = NULL, chr = NULL, 
163
+get_directionality_index_by_chunks <- function(Brick = NULL, chr = NULL, 
164 164
     di.window = NULL, distance = NULL, chunk.size = 500, sparse = FALSE, 
165 165
     sparsity.threshold = 0.8, min.sum = -1, force = FALSE){
166
-    Ranges <- Block_get_bintable(Block = Block, chr = chr)
167
-    First.non.zero.bin <- ._get_first_nonzero_bin(Block = Block, chr = chr)
166
+    Ranges <- Brick_get_bintable(Brick = Brick, chr = chr)
167
+    First.non.zero.bin <- ._get_first_nonzero_bin(Brick = Brick, chr = chr)
168 168
     chr.length <- length(Ranges)
169
-    RowSums <- Block_get_matrix_mcols(Block = Block, chr1 = chr, chr2 = chr, 
169
+    RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, chr2 = chr, 
170 170
         what = "row.sums")
171 171
     if(sparse){
172
-        SparsityIndex <- Block_get_matrix_mcols(Block = Block, chr1 = chr, 
172
+        SparsityIndex <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
173 173
             chr2 = chr, what = "sparsity")
174 174
     }
175 175
     if((chunk.size - (di.window*2))/di.window < 10){
... ...
@@ -216,7 +216,7 @@ get_directionality_index_by_chunks <- function(Block = NULL, chr = NULL,
216 216
             True.length <- length(which(Filter))
217 217
             extend <- extend + 1
218 218
         }
219
-        Matrix <- Block_get_vector_values(Block = Block, chr1 = chr, 
219
+        Matrix <- Brick_get_vector_values(Brick = Brick, chr1 = chr, 
220 220
             chr2 = chr, xaxis=c(Start:End), yaxis=c(Start:End), force = force)
221 221
         # cat((Start - 1),"\n")
222 222
         message(Position.start,Position.end,"\n")
... ...
@@ -238,7 +238,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
238 238
     Starts <- start(Ranges)
239 239
     Starts <- Starts[seq_len(length(Starts))[-1]] - 1 
240 240
     Domain.boundaries <- unique(Starts,Ends)
241
-    Boundary.ranges <- Block_make_ranges(
241
+    Boundary.ranges <- Brick_make_ranges(
242 242
         Chrom=rep(chr,length(Domain.boundaries)),
243 243
         Start=(Domain.boundaries-(Binsize/2))+1,
244 244
         End=Domain.boundaries+(Binsize/2))
... ...
@@ -284,7 +284,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
284 284
 #' This function provides the capability to call very accurante TAD definitions
285 285
 #' in a very fast way. 
286 286
 #' 
287
-#' @inheritParams Block_get_chrominfo
287
+#' @inheritParams Brick_get_chrominfo
288 288
 #' 
289 289
 #' @param chrs \strong{Optional}. Default NULL
290 290
 #' If present, only TAD calls for elements in \emph{chrs} will be done.
... ...
@@ -342,7 +342,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
342 342
 #' 
343 343
 #' @param force.retrieve \strong{Optional}. Default TRUE
344 344
 #' If TRUE, this will force the retrieval of a matrix chunk even when the 
345
-#' retrieval includes interaction points which were not loaded into a Block 
345
+#' retrieval includes interaction points which were not loaded into a Brick 
346 346
 #' store (larger chunks). Please note, that this does not mean that DI can be 
347 347
 #' computed at distances larger than max distance. Rather, this is meant to aid
348 348
 #' faster computation.
... ...
@@ -352,23 +352,23 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
352 352
 #' the bintable. 
353 353
 #' 
354 354
 #' @examples
355
-#' Block.file <- system.file("extdata", "test.hdf", package = "HiCBlocks")
356
-#' TAD_ranges <- Block_local_score_differentiator(Block = Block.file, 
355
+#' Brick.file <- system.file("extdata", "test.hdf", package = "HiCBricks")
356
+#' TAD_ranges <- Brick_local_score_differentiator(Brick = Brick.file, 
357 357
 #' chrs = "chr19", di.window = 10, lookup.window = 30, strict = TRUE, 
358 358
 #' fill.gaps = TRUE, chunk.size = 500)
359
-Block_local_score_differentiator <- function(Block = NULL, chrs = NULL, 
359
+Brick_local_score_differentiator <- function(Brick = NULL, chrs = NULL, 
360 360
     min.sum = -1, di.window = 200L, lookup.window = 200L, tukeys.constant=1.5, 
361 361
     strict = TRUE, fill.gaps=TRUE, ignore.sparse=TRUE, sparsity.threshold=0.8,
362 362
     remove.empty = NULL, chunk.size = 500, force.retrieve = TRUE){
363
-    ChromInfo <- Block_get_chrominfo(Block = Block)
363
+    ChromInfo <- Brick_get_chrominfo(Brick = Brick)
364 364
     Chromosomes <- ChromInfo[,'chr']
365 365
     if(!is.null(chrs)){
366 366
         Chromosomes <- ChromInfo[ChromInfo[,'chr'] %in% chrs,'chr']
367 367
     }
368 368
     Chrom.domains.ranges.list <- lapply(Chromosomes, function(chr){
369
-        Ranges <- Block_get_bintable(Block = Block, chr = chr)
370
-        sparse <- Block_matrix_issparse(Block = Block, chr1 = chr, chr2 = chr)
371
-        max.distance <- Block_matrix_maxdist(Block = Block, chr1 = chr, 
369
+        Ranges <- Brick_get_bintable(Brick = Brick, chr = chr)
370
+        sparse <- Brick_matrix_issparse(Brick = Brick, chr1 = chr, chr2 = chr)
371
+        max.distance <- Brick_matrix_maxdist(Brick = Brick, chr1 = chr, 
372 372
             chr2 = chr)
373 373
         if(ignore.sparse){
374 374
             sparse=FALSE
... ...
@@ -377,18 +377,18 @@ Block_local_score_differentiator <- function(Block = NULL, chrs = NULL,
377 377
             fill.gaps=FALSE
378 378
         }
379 379
         message("[1] Computing DI for",chr,"\n")
380
-        Ranges <- get_directionality_index_by_chunks(Block = Block, chr = chr, 
380
+        Ranges <- get_directionality_index_by_chunks(Brick = Brick, chr = chr, 
381 381
             di.window = di.window, 
382 382
             distance = max.distance, chunk.size = chunk.size, sparse=sparse, 
383 383
             sparsity.threshold=sparsity.threshold,
384 384
             min.sum = min.sum, force = force.retrieve)
385 385
 
386
-        RowSums <- Block_get_matrix_mcols(Block = Block, chr1 = chr, 
386
+        RowSums <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
387 387
             chr2 = chr, what = "row.sums")
388 388
         Ranges$row.sums <- RowSums
389 389
         message("[2] Computing DI Differences for",chr,"\n")
390 390
         if(sparse){
391
-            SparsityIndex <- Block_get_matrix_mcols(Block = Block, chr1 = chr, 
391
+            SparsityIndex <- Brick_get_matrix_mcols(Brick = Brick, chr1 = chr, 
392 392
                 chr2 = chr, what = "sparsity")
393 393
             Backwards.DI.Difference <- Backwards.Difference(
394 394
                 Vector = Ranges$DI.Data, sparse = sparse,
... ...
@@ -460,7 +460,7 @@ Block_local_score_differentiator <- function(Block = NULL, chrs = NULL,
460 460
         }
461 461
         Domain.list <- CreateDomainlist(start.vector=Domain.start.candidates,
462 462
             end.vector=Domain.end.candidates,fill.gaps=fill.gaps)
463
-        Domain.Ranges <- Block_make_ranges(Chrom=rep(chr,nrow(Domain.list)),
463
+        Domain.Ranges <- Brick_make_ranges(Chrom=rep(chr,nrow(Domain.list)),
464 464
             Start=start(Ranges[Domain.list$startbin]),
465 465
             End=end(Ranges[Domain.list$endbin]))
466 466
         message("[4] Done\n")
Browse code

- All HiCLegos have been replaced with HiCBlocks. Vignette has been changed.

- Roxygen generated rd files contain changes in indentation.

- No code changes.

Koustav Pal authored on 19/10/2018 13:22:46
Showing1 changed files
... ...
@@ -4,8 +4,8 @@
4 4
     return(min(which(RowSums > 0)))
5 5
 }
6 6
 ._get_sparsity_index <- function(Block = NULL, chr = NULL){
7
-    Sparsity.index <- Block_get_matrix_mcols(Block = Block, chr1 = chr, chr2 = chr,
8
-        what = "sparsity")
7
+    Sparsity.index <- Block_get_matrix_mcols(Block = Block, chr1 = chr, 
8
+        chr2 = chr, what = "sparsity")
9 9
     return(Sparsity.index)
10 10
 }
11 11
 Backwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,
... ...
@@ -368,7 +368,8 @@ Block_local_score_differentiator <- function(Block = NULL, chrs = NULL,
368 368
     Chrom.domains.ranges.list <- lapply(Chromosomes, function(chr){
369 369
         Ranges <- Block_get_bintable(Block = Block, chr = chr)
370 370
         sparse <- Block_matrix_issparse(Block = Block, chr1 = chr, chr2 = chr)
371
-        max.distance <- Block_matrix_maxdist(Block = Block, chr1 = chr, chr2 = chr)
371
+        max.distance <- Block_matrix_maxdist(Block = Block, chr1 = chr, 
372
+            chr2 = chr)
372 373
         if(ignore.sparse){
373 374
             sparse=FALSE
374 375
         }
... ...
@@ -382,8 +383,8 @@ Block_local_score_differentiator <- function(Block = NULL, chrs = NULL,
382 383
             sparsity.threshold=sparsity.threshold,
383 384
             min.sum = min.sum, force = force.retrieve)
384 385
 
385
-        RowSums <- Block_get_matrix_mcols(Block = Block, chr1 = chr, chr2 = chr, 
386
-            what = "row.sums")
386
+        RowSums <- Block_get_matrix_mcols(Block = Block, chr1 = chr, 
387
+            chr2 = chr, what = "row.sums")
387 388
         Ranges$row.sums <- RowSums
388 389
         message("[2] Computing DI Differences for",chr,"\n")
389 390
         if(sparse){
Browse code

Package name has been changed. All function names starting with Lego have been renamed to Block. No changes have been made to the codebase

Koustav Pal authored on 19/10/2018 09:46:29
Showing1 changed files
... ...
@@ -1,10 +1,10 @@
1
-._get_first_nonzero_bin <- function(Lego = NULL, chr = NULL){
2
-    RowSums <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, 
1
+._get_first_nonzero_bin <- function(Block = NULL, chr = NULL){
2
+    RowSums <- Block_get_matrix_mcols(Block = Block, chr1 = chr, chr2 = chr, 
3 3
         what = "row.sums")
4 4
     return(min(which(RowSums > 0)))
5 5
 }
6
-._get_sparsity_index <- function(Lego = NULL, chr = NULL){
7
-    Sparsity.index <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr,
6
+._get_sparsity_index <- function(Block = NULL, chr = NULL){
7
+    Sparsity.index <- Block_get_matrix_mcols(Block = Block, chr1 = chr, chr2 = chr,
8 8
         what = "sparsity")
9 9
     return(Sparsity.index)
10 10
 }
... ...
@@ -160,16 +160,16 @@ ComputeDirectionalityIndex <- function(Matrix = NULL, Window.size=NULL,
160 160
     DI.Data[Sequence %in% Bins.to.process] <- DI.list
161 161
     return(DI.Data)
162 162
 }
163
-get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL, 
163
+get_directionality_index_by_chunks <- function(Block = NULL, chr = NULL, 
164 164
     di.window = NULL, distance = NULL, chunk.size = 500, sparse = FALSE, 
165 165
     sparsity.threshold = 0.8, min.sum = -1, force = FALSE){
166
-    Ranges <- Lego_get_bintable(Lego = Lego, chr = chr)
167
-    First.non.zero.bin <- ._get_first_nonzero_bin(Lego = Lego, chr = chr)
166
+    Ranges <- Block_get_bintable(Block = Block, chr = chr)
167
+    First.non.zero.bin <- ._get_first_nonzero_bin(Block = Block, chr = chr)
168 168
     chr.length <- length(Ranges)
169
-    RowSums <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, 
169
+    RowSums <- Block_get_matrix_mcols(Block = Block, chr1 = chr, chr2 = chr, 
170 170
         what = "row.sums")
171 171
     if(sparse){
172
-        SparsityIndex <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, 
172
+        SparsityIndex <- Block_get_matrix_mcols(Block = Block, chr1 = chr, 
173 173
             chr2 = chr, what = "sparsity")
174 174
     }
175 175
     if((chunk.size - (di.window*2))/di.window < 10){
... ...
@@ -216,7 +216,7 @@ get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL,
216 216
             True.length <- length(which(Filter))
217 217
             extend <- extend + 1
218 218
         }
219
-        Matrix <- Lego_get_vector_values(Lego = Lego, chr1 = chr, 
219
+        Matrix <- Block_get_vector_values(Block = Block, chr1 = chr, 
220 220
             chr2 = chr, xaxis=c(Start:End), yaxis=c(Start:End), force = force)
221 221
         # cat((Start - 1),"\n")
222 222
         message(Position.start,Position.end,"\n")
... ...
@@ -238,7 +238,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
238 238
     Starts <- start(Ranges)
239 239
     Starts <- Starts[seq_len(length(Starts))[-1]] - 1 
240 240
     Domain.boundaries <- unique(Starts,Ends)
241
-    Boundary.ranges <- Lego_make_ranges(
241
+    Boundary.ranges <- Block_make_ranges(
242 242
         Chrom=rep(chr,length(Domain.boundaries)),
243 243
         Start=(Domain.boundaries-(Binsize/2))+1,
244 244
         End=Domain.boundaries+(Binsize/2))
... ...
@@ -284,7 +284,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
284 284
 #' This function provides the capability to call very accurante TAD definitions
285 285
 #' in a very fast way. 
286 286
 #' 
287
-#' @inheritParams Lego_get_chrominfo
287
+#' @inheritParams Block_get_chrominfo
288 288
 #' 
289 289
 #' @param chrs \strong{Optional}. Default NULL
290 290
 #' If present, only TAD calls for elements in \emph{chrs} will be done.
... ...
@@ -342,7 +342,7 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
342 342
 #' 
343 343
 #' @param force.retrieve \strong{Optional}. Default TRUE
344 344
 #' If TRUE, this will force the retrieval of a matrix chunk even when the 
345
-#' retrieval includes interaction points which were not loaded into a Lego 
345
+#' retrieval includes interaction points which were not loaded into a Block 
346 346
 #' store (larger chunks). Please note, that this does not mean that DI can be 
347 347
 #' computed at distances larger than max distance. Rather, this is meant to aid
348 348
 #' faster computation.
... ...
@@ -352,23 +352,23 @@ MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
352 352
 #' the bintable. 
353 353
 #' 
354 354
 #' @examples
355
-#' Lego.file <- system.file("extdata", "test.hdf", package = "HiCLegos")
356
-#' TAD_ranges <- Lego_local_score_differentiator(Lego = Lego.file, 
355
+#' Block.file <- system.file("extdata", "test.hdf", package = "HiCBlocks")
356
+#' TAD_ranges <- Block_local_score_differentiator(Block = Block.file, 
357 357
 #' chrs = "chr19", di.window = 10, lookup.window = 30, strict = TRUE, 
358 358
 #' fill.gaps = TRUE, chunk.size = 500)
359
-Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL, 
359
+Block_local_score_differentiator <- function(Block = NULL, chrs = NULL, 
360 360
     min.sum = -1, di.window = 200L, lookup.window = 200L, tukeys.constant=1.5, 
361 361
     strict = TRUE, fill.gaps=TRUE, ignore.sparse=TRUE, sparsity.threshold=0.8,
362 362
     remove.empty = NULL, chunk.size = 500, force.retrieve = TRUE){
363
-    ChromInfo <- Lego_get_chrominfo(Lego = Lego)
363
+    ChromInfo <- Block_get_chrominfo(Block = Block)
364 364
     Chromosomes <- ChromInfo[,'chr']
365 365
     if(!is.null(chrs)){
366 366
         Chromosomes <- ChromInfo[ChromInfo[,'chr'] %in% chrs,'chr']
367 367
     }
368 368
     Chrom.domains.ranges.list <- lapply(Chromosomes, function(chr){
369
-        Ranges <- Lego_get_bintable(Lego = Lego, chr = chr)
370
-        sparse <- Lego_matrix_issparse(Lego = Lego, chr1 = chr, chr2 = chr)
371
-        max.distance <- Lego_matrix_maxdist(Lego = Lego, chr1 = chr, chr2 = chr)
369
+        Ranges <- Block_get_bintable(Block = Block, chr = chr)
370
+        sparse <- Block_matrix_issparse(Block = Block, chr1 = chr, chr2 = chr)
371
+        max.distance <- Block_matrix_maxdist(Block = Block, chr1 = chr, chr2 = chr)
372 372
         if(ignore.sparse){
373 373
             sparse=FALSE
374 374
         }
... ...
@@ -376,18 +376,18 @@ Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL,
376 376
             fill.gaps=FALSE
377 377
         }
378 378
         message("[1] Computing DI for",chr,"\n")
379
-        Ranges <- get_directionality_index_by_chunks(Lego = Lego, chr = chr, 
379
+        Ranges <- get_directionality_index_by_chunks(Block = Block, chr = chr, 
380 380
             di.window = di.window, 
381 381
             distance = max.distance, chunk.size = chunk.size, sparse=sparse, 
382 382
             sparsity.threshold=sparsity.threshold,
383 383
             min.sum = min.sum, force = force.retrieve)
384 384
 
385
-        RowSums <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, 
385
+        RowSums <- Block_get_matrix_mcols(Block = Block, chr1 = chr, chr2 = chr, 
386 386
             what = "row.sums")
387 387
         Ranges$row.sums <- RowSums
388 388
         message("[2] Computing DI Differences for",chr,"\n")
389 389
         if(sparse){
390
-            SparsityIndex <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, 
390
+            SparsityIndex <- Block_get_matrix_mcols(Block = Block, chr1 = chr, 
391 391
                 chr2 = chr, what = "sparsity")
392 392
             Backwards.DI.Difference <- Backwards.Difference(
393 393
                 Vector = Ranges$DI.Data, sparse = sparse,
... ...
@@ -459,7 +459,7 @@ Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL,
459 459
         }
460 460
         Domain.list <- CreateDomainlist(start.vector=Domain.start.candidates,
461 461
             end.vector=Domain.end.candidates,fill.gaps=fill.gaps)
462
-        Domain.Ranges <- Lego_make_ranges(Chrom=rep(chr,nrow(Domain.list)),
462
+        Domain.Ranges <- Block_make_ranges(Chrom=rep(chr,nrow(Domain.list)),
463 463
             Start=start(Ranges[Domain.list$startbin]),
464 464
             End=end(Ranges[Domain.list$endbin]))
465 465
         message("[4] Done\n")
Browse code

substituting cat() with message()

carmencita authored on 26/09/2018 11:27:32
Showing1 changed files
... ...
@@ -219,8 +219,8 @@ get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL,
219 219
         Matrix <- Lego_get_vector_values(Lego = Lego, chr1 = chr, 
220 220
             chr2 = chr, xaxis=c(Start:End), yaxis=c(Start:End), force = force)
221 221
         # cat((Start - 1),"\n")
222
-        cat(Position.start,Position.end,"\n")
223
-        cat(Position.start - (Start - 1),Position.end - (Start - 1),"\n")
222
+        message(Position.start,Position.end,"\n")
223
+        message(Position.start - (Start - 1),Position.end - (Start - 1),"\n")
224 224
         DI.data <- ComputeDirectionalityIndex(Matrix = Matrix, 
225 225
             Window.size = di.window, filter = Filter, 
226 226
             start = Position.start - (Start - 1), 
... ...
@@ -375,7 +375,7 @@ Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL,
375 375
         if(sparse & fill.gaps){
376 376
             fill.gaps=FALSE
377 377
         }
378
-        cat("[1] Computing DI for",chr,"\n")
378
+        message("[1] Computing DI for",chr,"\n")
379 379
         Ranges <- get_directionality_index_by_chunks(Lego = Lego, chr = chr, 
380 380
             di.window = di.window, 
381 381
             distance = max.distance, chunk.size = chunk.size, sparse=sparse, 
... ...
@@ -385,7 +385,7 @@ Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL,
385 385
         RowSums <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, 
386 386
             what = "row.sums")
387 387
         Ranges$row.sums <- RowSums
388
-        cat("[2] Computing DI Differences for",chr,"\n")
388
+        message("[2] Computing DI Differences for",chr,"\n")
389 389
         if(sparse){
390 390
             SparsityIndex <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, 
391 391
                 chr2 = chr, what = "sparsity")
... ...
@@ -405,8 +405,8 @@ Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL,
405 405
         }
406 406
         Ranges$backward.Differences <- Backwards.DI.Difference
407 407
         Ranges$forward.Differences <- Forwards.DI.Difference
408
-        cat("[2] Done\n")
409
-        cat("[3] Fetching Outliers ",chr,"\n")
408
+        message("[2] Done\n")
409
+        message("[3] Fetching Outliers ",chr,"\n")
410 410
         if(sparse){
411 411
             Domain.end.candidates <- ComputeOutlierOverIQRInsideWindow(
412 412
                 lookup.window=lookup.window,
... ...
@@ -448,8 +448,8 @@ Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL,
448 448
         Domain.start.candidates != length(Ranges)]
449 449
         Domain.end.candidates <- Domain.end.candidates[
450 450
         Domain.end.candidates != 1]
451
-        cat("[3] Done\n")
452
-        cat("[4] Creating Domain list for",chr,"\n")
451
+        message("[3] Done\n")
452
+        message("[4] Creating Domain list for",chr,"\n")
453 453
 
454 454
         if(!(1 %in% Domain.start.candidates)){
455 455
             Domain.start.candidates <- c(1,Domain.start.candidates)
... ...
@@ -462,7 +462,7 @@ Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL,
462 462
         Domain.Ranges <- Lego_make_ranges(Chrom=rep(chr,nrow(Domain.list)),
463 463
             Start=start(Ranges[Domain.list$startbin]),
464 464
             End=end(Ranges[Domain.list$endbin]))
465
-        cat("[4] Done\n")
465
+        message("[4] Done\n")
466 466
         Domain.Ranges$gap.fill <- Domain.list$gap.fill
467 467
         Domain.Ranges$level <- Domain.list$level
468 468
         Domain.Ranges$window.size <- di.window
... ...
@@ -472,4 +472,4 @@ Lego_local_score_differentiator <- function(Lego = NULL, chrs = NULL,
472 472
     Chrom.domains.ranges <- do.call(c,unlist(Chrom.domains.ranges.list, 
473 473
         use.names = TRUE))
474 474
     return(Chrom.domains.ranges)
475
-}
476 475
\ No newline at end of file
476
+}
Browse code

Prepare for final release

Koustav Pal authored on 29/08/2018 11:41:28
Showing1 changed files
... ...
@@ -1,18 +1,22 @@
1 1
 ._get_first_nonzero_bin <- function(Lego = NULL, chr = NULL){
2
-	RowSums <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, what = "row.sums")
2
+    RowSums <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, 
3
+        what = "row.sums")
3 4
     return(min(which(RowSums > 0)))
4 5
 }
5 6
 ._get_sparsity_index <- function(Lego = NULL, chr = NULL){
6
-    Sparsity.index <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, what = "sparsity")
7
-    return(Sparsity.Index)
7
+    Sparsity.index <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr,
8
+        what = "sparsity")
9
+    return(Sparsity.index)
8 10
 }
9
-Backwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,sparsity.threshold=NULL){
11
+Backwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,
12
+    sparsity.threshold=NULL){
10 13
         if(is.null(Vector)){
11 14
             stop("Vector variable cannot be empty.")
12 15
         }
13 16
         if(sparse){
14 17
             VectorDiff <- rep(NA,length(Vector))
15
-            temp.diff <- rev(diff(rev(Vector[sparsity.idx > sparsity.threshold])))
18
+            temp.diff <- rev(diff(
19
+                rev(Vector[sparsity.idx > sparsity.threshold])))
16 20
             temp.diff[length(temp.diff)+1] <- 0
17 21
             VectorDiff[sparsity.idx > sparsity.threshold] <- temp.diff
18 22
         }else{
... ...
@@ -21,7 +25,8 @@ Backwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,spar
21 25
         }
22 26
         return(VectorDiff)
23 27
 }
24
-Forwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,sparsity.threshold=NULL){
28
+Forwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,
29
+    sparsity.threshold=NULL){
25 30
         if(is.null(Vector)){
26 31
             stop("Vector variable cannot be empty.")
27 32
         }
... ...
@@ -36,8 +41,10 @@ Forwards.Difference <- function(Vector=NULL,sparse=FALSE,sparsity.idx=NULL,spars
36 41
         }
37 42
         return(VectorDiff)
38 43
 }
39
-ComputeOutlierOverIQRInsideWindow <- function(lookup.window=NULL,diff.values=NULL,values=NULL, row.sums = NULL,
40
-        min.sum = NULL, tukeys.constant=NULL,tail=NULL,sparse=FALSE,strict = FALSE,sparsity.idx=NULL,sparsity.threshold=NULL){
44
+ComputeOutlierOverIQRInsideWindow <- function(lookup.window=NULL,
45
+    diff.values=NULL,values=NULL, row.sums = NULL,
46
+        min.sum = NULL, tukeys.constant=NULL,tail=NULL,
47
+        sparse=FALSE,strict = FALSE,sparsity.idx=NULL,sparsity.threshold=NULL){
41 48
         seq.over.value <- seq_along(diff.values)
42 49
         Filter <- row.sums > min.sum
43 50
         if(sparse){
... ...
@@ -46,8 +53,10 @@ ComputeOutlierOverIQRInsideWindow <- function(lookup.window=NULL,diff.values=NUL
46 53
         seq.over.value <- seq.over.value[Filter]
47 54
         seq.over.seq <- seq_along(seq.over.value)
48 55
         outlier.list <- lapply(seq.over.seq,function(x.seq){
49
-            lookup.window.range <- ((x.seq - lookup.window) : (x.seq + lookup.window))
50
-            lookup.window.range <- seq.over.value[lookup.window.range[lookup.window.range>0 & lookup.window.range<=max(seq.over.seq)]]
56
+            lookup.window.range <- (
57
+                (x.seq - lookup.window) : (x.seq + lookup.window))
58
+            lookup.window.range <- seq.over.value[lookup.window.range[
59
+            lookup.window.range>0 & lookup.window.range<=max(seq.over.seq)]]
51 60
             offset <- (min(lookup.window.range)-1)
52 61
             diff.value.window <- diff.values[lookup.window.range]
53 62
             value.window <- values[lookup.window.range]
... ...
@@ -76,7 +85,7 @@ ComputeOutlierOverIQRInsideWindow <- function(lookup.window=NULL,diff.values=NUL
76 85
                 outliers <- lookup.window.range[outliers]
77 86
             }
78 87
             outliers
79
-         })
88
+        })
80 89
         outlier.vector.dups <- do.call(c,outlier.list)
81 90
         outlier.vector.uniq.sorted <- sort(unique(outlier.vector.dups))
82 91
         return(outlier.vector.uniq.sorted)
... ...
@@ -91,34 +100,42 @@ CreateDomainlist <- function(start.vector=NULL,end.vector=NULL,fill.gaps=NULL){
91 100
     Domains.by.end.df <- NULL
92 101
     Domains.by.assumption.df <- NULL
93 102
     if(fill.gaps){
94
-        uncurated.ends <- end.vector[!(end.vector %in% Domains.by.start.df[,"endbin"])]
103
+        uncurated.ends <- end.vector[
104
+        !(end.vector %in% Domains.by.start.df[,"endbin"])]
95 105
         if(length(uncurated.ends) > 0){
96 106
             Domains.by.end.list <- lapply(uncurated.ends,function(x){
97
-                data.frame(startbin=(max(Domains.by.start.df$endbin[Domains.by.start.df$endbin<x])+1),endbin=x)
107
+                data.frame(startbin=(
108
+                    max(Domains.by.start.df$endbin[
109
+                        Domains.by.start.df$endbin<x])+1),endbin=x)
98 110
             })
99 111
             Domains.by.end.df <- do.call(rbind,Domains.by.end.list)
100 112
             Domains.by.end.df$gap.fill <- as.numeric(TRUE)
101 113
             Domains.by.end.df$level <- 1
102 114
         }
103 115
     }
104
-    All.Domains <- rbind(Domains.by.start.df,Domains.by.end.df,Domains.by.assumption.df)
116
+    All.Domains <- rbind(Domains.by.start.df,
117
+        Domains.by.end.df,
118
+        Domains.by.assumption.df)
105 119
     All.Domains.sorted <- All.Domains[order(All.Domains$startbin),]
106 120
     return(All.Domains.sorted)
107 121
 }
108
-ComputeDirectionalityIndex <- function(Matrix = NULL, Window.size=NULL, filter = NULL, start = NULL, end = NULL){
109
-    Sequence <- 1:nrow(Matrix)
122
+ComputeDirectionalityIndex <- function(Matrix = NULL, Window.size=NULL, 
123
+    filter = NULL, start = NULL, end = NULL){
124
+    Sequence <- seq_len(nrow(Matrix))
110 125
     Sequence <- Sequence[start:end]
111 126
     DI.Data <- rep(NA,length(Sequence))
112 127
     Bins.to.process <- Sequence[filter[start:end]]
113
-    All.bins <- 1:nrow(Matrix)
128
+    All.bins <- seq_len(nrow(Matrix))
114 129
     All.bins <- All.bins[filter]
115 130
     DI.list <- vapply(Bins.to.process,function(i){
116 131
             Upstream<-0
117 132
             Downstream<-0
118 133
             My.DI.Data <- NA
119 134
             Relative.mid <- which(All.bins == i)
120
-            Window.range <- c((Relative.mid - Window.size) : (Relative.mid + Window.size))
121
-            Window.range <- All.bins[Window.range[Window.range >= 1 & Window.range <= length(All.bins)]]
135
+            Window.range <- c(
136
+                (Relative.mid - Window.size) : (Relative.mid + Window.size))
137
+            Window.range <- All.bins[
138
+            Window.range[Window.range >= 1 & Window.range <= length(All.bins)]]
122 139
             Upstream.range <- Window.range[Window.range < i]
123 140
             Downstream.range <- Window.range[Window.range > i]
124 141
             Row.vector <- Matrix[i,]
... ...
@@ -133,21 +150,27 @@ ComputeDirectionalityIndex <- function(Matrix = NULL, Window.size=NULL, filter =
133 150
             if( Expected == 0 | Upstream == Downstream ){
134 151
                 My.DI.Data <- 0
135 152
             }else{
136
-                # $DI = ( ($B - $A)/abs($B - $A) ) *( (($A - $E)**2)/$E + (($B - $E)**2)/$E);
137
-                My.DI.Data <- ((Downstream - Upstream)/abs(Downstream - Upstream)) * (((Upstream - Expected)^2)/Expected + ((Downstream - Expected)^2)/Expected)
153
+                My.DI.Data <- (
154
+                    (Downstream - Upstream)/abs(Downstream - Upstream)
155
+                    ) * (
156
+                    ((Upstream - Expected)^2)/Expected + (
157
+                        (Downstream - Expected)^2)/Expected)
138 158
             }
139 159
         },1)
140 160
     DI.Data[Sequence %in% Bins.to.process] <- DI.list
141 161
     return(DI.Data)
142 162
 }
143
-get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL, di.window = NULL, distance = NULL,
144
-    chunk.size = 500, sparse = FALSE, sparsity.threshold = 0.8, min.sum = -1, force = FALSE){
163
+get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL, 
164
+    di.window = NULL, distance = NULL, chunk.size = 500, sparse = FALSE, 
165
+    sparsity.threshold = 0.8, min.sum = -1, force = FALSE){
145 166
     Ranges <- Lego_get_bintable(Lego = Lego, chr = chr)
146 167
     First.non.zero.bin <- ._get_first_nonzero_bin(Lego = Lego, chr = chr)
147 168
     chr.length <- length(Ranges)
148
-    RowSums <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, what = "row.sums")
169
+    RowSums <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, 
170
+        what = "row.sums")
149 171
     if(sparse){
150
-        SparsityIndex <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, chr2 = chr, what = "sparsity")
172
+        SparsityIndex <- Lego_get_matrix_mcols(Lego = Lego, chr1 = chr, 
173
+            chr2 = chr, what = "sparsity")
151 174
     }
152 175
     if((chunk.size - (di.window*2))/di.window < 10){
153 176
         stop("chunk.size is too small for this di.window\n")
... ...
@@ -165,8 +188,10 @@ get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL, di.windo
165 188
         End <- Ends[x]
166 189
         Position.start <- Start
167 190
         Position.end <- End
168
-        Start <- ifelse((Start - di.window) < First.non.zero.bin, First.non.zero.bin, (Start - di.window))
169
-        End <- ifelse((End + di.window) > chr.length, chr.length, (End + di.window))
191
+        Start <- ifelse((Start - di.window) < First.non.zero.bin, 
192
+            First.non.zero.bin, (Start - di.window))
193
+        End <- ifelse((End + di.window) > chr.length, 
194
+            chr.length, (End + di.window))
170 195
         RowSums.subset <- RowSums[Start:End]
171 196
         Filter <- RowSums.subset > min.sum
172 197
         if(sparse){
... ...
@@ -176,12 +201,12 @@ get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL, di.windo
176 201
         Total.length <- length(Filter)
177 202
         Filter.extend.length <- length(which(!Filter))
178 203
         True.length <- length(which(Filter))
204
+        extend <- Filter.extend.length
179 205
         while(True.length < Total.length){
180
-            if(i == 1){
181
-                extend <- Filter.extend.length
182
-            }
183
-            Start <- ifelse((Start - extend) < First.non.zero.bin, First.non.zero.bin, Start - extend)
184
-            End <- ifelse((End + extend) > chr.length, chr.length, (End + extend))
206
+            Start <- ifelse((Start - extend) < First.non.zero.bin, 
207
+                First.non.zero.bin, Start - extend)
208
+            End <- ifelse((End + extend) > chr.length, 
209
+                chr.length, (End + extend))
185 210
             RowSums.subset <- RowSums[Start:End]
186 211
             Filter <- RowSums.subset > min.sum
187 212
             if(sparse){
... ...
@@ -191,12 +216,15 @@ get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL, di.windo
191 216
             True.length <- length(which(Filter))
192 217
             extend <- extend + 1
193 218
         }
194
-        Matrix <- Lego_get_vector_values(Lego = Lego, chr1 = chr, chr2 = chr, xaxis=c(Start:End), yaxis=c(Start:End), force = force)
219
+        Matrix <- Lego_get_vector_values(Lego = Lego, chr1 = chr, 
220
+            chr2 = chr, xaxis=c(Start:End), yaxis=c(Start:End), force = force)
195 221
         # cat((Start - 1),"\n")
196 222
         cat(Position.start,Position.end,"\n")
197 223
         cat(Position.start - (Start - 1),Position.end - (Start - 1),"\n")
198
-        DI.data <- ComputeDirectionalityIndex(Matrix = Matrix, Window.size = di.window, filter = Filter, 
199
-            start = Position.start - (Start - 1), end = Position.end - (Start - 1))
224
+        DI.data <- ComputeDirectionalityIndex(Matrix = Matrix, 
225
+            Window.size = di.window, filter = Filter, 
226
+            start = Position.start - (Start - 1), 
227
+            end = Position.end - (Start - 1))
200 228
         return(DI.data)
201 229
     })
202 230
     DI.data <- do.call(c, DI.data.list)
... ...
@@ -206,12 +234,14 @@ get_directionality_index_by_chunks <- function(Lego = NULL, chr = NULL, di.windo
206 234
 }
207 235
 MakeBoundaries <- function(chr = NULL, Ranges = NULL, Binsize = NULL){
208 236
     Ends <- end(Ranges) 
209
-    Ends <- Ends[1:(length(Ends)-1)]
237
+    Ends <- Ends[seq_len(length(Ends)-1)]
210 238
     Starts <- start(Ranges)
211
-    Starts <- Starts[2:length(Starts)] - 1 
239
+    Starts <- Starts[seq_len(length(Starts))[-1]] - 1 
212 240
     Domain.boundaries <- unique(Starts,Ends)