Browse code

- Added function to call compartments. - Fixed the colour bar so that the ticks are now properly represented. - Added a function to fetch entire matrices

Koustav Pal authored on 13/09/2019 12:31:26
Showing1 changed files
... ...
@@ -570,8 +570,8 @@ get_legend_breaks <- function(Object = NULL, mid.val = 0.5,
570 570
         # message(Colour.labs,"\n")
571 571
     }else{
572 572
         Colour.breaks <- seq(min(values),max(values),length.out = 5)
573
-        Colour.labs <- round(seq(min(original.values),
574
-            max(original.values),length.out = 5),2)
573
+        Colour.labs <- format(seq(min(original.values),
574
+            max(original.values),length.out = 5), scientific = TRUE)
575 575
         if(!is.null(value_cap)){
576 576
             Colour.labs[length(Colour.labs)] <- paste(">",
577 577
                 Colour.labs[length(Colour.labs)], sep = "")
Browse code

Bugfix for viz_art function TAD lines computation

Koustav Pal authored on 02/09/2019 09:50:19
Showing1 changed files
... ...
@@ -279,56 +279,55 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
279 279
     Object_split <- split(Object, paste(Object$groups, Object$dom.names, 
280 280
         Object$colours, sep = ":"))
281 281
     Group.list <- lapply(Object_split,function(current_domain){
282
-            current_domain <- unique(current_domain)
283
-            domain_name <- unique(current_domain[,"dom.names"])
284
-            Brick.x <- unique(current_domain[,"groups"])
285
-            colours <- current_domain$colours[
286
-            current_domain[,"type"] == "start"]
287
-            Start <- current_domain[
288
-            current_domain[,"type"] == "start", "position"]
289
-            End <- current_domain[
290
-            current_domain[,"type"] == "end", "position"]
282
+        current_domain <- unique(current_domain)
283
+        domain_name <- unique(current_domain[,"dom.names"])
284
+        Brick.x <- unique(current_domain[,"groups"])
285
+        colours <- current_domain$colours[
286
+        current_domain[,"type"] == "start"]
287
+        Start <- current_domain[
288
+        current_domain[,"type"] == "start", "position"]
289
+        End <- current_domain[
290
+        current_domain[,"type"] == "end", "position"]
291 291
 
292
-            Normalised.start.bin <- Start - region.start
293
-            Normalised.end.bin <- End - region.start
292
+        Normalised.start.bin <- Start - region.start
293
+        Normalised.end.bin <- End - region.start
294 294
 
295
-            if(cut_corners){
296
-                Max.dist <- (End - Start)/2
297
-                if(Max.dist > distance){
298
-                    Max.dist <- distance/2
299
-                }
300
-            }else{
295
+        if(cut_corners){
296
+            Max.dist <- (End - Start)/2
297
+            if(Max.dist > distance){
301 298
                 Max.dist <- distance/2
302 299
             }
303
-            Dist.up <- Max.dist
304
-            if((Normalised.end.bin - (Max.dist*2)) < 0){
305
-                Dist.up <- abs(0 - Normalised.end.bin)/2
306
-            }
307
-            x1.start <- Normalised.end.bin - Dist.up
308
-            y1.start <- ifelse(Brick.x == 1, Dist.up, Dist.up*-1)
309
-            x2.start <- Normalised.end.bin
310
-            y2.start <- 0
311
-            End.line <- data.frame(x=c(x1.start,x2.start),
312
-            y=c(y1.start,y2.start), colours = colours,
313
-            line.group = paste(Brick.x, domain_name, "end", sep = "."), 
314
-            group = paste("Group",Brick.x,sep = "."),
315
-            row.names = NULL)
300
+        }else{
301
+            Max.dist <- distance/2
302
+        }
303
+        Dist.up <- Max.dist
304
+        if((Normalised.end.bin - (Max.dist*2)) < 0){
305
+            Dist.up <- abs(0 - Normalised.end.bin)/2
306
+        }
307
+        x1.start <- Normalised.end.bin - Dist.up
308
+        y1.start <- ifelse(Brick.x == 1, Dist.up, Dist.up*-1)
309
+        x2.start <- Normalised.end.bin
310
+        y2.start <- 0
311
+        End.line <- data.frame(x=c(x1.start,x2.start),
312
+        y=c(y1.start,y2.start), colours = colours,
313
+        line.group = paste(Brick.x, domain_name, "end", sep = "."), 
314
+        group = paste("Group",Brick.x,sep = "."),
315
+        row.names = NULL)
316 316
 
317
-            Dist.down <- Max.dist
318
-            if((Normalised.start.bin + (Max.dist*2)) > Span){
319
-                Dist.down <- (Span - Normalised.start.bin)/ 2
320
-            }
321
-            x1.end <- Normalised.start.bin
322
-            y1.end <- 0
323
-            x2.end <- Normalised.start.bin + Dist.down
324
-            y2.end <- ifelse(Brick.x == 1, Dist.down, Dist.down*-1)
325
-            Start.line <- data.frame(x=c(x1.end,x2.end),
326
-                    y=c(y1.end,y2.end), colours=colours,
327
-                    line.group = paste(Brick.x, domain_name, 
328
-                        "start", sep = "."),
329
-                    group=paste("Group",Brick.x,sep = "."),row.names = NULL)
330
-            Lines <- rbind(End.line,Start.line)
331
-        Domain.df <- do.call(rbind,Domain.df.list)
317
+        Dist.down <- Max.dist
318
+        if((Normalised.start.bin + (Max.dist*2)) > Span){
319
+            Dist.down <- (Span - Normalised.start.bin)/ 2
320
+        }
321
+        x1.end <- Normalised.start.bin
322
+        y1.end <- 0
323
+        x2.end <- Normalised.start.bin + Dist.down
324
+        y2.end <- ifelse(Brick.x == 1, Dist.down, Dist.down*-1)
325
+        Start.line <- data.frame(x=c(x1.end,x2.end),
326
+                y=c(y1.end,y2.end), colours=colours,
327
+                line.group = paste(Brick.x, domain_name, 
328
+                    "start", sep = "."),
329
+                group=paste("Group",Brick.x,sep = "."),row.names = NULL)
330
+        Lines <- rbind(End.line,Start.line)
332 331
     })
333 332
     Group.df <- do.call(rbind,Group.list)
334 333
     return(Group.df)
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
... ...
@@ -197,80 +197,72 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
197 197
     if(is.null(distance)){
198 198
         distance <- region.end - region.start
199 199
     }
200
-    # message(region.start,region.end,"\n")
201
-
202 200
     Unique.groups <- unique(Object[,"groups"])
203
-    Group.list <- lapply(Unique.groups,function(Brick.x){
204
-        # message(Brick.x,"\n")
205
-        Domain <- Object[Object[,"groups"] == Brick.x,]
206
-        Domain.names <- unique(Domain[,"dom.names"])
207
-        Dolly.the.sheep.list <- lapply(Domain.names, function(domain.name){
208
-            current.domain <- Domain[Domain[,"dom.names"]==domain.name,]
209
-            colours <- current.domain$colours[
210
-            current.domain[,"type"] == "start"]
211
-            Start <- current.domain[
212
-            current.domain[,"type"] == "start", "position"]
213
-            End <- current.domain[
214
-            current.domain[,"type"] == "end", "position"]
215
-            # message(Start)
216
-            # message("Region start: ",region.start)
217
-            # message(End)
218
-            # message("Region end: ",region.end)
219
-            if(Start < region.start & End >= region.start){
220
-                # message("Here")
221
-                Start <- region.start
222
-                if((End - Start) > distance){
223
-                    Start <- Start + distance
224
-                }
225
-                Coord.list <- list(x1 = c(Start,End),
226
-                    y1 = c(End,End))
227
-                Groups <- rep(paste(domain.name,Brick.x,c(1,2),sep = "."), 
228
-                    each = 2)
229
-            }else if(Start >= region.start & End <= region.end){
230
-                # message("2nd Here")
231
-                Coord.list <- list(x1 = c(Start - 1,Start - 1,End), 
232
-                    y1 = c(Start - 1,End,End))
233
-                Groups <- rep(paste(domain.name,Brick.x,sep = "."), 
234
-                    each = 3)
235
-                My.end <- End
236
-                My.Start <- Start
237
-                if((End - Start) > distance){
238
-                    My.end <- Start + distance
239
-                    My.Start <- End - distance
240
-                }
241
-                Coord.list <- list(x1 = c(Start - 1,Start - 1,
242
-                    My.Start - 1,End), 
243
-                    y1 = c(Start - 1,My.end,End,End))
244
-                Groups <- rep(paste(domain.name,Brick.x,
245
-                    c(1,2),
246
-                    sep = "."), each = 2)
247
-            }else if(Start <= region.end & End > region.end){
248
-                # message("3rd Here")
249
-                End <- region.end
250
-                if((End - Start) > distance){
251
-                    End <- Start + distance
252
-                }
253
-                Coord.list <- list(x1 = c(Start - 1,Start - 1),
254
-                y1 = c(Start - 1,End))
255
-                Groups <- rep(paste(domain.name,Brick.x,sep = "."),2)
201
+    Object_split <- split(Object, paste(Object$groups, Object$dom.names, 
202
+        Object$colours, sep = ":"))
203
+    Group.list <- lapply(Object_split,function(current_domain){
204
+        current_domain <- unique(current_domain)
205
+        Brick.x <- unique(current_domain$groups)
206
+        colours <- current_domain$colours[
207
+        current_domain[,"type"] == "start"]
208
+        domain_name <- current_domain$dom.names[
209
+        current_domain[,"type"] == "start"]
210
+        Start <- current_domain[
211
+        current_domain[,"type"] == "start", "position"]
212
+        End <- current_domain[
213
+        current_domain[,"type"] == "end", "position"]
214
+        if(Start < region.start & End >= region.start){
215
+            # message("Here")
216
+            Start <- region.start
217
+            if((End - Start) > distance){
218
+                Start <- Start + distance
256 219
             }
257
-            if(Brick.x == 2){
258
-                Coord.list <- rev(Coord.list)
220
+            Coord.list <- list(x1 = c(Start,End),
221
+                y1 = c(End,End))
222
+            Groups <- rep(paste(domain_name,Brick.x,c(1,2),sep = "."), 
223
+                each = 2)
224
+        }else if(Start >= region.start & End <= region.end){
225
+            # message("2nd Here")
226
+            Coord.list <- list(x1 = c(Start - 1,Start - 1,End), 
227
+                y1 = c(Start - 1,End,End))
228
+            Groups <- rep(paste(domain_name,Brick.x,sep = "."), 
229
+                each = 3)
230
+            My.end <- End
231
+            My.Start <- Start
232
+            if((End - Start) > distance){
233
+                My.end <- Start + distance
234
+                My.Start <- End - distance
259 235
             }
260
-            Line <- data.frame(x = Coord.list[[1]], 
261
-                y = Coord.list[[2]], colours = colours,
262
-                line.group = Groups, group = paste("Group",Brick.x,sep = "."))
263
-            if(length(Unique.groups)==1){
264
-                Coord.list <- rev(Coord.list)
265
-                Line.2 <- data.frame(x = Coord.list[[1]],
266
-                y = Coord.list[[2]], colours = colours,
267
-                line.group = Groups, group = paste("Group",Brick.x+1,sep = "."))
268
-                Line <- rbind(Line,Line.2)
236
+            Coord.list <- list(x1 = c(Start - 1,Start - 1,
237
+                My.Start - 1,End), 
238
+                y1 = c(Start - 1,My.end,End,End))
239
+            Groups <- rep(paste(domain_name,Brick.x,
240
+                c(1,2),
241
+                sep = "."), each = 2)
242
+        }else if(Start <= region.end & End > region.end){
243
+            # message("3rd Here")
244
+            End <- region.end
245
+            if((End - Start) > distance){
246
+                End <- Start + distance
269 247
             }
270
-            Line
271
-        })
272
-        Dolly.the.sheep <- do.call(rbind,Dolly.the.sheep.list)
273
-        Dolly.the.sheep
248
+            Coord.list <- list(x1 = c(Start - 1,Start - 1),
249
+            y1 = c(Start - 1,End))
250
+            Groups <- rep(paste(domain_name,Brick.x,sep = "."),2)
251
+        }
252
+        if(Brick.x == 2){
253
+            Coord.list <- rev(Coord.list)
254
+        }
255
+        Line <- data.frame(x = Coord.list[[1]], 
256
+            y = Coord.list[[2]], colours = colours,
257
+            line.group = Groups, group = paste("Group",Brick.x,sep = "."))
258
+        if(length(Unique.groups)==1){
259
+            Coord.list <- rev(Coord.list)
260
+            Line.2 <- data.frame(x = Coord.list[[1]],
261
+            y = Coord.list[[2]], colours = colours,
262
+            line.group = Groups, group = paste("Group",Brick.x+1,sep = "."))
263
+            Line <- rbind(Line,Line.2)
264
+        }
265
+        Line
274 266
     })
275 267
     Group.df <- do.call(rbind,Group.list)
276 268
 }
... ...
@@ -284,17 +276,18 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
284 276
     Shift.seed <- 0.5
285 277
     Span <- region.end - region.start
286 278
     Unique.groups <- unique(Object[,"groups"])
287
-    Group.list <- lapply(Unique.groups,function(Brick.x){
288
-        Domain <- Object[Object[,"groups"] == Brick.x,]
289
-        Domain.names <- unique(Domain[,"dom.names"])
290
-        Domain.df.list <- lapply(Domain.names,function(x){
291
-            current.domain <- Domain[Domain[,"dom.names"]==x,]
292
-            colours <- current.domain$colours[
293
-            current.domain[,"type"] == "start"]
294
-            Start <- current.domain[
295
-            current.domain[,"type"] == "start", "position"]
296
-            End <- current.domain[
297
-            current.domain[,"type"] == "end", "position"]
279
+    Object_split <- split(Object, paste(Object$groups, Object$dom.names, 
280
+        Object$colours, sep = ":"))
281
+    Group.list <- lapply(Object_split,function(current_domain){
282
+            current_domain <- unique(current_domain)
283
+            domain_name <- unique(current_domain[,"dom.names"])
284
+            Brick.x <- unique(current_domain[,"groups"])
285
+            colours <- current_domain$colours[
286
+            current_domain[,"type"] == "start"]
287
+            Start <- current_domain[
288
+            current_domain[,"type"] == "start", "position"]
289
+            End <- current_domain[
290
+            current_domain[,"type"] == "end", "position"]
298 291
 
299 292
             Normalised.start.bin <- Start - region.start
300 293
             Normalised.end.bin <- End - region.start
... ...
@@ -317,7 +310,7 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
317 310
             y2.start <- 0
318 311
             End.line <- data.frame(x=c(x1.start,x2.start),
319 312
             y=c(y1.start,y2.start), colours = colours,
320
-            line.group = paste(Brick.x, x, "end", sep = "."), 
313
+            line.group = paste(Brick.x, domain_name, "end", sep = "."), 
321 314
             group = paste("Group",Brick.x,sep = "."),
322 315
             row.names = NULL)
323 316
 
... ...
@@ -331,10 +324,10 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
331 324
             y2.end <- ifelse(Brick.x == 1, Dist.down, Dist.down*-1)
332 325
             Start.line <- data.frame(x=c(x1.end,x2.end),
333 326
                     y=c(y1.end,y2.end), colours=colours,
334
-                    line.group = paste(Brick.x, x, "start", sep = "."),
327
+                    line.group = paste(Brick.x, domain_name, 
328
+                        "start", sep = "."),
335 329
                     group=paste("Group",Brick.x,sep = "."),row.names = NULL)
336 330
             Lines <- rbind(End.line,Start.line)
337
-        })
338 331
         Domain.df <- do.call(rbind,Domain.df.list)
339 332
     })
340 333
     Group.df <- do.call(rbind,Group.list)
Browse code

Bug fixes for BrickContainer functions

Koustav Pal authored on 13/08/2019 18:48:21
Showing1 changed files
... ...
@@ -24,12 +24,12 @@
24 24
     return(parsed.string.list)
25 25
 }
26 26
 
27
-Get_one_or_two_brick_regions <- function(Bricks = NULL, x_coords = NULL, 
28
-    y_coords = NULL, distance = NULL, 
29
-    value_cap = NULL, FUN = NULL){
27
+Get_one_or_two_brick_regions <- function(Bricks = NULL, resolution = NULL, 
28
+    x_coords = NULL, y_coords = NULL, distance = NULL, value_cap = NULL, 
29
+    FUN = NULL){
30 30
     Reference.object <- GenomicMatrix$new()
31 31
     if(length(Bricks) > 2){
32
-        stop("Polygonal layouts have not been implemented yet! 
32
+        stop("Higher order polygon layouts have not been implemented yet! 
33 33
             So for now we can only do two matrices at a time.\n")
34 34
     }
35 35
     if(!is.null(value_cap)){
... ...
@@ -41,13 +41,14 @@ Get_one_or_two_brick_regions <- function(Bricks = NULL, x_coords = NULL,
41 41
     # require(reshape2)
42 42
     Matrix.df.list <- list()
43 43
     for(i in seq_along(Bricks)){
44
-        Brick <- Bricks[i]
44
+        Brick <- Bricks[[i]]
45 45
         Matrix <- Brick_get_matrix_within_coords(Brick = Brick, 
46
-            x_coords = x_coords, y_coords = y_coords, force = TRUE, FUN = FUN)
47
-        Region.position.x <- Brick_return_region_position(Brick = Brick, 
48
-            region = x_coords)
49
-        Region.position.y <- Brick_return_region_position(Brick = Brick, 
50
-            region = y_coords)
46
+            x_coords = x_coords, y_coords = y_coords, 
47
+            resolution = resolution, force = TRUE, FUN = FUN)
48
+        Region.position.x <- Brick_return_region_position(Brick = Brick,
49
+            region = x_coords, resolution = resolution)
50
+        Region.position.y <- Brick_return_region_position(Brick = Brick,
51
+            region = y_coords, resolution = resolution)
51 52
         if(dim(Matrix)[1] != length(Region.position.x) | 
52 53
             dim(Matrix)[2] != length(Region.position.y)){
53 54
             stop("Matrix dimensions do not match the expected ",
... ...
@@ -86,8 +87,10 @@ Get_one_or_two_brick_regions <- function(Bricks = NULL, x_coords = NULL,
86 87
     return(Matrix.df)
87 88
 }
88 89
 
89
-Make_axis_labels = function(Brick = NULL, chr = NULL, positions = NULL){
90
-    Bintable <- Brick_get_bintable(Brick = Brick, chr = chr)
90
+Make_axis_labels = function(Brick = NULL, chr = NULL, resolution = NULL, 
91
+    positions = NULL){
92
+    Bintable <- Brick_get_bintable(Brick = Brick, chr = chr, 
93
+        resolution = resolution)
91 94
     breaks <- end(Bintable[positions])
92 95
     breaks[1] <- start(Bintable[positions[1]])
93 96
     coord.labs <- ._Figure_out_genomic_scale(breaks)
... ...
@@ -338,8 +341,8 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
338 341
     return(Group.df)
339 342
 }
340 343
 
341
-Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL, 
342
-    group_col = NULL, cut_corners = FALSE, colour.col = NULL, 
344
+Format_boundaries_normal_heatmap <- function(Bricks = NULL, resolution, 
345
+    Ranges = NULL, group_col = NULL, cut_corners = FALSE, colour.col = NULL, 
343 346
     colours = NULL, colours_names = NULL, region.chr = NULL, 
344 347
     region.start = NULL, region.end = NULL, distance = NULL, 
345 348
     rotate = FALSE){
... ...
@@ -392,7 +395,8 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
392 395
     start(chr.ranges) <= region.end]
393 396
     region <- paste(region.chr, region.start, region.end, 
394 397
         sep = Reference.object$Ranges.separator)
395
-    Region.positions <- Brick_return_region_position(Brick = Bricks[1], 
398
+    Region.positions <- Brick_return_region_position(Brick = Bricks[[1]], 
399
+        resolution = resolution, 
396 400
         region = region)
397 401
     Range.to.df.list <- lapply(seq_along(Bricks),function(Brick.x){
398 402
         pos.ranges <- chr.ranges[
... ...
@@ -400,8 +404,8 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
400 404
         chrs <- as.vector(seqnames(pos.ranges))
401 405
         start <- start(pos.ranges)
402 406
         end <- end(pos.ranges)
403
-        A.ranges <- Brick_fetch_range_index(Brick = Bricks[Brick.x], 
404
-            chr = chrs, start = start, end = end)
407
+        A.ranges <- Brick_fetch_range_index(Brick = Bricks[[Brick.x]], 
408
+            chr = chrs, start = start, end = end, resolution = resolution)
405 409
         Position.list <- A.ranges[seqnames(A.ranges) == region.chr]
406 410
         check_if_only_one_ranges <- function(x){
407 411
             all(!is.na(Position.list$Indexes[[x]]))
... ...
@@ -473,9 +477,9 @@ Get_heatmap_theme <- function(x_axis=TRUE, y_axis=TRUE,
473 477
                 axis.ticks.x = x_axis.ticks,
474 478
                 axis.ticks.y = y_axis.ticks,
475 479
                 legend.position="bottom",
476
-                legend_key_height = legend_key_height,
477
-                legend_key_width = legend_key_width,
478
-                legend_title=element_text(size=legend_title_text_size),
480
+                legend.key.height = legend_key_height,
481
+                legend.key.width = legend_key_width,
482
+                legend.title=element_text(size=legend_title_text_size),
479 483
                 legend.text=element_text(size=legend_text_size),
480 484
                 plot.title=element_text(size=title_size))
481 485
     return(Brick_theme)
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
... ...
@@ -24,17 +24,17 @@
24 24
     return(parsed.string.list)
25 25
 }
26 26
 
27
-Get_one_or_two_brick_regions <- function(Bricks = NULL, x.coords = NULL, 
28
-    y.coords = NULL, distance = NULL, 
29
-    value.cap = NULL, FUN = NULL){
27
+Get_one_or_two_brick_regions <- function(Bricks = NULL, x_coords = NULL, 
28
+    y_coords = NULL, distance = NULL, 
29
+    value_cap = NULL, FUN = NULL){
30 30
     Reference.object <- GenomicMatrix$new()
31 31
     if(length(Bricks) > 2){
32 32
         stop("Polygonal layouts have not been implemented yet! 
33 33
             So for now we can only do two matrices at a time.\n")
34 34
     }
35
-    if(!is.null(value.cap)){
36
-        if(value.cap > 1 | value.cap < 0){
37
-            stop("value.cap must be a value between 0,1 ",
35
+    if(!is.null(value_cap)){
36
+        if(value_cap > 1 | value_cap < 0){
37
+            stop("value_cap must be a value between 0,1 ",
38 38
                 "representing the quantiles.\n")
39 39
         }
40 40
     }
... ...
@@ -43,11 +43,11 @@ Get_one_or_two_brick_regions <- function(Bricks = NULL, x.coords = NULL,
43 43
     for(i in seq_along(Bricks)){
44 44
         Brick <- Bricks[i]
45 45
         Matrix <- Brick_get_matrix_within_coords(Brick = Brick, 
46
-            x.coords = x.coords, y.coords = y.coords, force = TRUE, FUN = FUN)
46
+            x_coords = x_coords, y_coords = y_coords, force = TRUE, FUN = FUN)
47 47
         Region.position.x <- Brick_return_region_position(Brick = Brick, 
48
-            region = x.coords)
48
+            region = x_coords)
49 49
         Region.position.y <- Brick_return_region_position(Brick = Brick, 
50
-            region = y.coords)
50
+            region = y_coords)
51 51
         if(dim(Matrix)[1] != length(Region.position.x) | 
52 52
             dim(Matrix)[2] != length(Region.position.y)){
53 53
             stop("Matrix dimensions do not match the expected ",
... ...
@@ -60,8 +60,8 @@ Get_one_or_two_brick_regions <- function(Bricks = NULL, x.coords = NULL,
60 60
         Matrix.df <- melt(Matrix)
61 61
         colnames(Matrix.df) <- c("row","col","val")
62 62
 
63
-        if(!is.null(value.cap)){
64
-            capped.val <- quantile(Matrix.df$val,value.cap)
63
+        if(!is.null(value_cap)){
64
+            capped.val <- quantile(Matrix.df$val,value_cap)
65 65
             Matrix.df$val[Matrix.df$val > capped.val] <- capped.val
66 66
         }
67 67
         Matrix.df$dist <- Matrix.df$col - Matrix.df$row
... ...
@@ -94,7 +94,7 @@ Make_axis_labels = function(Brick = NULL, chr = NULL, positions = NULL){
94 94
     return(coord.labs)
95 95
 }
96 96
 
97
-Make_colours <- function(palette = NULL, extrapolate.on = NULL, direction = 1){
97
+Make_colours <- function(palette = NULL, extrapolate_on = NULL, direction = 1){
98 98
     # require(RColorBrewer)
99 99
     # require(viridis)
100 100
     viridis.cols <- list("plasma" = plasma, "inferno" = inferno, 
... ...
@@ -124,12 +124,12 @@ Make_colours <- function(palette = NULL, extrapolate.on = NULL, direction = 1){
124 124
         viridis.fun <- viridis.cols[[palette]]
125 125
         Colours <- viridis.fun(n = viridis.col.breaks, direction = direction)
126 126
     }
127
-    if(!is.null(extrapolate.on)){
128
-        if(extrapolate.on > 100){
127
+    if(!is.null(extrapolate_on)){
128
+        if(extrapolate_on > 100){
129 129
             stop("I don't think you can actually differentiate ",
130 130
                 "between more than 100 shades.")
131 131
         }
132
-        Colours <- colorRampPalette(Colours)(extrapolate.on)
132
+        Colours <- colorRampPalette(Colours)(extrapolate_on)
133 133
     }
134 134
     return(Colours)
135 135
 }
... ...
@@ -190,7 +190,7 @@ RotateHeatmap = function(Matrix=NULL, value.var=NULL, upper = FALSE){
190 190
 }
191 191
 
192 192
 make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL, 
193
-    region.end = NULL, distance = NULL, cut.corners = FALSE){
193
+    region.end = NULL, distance = NULL, cut_corners = FALSE){
194 194
     if(is.null(distance)){
195 195
         distance <- region.end - region.start
196 196
     }
... ...
@@ -274,7 +274,7 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
274 274
 
275 275
 make_boundaries_for_rotated_heatmap <- function(Object = NULL, 
276 276
     region.start = NULL, region.end = NULL, distance = NULL, 
277
-    cut.corners = FALSE){
277
+    cut_corners = FALSE){
278 278
     if(is.null(distance)){
279 279
         distance <- region.end - region.start
280 280
     }
... ...
@@ -296,7 +296,7 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
296 296
             Normalised.start.bin <- Start - region.start
297 297
             Normalised.end.bin <- End - region.start
298 298
 
299
-            if(cut.corners){
299
+            if(cut_corners){
300 300
                 Max.dist <- (End - Start)/2
301 301
                 if(Max.dist > distance){
302 302
                     Max.dist <- distance/2
... ...
@@ -339,24 +339,24 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
339 339
 }
340 340
 
341 341
 Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL, 
342
-    group.col = NULL, cut.corners = FALSE, colour.col = NULL, 
343
-    colours = NULL, colours.names = NULL, region.chr = NULL, 
342
+    group_col = NULL, cut_corners = FALSE, colour.col = NULL, 
343
+    colours = NULL, colours_names = NULL, region.chr = NULL, 
344 344
     region.start = NULL, region.end = NULL, distance = NULL, 
345 345
     rotate = FALSE){
346 346
     Reference.object <- GenomicMatrix$new()
347
-    if(!is.null(group.col)){
348
-        Col.values <- unique(elementMetadata(Ranges)[[group.col]])
347
+    if(!is.null(group_col)){
348
+        Col.values <- unique(elementMetadata(Ranges)[[group_col]])
349 349
         if(length(Col.values) > 2 | !is.numeric(Col.values)){
350
-            stop("group.col values must be numeric ",
350
+            stop("group_col values must be numeric ",
351 351
                 "values corresponding to ",
352 352
                 "the number of Brick objects ",
353 353
                 "(max. 2) specified.\n")
354 354
         }
355 355
     }else{
356
-        group.col <- "pseudogroups"
356
+        group_col <- "pseudogroups"
357 357
         Ranges.too <- Ranges
358
-        elementMetadata(Ranges)[[group.col]] <- 1
359
-        elementMetadata(Ranges.too)[[group.col]] <- 2
358
+        elementMetadata(Ranges)[[group_col]] <- 1
359
+        elementMetadata(Ranges.too)[[group_col]] <- 2
360 360
         Ranges <- c(Ranges,Ranges.too)
361 361
     }
362 362
     
... ...
@@ -376,15 +376,15 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
376 376
             "Length of colour names: ",length(Unique.colour.cols),"\n",
377 377
             "Names: ",paste(Unique.colour.cols,collapse=","))
378 378
     }
379
-    if(is.null(colours.names)){
380
-        colours.names <- Unique.colour.cols
381
-        names(colours) <- colours.names
379
+    if(is.null(colours_names)){
380
+        colours_names <- Unique.colour.cols
381
+        names(colours) <- colours_names
382 382
     }else{
383
-        if(any(!(Unique.colour.cols %in% colours.names))){
384
-            stop("Provided colours.names had differing values ",
383
+        if(any(!(Unique.colour.cols %in% colours_names))){
384
+            stop("Provided colours_names had differing values ",
385 385
                 "from unique values present in colour.cols")
386 386
         }
387
-        names(colours) <- colours.names
387
+        names(colours) <- colours_names
388 388
     }
389 389
 
390 390
     chr.ranges <- Ranges[seqnames(Ranges) == region.chr]
... ...
@@ -396,7 +396,7 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
396 396
         region = region)
397 397
     Range.to.df.list <- lapply(seq_along(Bricks),function(Brick.x){
398 398
         pos.ranges <- chr.ranges[
399
-        elementMetadata(chr.ranges)[[group.col]] == Brick.x]
399
+        elementMetadata(chr.ranges)[[group_col]] == Brick.x]
400 400
         chrs <- as.vector(seqnames(pos.ranges))
401 401
         start <- start(pos.ranges)
402 402
         end <- end(pos.ranges)
... ...
@@ -431,7 +431,7 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
431 431
     Range.to.df <- do.call(rbind, Range.to.df.list)
432 432
     if(rotate){
433 433
         Normal.heatmap.lines <- make_boundaries_for_rotated_heatmap(
434
-            Object = Range.to.df, cut.corners = cut.corners,
434
+            Object = Range.to.df, cut_corners = cut_corners,
435 435
             region.start = min(Region.positions), 
436 436
             region.end = max(Region.positions), distance = distance)      
437 437
     }else{
... ...
@@ -442,65 +442,65 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
442 442
     return(Normal.heatmap.lines)
443 443
 }
444 444
 
445
-Get_heatmap_theme <- function(x.axis=TRUE, y.axis=TRUE, 
446
-    x.axis.text = NULL, y.axis.text = NULL, text.size = 10, 
447
-    x.axis.text.size = 10, y.axis.text.size = 10,
448
-    legend.title.text.size = 8, legend.text.size = 8, title.size = 10,
449
-    legend.key.width = unit(3,"cm"), legend.key.height = unit(0.5,"cm")){
450
-    if(!x.axis){
451
-        x.axis.ticks <- element_blank()
452
-        x.axis.text <- element_blank()
445
+Get_heatmap_theme <- function(x_axis=TRUE, y_axis=TRUE, 
446
+    x_axis.text = NULL, y_axis.text = NULL, text_size = 10, 
447
+    x_axis_text_size = 10, y_axis_text_size = 10,
448
+    legend_title_text_size = 8, legend_text_size = 8, title_size = 10,
449
+    legend_key_width = unit(3,"cm"), legend_key_height = unit(0.5,"cm")){
450
+    if(!x_axis){
451
+        x_axis.ticks <- element_blank()
452
+        x_axis.text <- element_blank()
453 453
     }else{
454
-        x.axis.ticks <-element_line(colour = "#000000")
455
-        x.axis.text <- element_text(colour = "#000000", size = x.axis.text.size)
454
+        x_axis.ticks <-element_line(colour = "#000000")
455
+        x_axis.text <- element_text(colour = "#000000", size = x_axis_text_size)
456 456
     }
457
-    if(!y.axis){
458
-        y.axis.ticks <- element_blank()
459
-        y.axis.text <- element_blank()
457
+    if(!y_axis){
458
+        y_axis.ticks <- element_blank()
459
+        y_axis.text <- element_blank()
460 460
     }else{
461
-        y.axis.ticks <-element_line(colour = "#000000")
462
-        y.axis.text <- element_text(colour = "#000000", size = y.axis.text.size)
461
+        y_axis.ticks <-element_line(colour = "#000000")
462
+        y_axis.text <- element_text(colour = "#000000", size = y_axis_text_size)
463 463
     }
464
-    Brick_theme <- theme_bw() + theme(text = element_text(size=text.size),
464
+    Brick_theme <- theme_bw() + theme(text = element_text(size=text_size),
465 465
                 plot.background=element_blank(),
466 466
                 panel.grid.minor=element_blank(),
467 467
                 panel.grid.major=element_blank(),
468 468
                 panel.background = element_blank(),
469
-                axis.title.x=x.axis.text,
470
-                axis.title.y=y.axis.text,
471
-                axis.text.x = x.axis.text,
472
-                axis.text.y = x.axis.text,
473
-                axis.ticks.x = x.axis.ticks,
474
-                axis.ticks.y = y.axis.ticks,
469
+                axis.title.x=x_axis.text,
470
+                axis.title.y=y_axis.text,
471
+                axis.text.x = x_axis.text,
472
+                axis.text.y = x_axis.text,
473
+                axis.ticks.x = x_axis.ticks,
474
+                axis.ticks.y = y_axis.ticks,
475 475
                 legend.position="bottom",
476
-                legend.key.height = legend.key.height,
477
-                legend.key.width = legend.key.width,
478
-                legend.title=element_text(size=legend.title.text.size),
479
-                legend.text=element_text(size=legend.text.size),
480
-                plot.title=element_text(size=title.size))
476
+                legend_key_height = legend_key_height,
477
+                legend_key_width = legend_key_width,
478
+                legend_title=element_text(size=legend_title_text_size),
479
+                legend.text=element_text(size=legend_text_size),
480
+                plot.title=element_text(size=title_size))
481 481
     return(Brick_theme)
482 482
 }
483 483
 
484
-Get_heatmap_titles <- function(title = NULL, x.axis.title = NULL, 
485
-    y.axis.title = NULL, legend.title = NULL, x.coords = NULL, 
486
-    y.coords = NULL, rotate = NULL){
487
-    if(is.null(legend.title)){
488
-        legend.title <- "Signal"
484
+Get_heatmap_titles <- function(title = NULL, x_axis_title = NULL, 
485
+    y_axis_title = NULL, legend_title = NULL, x_coords = NULL, 
486
+    y_coords = NULL, rotate = NULL){
487
+    if(is.null(legend_title)){
488
+        legend_title <- "Signal"
489 489
     }
490
-    if(is.null(x.axis.title)){
491
-        x.axis.title <- paste("Genomic position",x.coords,sep = " ")
490
+    if(is.null(x_axis_title)){
491
+        x_axis_title <- paste("Genomic position",x_coords,sep = " ")
492 492
     }
493
-    if(is.null(y.axis.title)){
494
-        y.axis.title <- paste("Genomic position",y.coords,sep = " ")
493
+    if(is.null(y_axis_title)){
494
+        y_axis_title <- paste("Genomic position",y_coords,sep = " ")
495 495
     }
496 496
     if(is.null(title)){
497
-        title <- paste(x.coords,y.coords,sep = "-")
497
+        title <- paste(x_coords,y_coords,sep = "-")
498 498
     }
499 499
     if(rotate){
500
-        y.axis.title <- "distance in bins"
500
+        y_axis_title <- "distance in bins"
501 501
     }
502
-    Labels <- c(x.axis.title, y.axis.title, title, legend.title)
503
-    names(Labels) <- c("x.axis","y.axis","title","legend")
502
+    Labels <- c(x_axis_title, y_axis_title, title, legend_title)
503
+    names(Labels) <- c("x_axis","y_axis","title","legend")
504 504
     return(Labels)
505 505
 }
506 506
 
... ...
@@ -545,7 +545,7 @@ make_colour_breaks <- function(Object = NULL, how.many = NULL,
545 545
 }
546 546
 
547 547
 get_legend_breaks <- function(Object = NULL, mid.val = 0.5, 
548
-    how.many = 5, value.cap = NULL, colours = NULL, two.sample = NULL){
548
+    how.many = 5, value_cap = NULL, colours = NULL, two.sample = NULL){
549 549
     Len <- length(values)
550 550
     values <- Object[,'rescale']
551 551
     distances <- Object[,'dist']
... ...
@@ -566,7 +566,7 @@ get_legend_breaks <- function(Object = NULL, mid.val = 0.5,
566 566
         Colour.breaks <- unique(
567 567
             c(Colour.breaks.1,Colour.breaks.2))
568 568
         Colours <- c(rev(colours),colours)
569
-        if(!is.null(value.cap)){
569
+        if(!is.null(value_cap)){
570 570
             Colour.labs[1] <- paste(">",Colour.labs[1],sep = "")
571 571
             Colour.labs[length(Colour.labs)] <- paste(">",
572 572
                 Colour.labs[length(Colour.labs)],sep = "")
... ...
@@ -576,7 +576,7 @@ get_legend_breaks <- function(Object = NULL, mid.val = 0.5,
576 576
         Colour.breaks <- seq(min(values),max(values),length.out = 5)
577 577
         Colour.labs <- round(seq(min(original.values),
578 578
             max(original.values),length.out = 5),2)
579
-        if(!is.null(value.cap)){
579
+        if(!is.null(value_cap)){
580 580
             Colour.labs[length(Colour.labs)] <- paste(">",
581 581
                 Colour.labs[length(Colour.labs)], sep = "")
582 582
         }
Browse code

- Major changes to the vignette. Added detailed steps to generate bipartite heatmaps - Fixed a bug in the TAD plotting wherein TADs which coincided with the end of the plotting region were not being considered properly while computing TAD positions.

Koustav Pal authored on 15/03/2019 18:13:44
Showing1 changed files
... ...
@@ -209,7 +209,12 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
209 209
             current.domain[,"type"] == "start", "position"]
210 210
             End <- current.domain[
211 211
             current.domain[,"type"] == "end", "position"]
212
+            # message(Start)
213
+            # message("Region start: ",region.start)
214
+            # message(End)
215
+            # message("Region end: ",region.end)
212 216
             if(Start < region.start & End >= region.start){
217
+                # message("Here")
213 218
                 Start <- region.start
214 219
                 if((End - Start) > distance){
215 220
                     Start <- Start + distance
... ...
@@ -219,6 +224,7 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
219 224
                 Groups <- rep(paste(domain.name,Brick.x,c(1,2),sep = "."), 
220 225
                     each = 2)
221 226
             }else if(Start >= region.start & End <= region.end){
227
+                # message("2nd Here")
222 228
                 Coord.list <- list(x1 = c(Start - 1,Start - 1,End), 
223 229
                     y1 = c(Start - 1,End,End))
224 230
                 Groups <- rep(paste(domain.name,Brick.x,sep = "."), 
... ...
@@ -235,7 +241,8 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
235 241
                 Groups <- rep(paste(domain.name,Brick.x,
236 242
                     c(1,2),
237 243
                     sep = "."), each = 2)
238
-            }else if(Start < region.end & End > region.end){
244
+            }else if(Start <= region.end & End > region.end){
245
+                # message("3rd Here")
239 246
                 End <- region.end
240 247
                 if((End - Start) > distance){
241 248
                     End <- Start + distance
... ...
@@ -364,7 +371,10 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
364 371
     if(length(Unique.colour.cols) != length(colours)){
365 372
         stop("colours length must be equal to ",
366 373
             "number of unique values present in ",
367
-            "colour.col")
374
+            colour.col,"\n",
375
+            "Length of colours: ",length(colours),"\n",
376
+            "Length of colour names: ",length(Unique.colour.cols),"\n",
377
+            "Names: ",paste(Unique.colour.cols,collapse=","))
368 378
     }
369 379
     if(is.null(colours.names)){
370 380
         colours.names <- Unique.colour.cols
Browse code

Fixed the plotting of two different TAD definitions on the two sample rotated heatmap

Koustav Pal authored on 07/02/2019 12:53:48
Showing1 changed files
... ...
@@ -302,12 +302,12 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
302 302
                 Dist.up <- abs(0 - Normalised.end.bin)/2
303 303
             }
304 304
             x1.start <- Normalised.end.bin - Dist.up
305
-            y1.start <- Dist.up
305
+            y1.start <- ifelse(Brick.x == 1, Dist.up, Dist.up*-1)
306 306
             x2.start <- Normalised.end.bin
307 307
             y2.start <- 0
308 308
             End.line <- data.frame(x=c(x1.start,x2.start),
309 309
             y=c(y1.start,y2.start), colours = colours,
310
-            line.group = paste(x, "end", sep = "."), 
310
+            line.group = paste(Brick.x, x, "end", sep = "."), 
311 311
             group = paste("Group",Brick.x,sep = "."),
312 312
             row.names = NULL)
313 313
 
... ...
@@ -318,10 +318,10 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
318 318
             x1.end <- Normalised.start.bin
319 319
             y1.end <- 0
320 320
             x2.end <- Normalised.start.bin + Dist.down
321
-            y2.end <- Dist.down
321
+            y2.end <- ifelse(Brick.x == 1, Dist.down, Dist.down*-1)
322 322
             Start.line <- data.frame(x=c(x1.end,x2.end),
323 323
                     y=c(y1.end,y2.end), colours=colours,
324
-                    line.group = paste(x, "start", sep = "."),
324
+                    line.group = paste(Brick.x, x, "start", sep = "."),
325 325
                     group=paste("Group",Brick.x,sep = "."),row.names = NULL)
326 326
             Lines <- rbind(End.line,Start.line)
327 327
         })
Browse code

Deconvoluted control statements related to checking length and values of colour variables

Koustav Pal authored on 05/02/2019 16:00:59
Showing1 changed files
... ...
@@ -353,23 +353,27 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
353 353
         Ranges <- c(Ranges,Ranges.too)
354 354
     }
355 355
     
356
-    Colour.check <- as.logical(as.numeric(is.null(colour.col)) * 
357
-        as.numeric(is.null(colours)))
358
-    Colour.check.2 <- length(colour.col)/length(colours)
359
-    if(Colour.check){
360
-        stop("colours expects a vector of length 1 with the colour value")
361
-    }else if(is.nan(Colour.check.2)){
362
-        stop("colours is missing\n")
363
-    }else if(!(Colour.check.2 %in% c(0,1))){
364
-        stop("colours and colour.col have different lengths\n")
365
-    }else {
356
+    if(is.null(colours)){
357
+        stop("colours expects a vector of colours of at least length 1")
358
+    }
359
+    if(is.null(colour.col)){
366 360
         colour.col <- "pseudo.colour.col"
367 361
         elementMetadata(Ranges)[[colour.col]] <- "My_Group"
368 362
     }
363
+    Unique.colour.cols <- unique(elementMetadata(Ranges)[[colour.col]])
364
+    if(length(Unique.colour.cols) != length(colours)){
365
+        stop("colours length must be equal to ",
366
+            "number of unique values present in ",
367
+            "colour.col")
368
+    }
369 369
     if(is.null(colours.names)){
370
-        colours.names <- unique(elementMetadata(Ranges)[[colour.col]])
370
+        colours.names <- Unique.colour.cols
371 371
         names(colours) <- colours.names
372 372
     }else{
373
+        if(any(!(Unique.colour.cols %in% colours.names))){
374
+            stop("Provided colours.names had differing values ",
375
+                "from unique values present in colour.cols")
376
+        }
373 377
         names(colours) <- colours.names
374 378
     }
375 379
 
Browse code

When computing the coordinates for TAD boundaries, a numeric check is done to check for the number of group values provided. Here a bug was present. The bug was a double not check, which qualified as true. This is now a single not check.

Also, the error message for this statement is now more understandable.

Koustav Pal authored on 05/02/2019 13:46:02
Showing1 changed files
... ...
@@ -339,9 +339,11 @@ Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL,
339 339
     Reference.object <- GenomicMatrix$new()
340 340
     if(!is.null(group.col)){
341 341
         Col.values <- unique(elementMetadata(Ranges)[[group.col]])
342
-        if(!(length(Col.values) > 2 | !is.numeric(Col.values))){
342
+        if(length(Col.values) > 2 | !is.numeric(Col.values)){
343 343
             stop("group.col values must be numeric ",
344
-                "values of for the two Brick objects.\n")
344
+                "values corresponding to ",
345
+                "the number of Brick objects ",
346
+                "(max. 2) specified.\n")
345 347
         }
346 348
     }else{
347 349
         group.col <- "pseudogroups"
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
... ...
@@ -194,11 +194,11 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
194 194
     if(is.null(distance)){
195 195
         distance <- region.end - region.start
196 196
     }
197
-    message(region.start,region.end,"\n")
197
+    # message(region.start,region.end,"\n")
198 198
 
199 199
     Unique.groups <- unique(Object[,"groups"])
200 200
     Group.list <- lapply(Unique.groups,function(Brick.x){
201
-        message(Brick.x,"\n")
201
+        # message(Brick.x,"\n")
202 202
         Domain <- Object[Object[,"groups"] == Brick.x,]
203 203
         Domain.names <- unique(Domain[,"dom.names"])
204 204
         Dolly.the.sheep.list <- lapply(Domain.names, function(domain.name){
... ...
@@ -555,7 +555,7 @@ get_legend_breaks <- function(Object = NULL, mid.val = 0.5,
555 555
             Colour.labs[length(Colour.labs)] <- paste(">",
556 556
                 Colour.labs[length(Colour.labs)],sep = "")
557 557
         }
558
-        message(Colour.labs,"\n")
558
+        # message(Colour.labs,"\n")
559 559
     }else{
560 560
         Colour.breaks <- seq(min(values),max(values),length.out = 5)
561 561
         Colour.labs <- round(seq(min(original.values),
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
... ...
@@ -24,11 +24,11 @@
24 24
     return(parsed.string.list)
25 25
 }
26 26
 
27
-Get_one_or_two_block_regions <- function(Blocks = NULL, x.coords = NULL, 
27
+Get_one_or_two_brick_regions <- function(Bricks = NULL, x.coords = NULL, 
28 28
     y.coords = NULL, distance = NULL, 
29 29
     value.cap = NULL, FUN = NULL){
30 30
     Reference.object <- GenomicMatrix$new()
31
-    if(length(Blocks) > 2){
31
+    if(length(Bricks) > 2){
32 32
         stop("Polygonal layouts have not been implemented yet! 
33 33
             So for now we can only do two matrices at a time.\n")
34 34
     }
... ...
@@ -40,13 +40,13 @@ Get_one_or_two_block_regions <- function(Blocks = NULL, x.coords = NULL,
40 40
     }
41 41
     # require(reshape2)
42 42
     Matrix.df.list <- list()
43
-    for(i in seq_along(Blocks)){
44
-        Block <- Blocks[i]
45
-        Matrix <- Block_get_matrix_within_coords(Block = Block, 
43
+    for(i in seq_along(Bricks)){
44
+        Brick <- Bricks[i]
45
+        Matrix <- Brick_get_matrix_within_coords(Brick = Brick, 
46 46
             x.coords = x.coords, y.coords = y.coords, force = TRUE, FUN = FUN)
47
-        Region.position.x <- Block_return_region_position(Block = Block, 
47
+        Region.position.x <- Brick_return_region_position(Brick = Brick, 
48 48
             region = x.coords)
49
-        Region.position.y <- Block_return_region_position(Block = Block, 
49
+        Region.position.y <- Brick_return_region_position(Brick = Brick, 
50 50
             region = y.coords)
51 51
         if(dim(Matrix)[1] != length(Region.position.x) | 
52 52
             dim(Matrix)[2] != length(Region.position.y)){
... ...
@@ -75,7 +75,7 @@ Get_one_or_two_block_regions <- function(Blocks = NULL, x.coords = NULL,
75 75
     }
76 76
 
77 77
     Matrix.df <- do.call(rbind,Matrix.df.list)
78
-    if(length(Blocks)==2){
78
+    if(length(Bricks)==2){
79 79
         Matrix.df <- Matrix.df[Matrix.df$keep,]
80 80
         Matrix.df$val[Matrix.df$dist == 0] <- 0
81 81
     }
... ...
@@ -86,8 +86,8 @@ Get_one_or_two_block_regions <- function(Blocks = NULL, x.coords = NULL,
86 86
     return(Matrix.df)
87 87
 }
88 88
 
89
-Make_axis_labels = function(Block = NULL, chr = NULL, positions = NULL){
90
-    Bintable <- Block_get_bintable(Block = Block, chr = chr)
89
+Make_axis_labels = function(Brick = NULL, chr = NULL, positions = NULL){
90
+    Bintable <- Brick_get_bintable(Brick = Brick, chr = chr)
91 91
     breaks <- end(Bintable[positions])
92 92
     breaks[1] <- start(Bintable[positions[1]])
93 93
     coord.labs <- ._Figure_out_genomic_scale(breaks)
... ...
@@ -197,9 +197,9 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
197 197
     message(region.start,region.end,"\n")
198 198
 
199 199
     Unique.groups <- unique(Object[,"groups"])
200
-    Group.list <- lapply(Unique.groups,function(Block.x){
201
-        message(Block.x,"\n")
202
-        Domain <- Object[Object[,"groups"] == Block.x,]
200
+    Group.list <- lapply(Unique.groups,function(Brick.x){
201
+        message(Brick.x,"\n")
202
+        Domain <- Object[Object[,"groups"] == Brick.x,]
203 203
         Domain.names <- unique(Domain[,"dom.names"])
204 204
         Dolly.the.sheep.list <- lapply(Domain.names, function(domain.name){
205 205
             current.domain <- Domain[Domain[,"dom.names"]==domain.name,]
... ...
@@ -216,12 +216,12 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
216 216
                 }
217 217
                 Coord.list <- list(x1 = c(Start,End),
218 218
                     y1 = c(End,End))
219
-                Groups <- rep(paste(domain.name,Block.x,c(1,2),sep = "."), 
219
+                Groups <- rep(paste(domain.name,Brick.x,c(1,2),sep = "."), 
220 220
                     each = 2)
221 221
             }else if(Start >= region.start & End <= region.end){
222 222
                 Coord.list <- list(x1 = c(Start - 1,Start - 1,End), 
223 223
                     y1 = c(Start - 1,End,End))
224
-                Groups <- rep(paste(domain.name,Block.x,sep = "."), 
224
+                Groups <- rep(paste(domain.name,Brick.x,sep = "."), 
225 225
                     each = 3)
226 226
                 My.end <- End
227 227
                 My.Start <- Start
... ...
@@ -232,7 +232,7 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
232 232
                 Coord.list <- list(x1 = c(Start - 1,Start - 1,
233 233
                     My.Start - 1,End), 
234 234
                     y1 = c(Start - 1,My.end,End,End))
235
-                Groups <- rep(paste(domain.name,Block.x,
235
+                Groups <- rep(paste(domain.name,Brick.x,
236 236
                     c(1,2),
237 237
                     sep = "."), each = 2)
238 238
             }else if(Start < region.end & End > region.end){
... ...
@@ -242,19 +242,19 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
242 242
                 }
243 243
                 Coord.list <- list(x1 = c(Start - 1,Start - 1),
244 244
                 y1 = c(Start - 1,End))
245
-                Groups <- rep(paste(domain.name,Block.x,sep = "."),2)
245
+                Groups <- rep(paste(domain.name,Brick.x,sep = "."),2)
246 246
             }
247
-            if(Block.x == 2){
247
+            if(Brick.x == 2){
248 248
                 Coord.list <- rev(Coord.list)
249 249
             }
250 250
             Line <- data.frame(x = Coord.list[[1]], 
251 251
                 y = Coord.list[[2]], colours = colours,
252
-                line.group = Groups, group = paste("Group",Block.x,sep = "."))
252
+                line.group = Groups, group = paste("Group",Brick.x,sep = "."))
253 253
             if(length(Unique.groups)==1){
254 254
                 Coord.list <- rev(Coord.list)
255 255
                 Line.2 <- data.frame(x = Coord.list[[1]],
256 256
                 y = Coord.list[[2]], colours = colours,
257
-                line.group = Groups, group = paste("Group",Block.x+1,sep = "."))
257
+                line.group = Groups, group = paste("Group",Brick.x+1,sep = "."))
258 258
                 Line <- rbind(Line,Line.2)
259 259
             }
260 260
             Line
... ...
@@ -274,8 +274,8 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
274 274
     Shift.seed <- 0.5
275 275
     Span <- region.end - region.start
276 276
     Unique.groups <- unique(Object[,"groups"])
277
-    Group.list <- lapply(Unique.groups,function(Block.x){
278
-        Domain <- Object[Object[,"groups"] == Block.x,]
277
+    Group.list <- lapply(Unique.groups,function(Brick.x){
278
+        Domain <- Object[Object[,"groups"] == Brick.x,]
279 279
         Domain.names <- unique(Domain[,"dom.names"])
280 280
         Domain.df.list <- lapply(Domain.names,function(x){
281 281
             current.domain <- Domain[Domain[,"dom.names"]==x,]
... ...
@@ -308,7 +308,7 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
308 308
             End.line <- data.frame(x=c(x1.start,x2.start),
309 309
             y=c(y1.start,y2.start), colours = colours,
310 310
             line.group = paste(x, "end", sep = "."), 
311
-            group = paste("Group",Block.x,sep = "."),
311
+            group = paste("Group",Brick.x,sep = "."),
312 312
             row.names = NULL)
313 313
 
314 314
             Dist.down <- Max.dist
... ...
@@ -322,7 +322,7 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
322 322
             Start.line <- data.frame(x=c(x1.end,x2.end),
323 323
                     y=c(y1.end,y2.end), colours=colours,
324 324
                     line.group = paste(x, "start", sep = "."),
325
-                    group=paste("Group",Block.x,sep = "."),row.names = NULL)
325
+                    group=paste("Group",Brick.x,sep = "."),row.names = NULL)
326 326
             Lines <- rbind(End.line,Start.line)
327 327
         })
328 328
         Domain.df <- do.call(rbind,Domain.df.list)
... ...
@@ -331,7 +331,7 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
331 331
     return(Group.df)
332 332
 }
333 333
 
334
-Format_boundaries_normal_heatmap <- function(Blocks = NULL, Ranges = NULL, 
334
+Format_boundaries_normal_heatmap <- function(Bricks = NULL, Ranges = NULL, 
335 335
     group.col = NULL, cut.corners = FALSE, colour.col = NULL, 
336 336
     colours = NULL, colours.names = NULL, region.chr = NULL, 
337 337
     region.start = NULL, region.end = NULL, distance = NULL, 
... ...
@@ -341,7 +341,7 @@ Format_boundaries_normal_heatmap <- function(Blocks = NULL, Ranges = NULL,
341 341
         Col.values <- unique(elementMetadata(Ranges)[[group.col]])
342 342
         if(!(length(Col.values) > 2 | !is.numeric(Col.values))){
343 343
             stop("group.col values must be numeric ",
344
-                "values of for the two Block objects.\n")
344
+                "values of for the two Brick objects.\n")
345 345
         }
346 346
     }else{
347 347
         group.col <- "pseudogroups"
... ...
@@ -376,15 +376,15 @@ Format_boundaries_normal_heatmap <- function(Blocks = NULL, Ranges = NULL,
376 376
     start(chr.ranges) <= region.end]
377 377
     region <- paste(region.chr, region.start, region.end, 
378 378
         sep = Reference.object$Ranges.separator)
379
-    Region.positions <- Block_return_region_position(Block = Blocks[1], 
379
+    Region.positions <- Brick_return_region_position(Brick = Bricks[1], 
380 380
         region = region)
381
-    Range.to.df.list <- lapply(seq_along(Blocks),function(Block.x){
381
+    Range.to.df.list <- lapply(seq_along(Bricks),function(Brick.x){
382 382
         pos.ranges <- chr.ranges[
383
-        elementMetadata(chr.ranges)[[group.col]] == Block.x]
383
+        elementMetadata(chr.ranges)[[group.col]] == Brick.x]
384 384
         chrs <- as.vector(seqnames(pos.ranges))
385 385
         start <- start(pos.ranges)
386 386
         end <- end(pos.ranges)
387
-        A.ranges <- Block_fetch_range_index(Block = Blocks[Block.x], 
387
+        A.ranges <- Brick_fetch_range_index(Brick = Bricks[Brick.x], 
388 388
             chr = chrs, start = start, end = end)
389 389
         Position.list <- A.ranges[seqnames(A.ranges) == region.chr]
390 390
         check_if_only_one_ranges <- function(x){
... ...
@@ -402,11 +402,11 @@ Format_boundaries_normal_heatmap <- function(Blocks = NULL, Ranges = NULL,
402 402
             function(x){names(Position.list[x])},"")
403 403
         Start.df <- data.frame(dom.names = Range.positions.names, 
404 404
             position = Range.positions.start, 
405
-            groups = Block.x, type = "start", 
405
+            groups = Brick.x, type = "start", 
406 406
             colours = elementMetadata(pos.ranges)[[colour.col]])
407 407
         End.df <- data.frame(dom.names = Range.positions.names, 
408 408
             position = Range.positions.end, 
409
-            groups = Block.x, type = "end", 
409
+            groups = Brick.x, type = "end", 
410 410
             colours = elementMetadata(pos.ranges)[[colour.col]])
411 411
         All.df <- rbind(Start.df,End.df)
412 412
         All.df$dom.names <- as.character(All.df$dom.names)
... ...
@@ -445,7 +445,7 @@ Get_heatmap_theme <- function(x.axis=TRUE, y.axis=TRUE,
445 445
         y.axis.ticks <-element_line(colour = "#000000")
446 446
         y.axis.text <- element_text(colour = "#000000", size = y.axis.text.size)
447 447
     }
448
-    Block_theme <- theme_bw() + theme(text = element_text(size=text.size),
448
+    Brick_theme <- theme_bw() + theme(text = element_text(size=text.size),
449 449
                 plot.background=element_blank(),
450 450
                 panel.grid.minor=element_blank(),
451 451
                 panel.grid.major=element_blank(),
... ...
@@ -462,7 +462,7 @@ Get_heatmap_theme <- function(x.axis=TRUE, y.axis=TRUE,
462 462
                 legend.title=element_text(size=legend.title.text.size),
463 463
                 legend.text=element_text(size=legend.text.size),
464 464
                 plot.title=element_text(size=title.size))
465
-    return(Block_theme)
465
+    return(Brick_theme)
466 466
 }
467 467
 
468 468
 Get_heatmap_titles <- function(title = NULL, x.axis.title = NULL, 
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
... ...
@@ -384,8 +384,8 @@ Format_boundaries_normal_heatmap <- function(Blocks = NULL, Ranges = NULL,
384 384
         chrs <- as.vector(seqnames(pos.ranges))
385 385
         start <- start(pos.ranges)
386 386
         end <- end(pos.ranges)
387
-        A.ranges <- Block_fetch_range_index(Block = Blocks[Block.x], chr = chrs, 
388
-            start = start, end = end)
387
+        A.ranges <- Block_fetch_range_index(Block = Blocks[Block.x], 
388
+            chr = chrs, start = start, end = end)
389 389
         Position.list <- A.ranges[seqnames(A.ranges) == region.chr]
390 390
         check_if_only_one_ranges <- function(x){
391 391
             all(!is.na(Position.list$Indexes[[x]]))
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
... ...
@@ -24,11 +24,11 @@
24 24
     return(parsed.string.list)
25 25
 }
26 26
 
27
-Get_one_or_two_lego_regions <- function(Legos = NULL, x.coords = NULL, 
27
+Get_one_or_two_block_regions <- function(Blocks = NULL, x.coords = NULL, 
28 28
     y.coords = NULL, distance = NULL, 
29 29
     value.cap = NULL, FUN = NULL){
30 30
     Reference.object <- GenomicMatrix$new()
31
-    if(length(Legos) > 2){
31
+    if(length(Blocks) > 2){
32 32
         stop("Polygonal layouts have not been implemented yet! 
33 33
             So for now we can only do two matrices at a time.\n")
34 34
     }
... ...
@@ -40,13 +40,13 @@ Get_one_or_two_lego_regions <- function(Legos = NULL, x.coords = NULL,
40 40
     }
41 41
     # require(reshape2)
42 42
     Matrix.df.list <- list()
43
-    for(i in seq_along(Legos)){
44
-        Lego <- Legos[i]
45
-        Matrix <- Lego_get_matrix_within_coords(Lego = Lego, 
43
+    for(i in seq_along(Blocks)){
44
+        Block <- Blocks[i]
45
+        Matrix <- Block_get_matrix_within_coords(Block = Block, 
46 46
             x.coords = x.coords, y.coords = y.coords, force = TRUE, FUN = FUN)
47
-        Region.position.x <- Lego_return_region_position(Lego = Lego, 
47
+        Region.position.x <- Block_return_region_position(Block = Block, 
48 48
             region = x.coords)
49
-        Region.position.y <- Lego_return_region_position(Lego = Lego, 
49
+        Region.position.y <- Block_return_region_position(Block = Block, 
50 50
             region = y.coords)
51 51
         if(dim(Matrix)[1] != length(Region.position.x) | 
52 52
             dim(Matrix)[2] != length(Region.position.y)){
... ...
@@ -75,7 +75,7 @@ Get_one_or_two_lego_regions <- function(Legos = NULL, x.coords = NULL,
75 75
     }
76 76
 
77 77
     Matrix.df <- do.call(rbind,Matrix.df.list)
78
-    if(length(Legos)==2){
78
+    if(length(Blocks)==2){
79 79
         Matrix.df <- Matrix.df[Matrix.df$keep,]
80 80
         Matrix.df$val[Matrix.df$dist == 0] <- 0
81 81
     }
... ...
@@ -86,8 +86,8 @@ Get_one_or_two_lego_regions <- function(Legos = NULL, x.coords = NULL,
86 86
     return(Matrix.df)
87 87
 }
88 88
 
89
-Make_axis_labels = function(Lego = NULL, chr = NULL, positions = NULL){
90
-    Bintable <- Lego_get_bintable(Lego = Lego, chr = chr)
89
+Make_axis_labels = function(Block = NULL, chr = NULL, positions = NULL){
90
+    Bintable <- Block_get_bintable(Block = Block, chr = chr)
91 91
     breaks <- end(Bintable[positions])
92 92
     breaks[1] <- start(Bintable[positions[1]])
93 93
     coord.labs <- ._Figure_out_genomic_scale(breaks)
... ...
@@ -197,9 +197,9 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
197 197
     message(region.start,region.end,"\n")
198 198
 
199 199
     Unique.groups <- unique(Object[,"groups"])
200
-    Group.list <- lapply(Unique.groups,function(Lego.x){
201
-        message(Lego.x,"\n")
202
-        Domain <- Object[Object[,"groups"] == Lego.x,]
200
+    Group.list <- lapply(Unique.groups,function(Block.x){
201
+        message(Block.x,"\n")
202
+        Domain <- Object[Object[,"groups"] == Block.x,]
203 203
         Domain.names <- unique(Domain[,"dom.names"])
204 204
         Dolly.the.sheep.list <- lapply(Domain.names, function(domain.name){
205 205
             current.domain <- Domain[Domain[,"dom.names"]==domain.name,]
... ...
@@ -216,12 +216,12 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
216 216
                 }
217 217
                 Coord.list <- list(x1 = c(Start,End),
218 218
                     y1 = c(End,End))
219
-                Groups <- rep(paste(domain.name,Lego.x,c(1,2),sep = "."), 
219
+                Groups <- rep(paste(domain.name,Block.x,c(1,2),sep = "."), 
220 220
                     each = 2)
221 221
             }else if(Start >= region.start & End <= region.end){
222 222
                 Coord.list <- list(x1 = c(Start - 1,Start - 1,End), 
223 223
                     y1 = c(Start - 1,End,End))
224
-                Groups <- rep(paste(domain.name,Lego.x,sep = "."), 
224
+                Groups <- rep(paste(domain.name,Block.x,sep = "."), 
225 225
                     each = 3)
226 226
                 My.end <- End
227 227
                 My.Start <- Start
... ...
@@ -232,7 +232,7 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
232 232
                 Coord.list <- list(x1 = c(Start - 1,Start - 1,
233 233
                     My.Start - 1,End), 
234 234
                     y1 = c(Start - 1,My.end,End,End))
235
-                Groups <- rep(paste(domain.name,Lego.x,
235
+                Groups <- rep(paste(domain.name,Block.x,
236 236
                     c(1,2),
237 237
                     sep = "."), each = 2)
238 238
             }else if(Start < region.end & End > region.end){
... ...
@@ -242,19 +242,19 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
242 242
                 }
243 243
                 Coord.list <- list(x1 = c(Start - 1,Start - 1),
244 244
                 y1 = c(Start - 1,End))
245
-                Groups <- rep(paste(domain.name,Lego.x,sep = "."),2)
245
+                Groups <- rep(paste(domain.name,Block.x,sep = "."),2)
246 246
             }
247
-            if(Lego.x == 2){
247
+            if(Block.x == 2){
248 248
                 Coord.list <- rev(Coord.list)
249 249
             }
250 250
             Line <- data.frame(x = Coord.list[[1]], 
251 251
                 y = Coord.list[[2]], colours = colours,
252
-                line.group = Groups, group = paste("Group",Lego.x,sep = "."))
252
+                line.group = Groups, group = paste("Group",Block.x,sep = "."))
253 253
             if(length(Unique.groups)==1){
254 254
                 Coord.list <- rev(Coord.list)
255 255
                 Line.2 <- data.frame(x = Coord.list[[1]],
256 256
                 y = Coord.list[[2]], colours = colours,
257
-                line.group = Groups, group = paste("Group",Lego.x+1,sep = "."))
257
+                line.group = Groups, group = paste("Group",Block.x+1,sep = "."))
258 258
                 Line <- rbind(Line,Line.2)
259 259
             }
260 260
             Line
... ...
@@ -274,8 +274,8 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
274 274
     Shift.seed <- 0.5
275 275
     Span <- region.end - region.start
276 276
     Unique.groups <- unique(Object[,"groups"])
277
-    Group.list <- lapply(Unique.groups,function(Lego.x){
278
-        Domain <- Object[Object[,"groups"] == Lego.x,]
277
+    Group.list <- lapply(Unique.groups,function(Block.x){
278
+        Domain <- Object[Object[,"groups"] == Block.x,]
279 279
         Domain.names <- unique(Domain[,"dom.names"])
280 280
         Domain.df.list <- lapply(Domain.names,function(x){
281 281
             current.domain <- Domain[Domain[,"dom.names"]==x,]
... ...
@@ -308,7 +308,7 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
308 308
             End.line <- data.frame(x=c(x1.start,x2.start),
309 309
             y=c(y1.start,y2.start), colours = colours,
310 310
             line.group = paste(x, "end", sep = "."), 
311
-            group = paste("Group",Lego.x,sep = "."),
311
+            group = paste("Group",Block.x,sep = "."),
312 312
             row.names = NULL)
313 313
 
314 314
             Dist.down <- Max.dist
... ...
@@ -322,7 +322,7 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
322 322
             Start.line <- data.frame(x=c(x1.end,x2.end),
323 323
                     y=c(y1.end,y2.end), colours=colours,
324 324
                     line.group = paste(x, "start", sep = "."),
325
-                    group=paste("Group",Lego.x,sep = "."),row.names = NULL)
325
+                    group=paste("Group",Block.x,sep = "."),row.names = NULL)
326 326
             Lines <- rbind(End.line,Start.line)
327 327
         })
328 328
         Domain.df <- do.call(rbind,Domain.df.list)
... ...
@@ -331,7 +331,7 @@ make_boundaries_for_rotated_heatmap <- function(Object = NULL,
331 331
     return(Group.df)
332 332
 }
333 333
 
334
-Format_boundaries_normal_heatmap <- function(Legos = NULL, Ranges = NULL, 
334
+Format_boundaries_normal_heatmap <- function(Blocks = NULL, Ranges = NULL, 
335 335
     group.col = NULL, cut.corners = FALSE, colour.col = NULL, 
336 336
     colours = NULL, colours.names = NULL, region.chr = NULL, 
337 337
     region.start = NULL, region.end = NULL, distance = NULL, 
... ...
@@ -341,7 +341,7 @@ Format_boundaries_normal_heatmap <- function(Legos = NULL, Ranges = NULL,
341 341
         Col.values <- unique(elementMetadata(Ranges)[[group.col]])
342 342
         if(!(length(Col.values) > 2 | !is.numeric(Col.values))){
343 343
             stop("group.col values must be numeric ",
344
-                "values of for the two Lego objects.\n")
344
+                "values of for the two Block objects.\n")
345 345
         }
346 346
     }else{
347 347
         group.col <- "pseudogroups"
... ...
@@ -376,15 +376,15 @@ Format_boundaries_normal_heatmap <- function(Legos = NULL, Ranges = NULL,
376 376
     start(chr.ranges) <= region.end]
377 377
     region <- paste(region.chr, region.start, region.end, 
378 378
         sep = Reference.object$Ranges.separator)
379
-    Region.positions <- Lego_return_region_position(Lego = Legos[1], 
379
+    Region.positions <- Block_return_region_position(Block = Blocks[1], 
380 380
         region = region)
381
-    Range.to.df.list <- lapply(seq_along(Legos),function(Lego.x){
381
+    Range.to.df.list <- lapply(seq_along(Blocks),function(Block.x){
382 382
         pos.ranges <- chr.ranges[
383
-        elementMetadata(chr.ranges)[[group.col]] == Lego.x]
383
+        elementMetadata(chr.ranges)[[group.col]] == Block.x]
384 384
         chrs <- as.vector(seqnames(pos.ranges))
385 385
         start <- start(pos.ranges)
386 386
         end <- end(pos.ranges)
387
-        A.ranges <- Lego_fetch_range_index(Lego = Legos[Lego.x], chr = chrs, 
387
+        A.ranges <- Block_fetch_range_index(Block = Blocks[Block.x], chr = chrs, 
388 388
             start = start, end = end)
389 389
         Position.list <- A.ranges[seqnames(A.ranges) == region.chr]
390 390
         check_if_only_one_ranges <- function(x){
... ...
@@ -402,11 +402,11 @@ Format_boundaries_normal_heatmap <- function(Legos = NULL, Ranges = NULL,
402 402
             function(x){names(Position.list[x])},"")
403 403
         Start.df <- data.frame(dom.names = Range.positions.names, 
404 404
             position = Range.positions.start, 
405
-            groups = Lego.x, type = "start", 
405
+            groups = Block.x, type = "start", 
406 406
             colours = elementMetadata(pos.ranges)[[colour.col]])
407 407
         End.df <- data.frame(dom.names = Range.positions.names, 
408 408
             position = Range.positions.end, 
409
-            groups = Lego.x, type = "end", 
409
+            groups = Block.x, type = "end", 
410 410
             colours = elementMetadata(pos.ranges)[[colour.col]])
411 411
         All.df <- rbind(Start.df,End.df)
412 412
         All.df$dom.names <- as.character(All.df$dom.names)
... ...
@@ -445,7 +445,7 @@ Get_heatmap_theme <- function(x.axis=TRUE, y.axis=TRUE,
445 445
         y.axis.ticks <-element_line(colour = "#000000")
446 446
         y.axis.text <- element_text(colour = "#000000", size = y.axis.text.size)
447 447
     }
448
-    Lego_theme <- theme_bw() + theme(text = element_text(size=text.size),
448
+    Block_theme <- theme_bw() + theme(text = element_text(size=text.size),
449 449
                 plot.background=element_blank(),
450 450
                 panel.grid.minor=element_blank(),
451 451
                 panel.grid.major=element_blank(),
... ...
@@ -462,7 +462,7 @@ Get_heatmap_theme <- function(x.axis=TRUE, y.axis=TRUE,
462 462
                 legend.title=element_text(size=legend.title.text.size),
463 463
                 legend.text=element_text(size=legend.text.size),
464 464
                 plot.title=element_text(size=title.size))
465
-    return(Lego_theme)
465
+    return(Block_theme)
466 466
 }
467 467
 
468 468
 Get_heatmap_titles <- function(title = NULL, x.axis.title = NULL, 
Browse code

substituting cat() with message()

carmencita authored on 26/09/2018 11:27:32
Showing1 changed files
... ...
@@ -194,11 +194,11 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
194 194
     if(is.null(distance)){
195 195
         distance <- region.end - region.start
196 196
     }
197
-    cat(region.start,region.end,"\n")
197
+    message(region.start,region.end,"\n")
198 198
 
199 199
     Unique.groups <- unique(Object[,"groups"])
200 200
     Group.list <- lapply(Unique.groups,function(Lego.x){
201
-        cat(Lego.x,"\n")
201
+        message(Lego.x,"\n")
202 202
         Domain <- Object[Object[,"groups"] == Lego.x,]
203 203
         Domain.names <- unique(Domain[,"dom.names"])
204 204
         Dolly.the.sheep.list <- lapply(Domain.names, function(domain.name){
... ...
@@ -555,7 +555,7 @@ get_legend_breaks <- function(Object = NULL, mid.val = 0.5,
555 555
             Colour.labs[length(Colour.labs)] <- paste(">",
556 556
                 Colour.labs[length(Colour.labs)],sep = "")
557 557
         }
558
-        cat(Colour.labs,"\n")
558
+        message(Colour.labs,"\n")
559 559
     }else{
560 560
         Colour.breaks <- seq(min(values),max(values),length.out = 5)
561 561
         Colour.labs <- round(seq(min(original.values),
Browse code

correcting BiocCheck

carmencita authored on 30/08/2018 17:14:30
Showing1 changed files
... ...
@@ -241,7 +241,7 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
241 241
                     End <- Start + distance
242 242
                 }
243 243
                 Coord.list <- list(x1 = c(Start - 1,Start - 1),
244
-                 y1 = c(Start - 1,End))
244
+                y1 = c(Start - 1,End))
245 245
                 Groups <- rep(paste(domain.name,Lego.x,sep = "."),2)
246 246
             }
247 247
             if(Lego.x == 2){
... ...
@@ -568,4 +568,4 @@ get_legend_breaks <- function(Object = NULL, mid.val = 0.5,
568 568
     }
569 569
     return(list("cols" = Colours, 
570 570
         "col.breaks" = Colour.breaks, "col.labs" = Colour.labs))
571
-}
572 571
\ No newline at end of file
572
+}
Browse code

Changed a few methods related to how tad borders were being plotted.

Koustav Pal authored on 30/08/2018 15:09:50
Showing1 changed files
... ...
@@ -219,8 +219,8 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
219 219
                 Groups <- rep(paste(domain.name,Lego.x,c(1,2),sep = "."), 
220 220
                     each = 2)
221 221
             }else if(Start >= region.start & End <= region.end){
222
-                Coord.list <- list(x1 = c(Start,Start,End), 
223
-                    y1 = c(Start,End,End))
222
+                Coord.list <- list(x1 = c(Start - 1,Start - 1,End), 
223
+                    y1 = c(Start - 1,End,End))
224 224
                 Groups <- rep(paste(domain.name,Lego.x,sep = "."), 
225 225
                     each = 3)
226 226
                 My.end <- End
... ...
@@ -229,8 +229,9 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
229 229
                     My.end <- Start + distance
230 230
                     My.Start <- End - distance
231 231
                 }
232
-                Coord.list <- list(x1 = c(Start,Start,My.Start,End), 
233
-                    y1 = c(Start,My.end,End,End))
232
+                Coord.list <- list(x1 = c(Start - 1,Start - 1,
233
+                    My.Start - 1,End), 
234
+                    y1 = c(Start - 1,My.end,End,End))
234 235
                 Groups <- rep(paste(domain.name,Lego.x,
235 236
                     c(1,2),
236 237
                     sep = "."), each = 2)
... ...
@@ -239,19 +240,20 @@ make_boundaries_for_heatmap <- function(Object = NULL, region.start = NULL,
239 240
                 if((End - Start) > distance){
240 241
                     End <- Start + distance
241 242
                 }
242
-                Coord.list <- list(x1 = c(Start,Start), y1 = c(Start,End))
243
+                Coord.list <- list(x1 = c(Start - 1,Start - 1),
244
+                 y1 = c(Start - 1,End))
243 245
                 Groups <- rep(paste(domain.name,Lego.x,sep = "."),2)
244 246
             }
245 247
             if(Lego.x == 2){
246 248
                 Coord.list <- rev(Coord.list)
247 249
             }
248
-            Line <- data.frame(x = Coord.list[[1]] - 0.5, 
249
-                y = Coord.list[[2]] + 0.5, colours = colours,
250
+            Line <- data.frame(x = Coord.list[[1]], 
251
+                y = Coord.list[[2]], colours = colours,
250 252
                 line.group = Groups, group = paste("Group",Lego.x,sep = "."))
251 253
             if(length(Unique.groups)==1){
252 254
                 Coord.list <- rev(Coord.list)
253
-                Line.2 <- data.frame(x = Coord.list[[1]] - 0.5,
254
-                y = Coord.list[[2]] + 0.5, colours = colours,