
R Under development (unstable) (2017-10-27 r73632) -- "Unsuffered Consequences"
Copyright (C) 2017 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

  Natural language support but running in an English locale

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ###################################################################################################
> # This tests the bin square summarization method in diffHic.
> 
> suppressWarnings(suppressPackageStartupMessages(require(diffHic)))
> source("simcounts.R")
> 
> chromos<-c(chrA=50, chrB=100, chrC=80)
> comp <- function(reference, widths, minbox=FALSE) {
+ 	cutted <- simcuts(chromos, min=20, max=200, overlap=4)
+ 	collected <- list()
+ 	for (w in widths) {
+ 		output <- list()
+ 		bindata <- diffHic:::.assignBins(pairParam(cutted), w)
+ 		n <- round(runif(1, 20, 100))
+ 		all.a <- as.integer(runif(n, 1, length(bindata$region)))
+ 		all.t <- as.integer(runif(n, 1, all.a))
+ 
+ 		oname <- paste0("w", w)
+ 		collected[[oname]] <- InteractionSet(list(counts=matrix(0L, nrow=n, ncol=1)), 
+             colData=DataFrame(totals=100), 
+             GInteractions(anchor1=all.a, anchor2=all.t, regions=bindata$region, mode="reverse"), 
+ 			metadata=List(param=pairParam(fragments=cutted)))
+ 	}	
+ 
+ 	output<- do.call(boxPairs, c(collected, reference=reference, minbox=minbox))
+ 	stopifnot(length(output$indices)==length(widths))
+ 	for (x in 1:length(output$indices)) { 
+ 		curdex <- output$indices[[x]]
+ 		curlist <- collected[[x]]
+ 
+ 		# Checking that each bin pair is truly nested within its reported parent.
+ 		parent.a <- anchors(output$interactions[curdex], type="first")
+ 		parent.t <- anchors(output$interactions[curdex], type="second")
+ 		current.a <- anchors(curlist, type="first")
+ 		current.t <- anchors(curlist, type="second")
+ 		
+ 		if (! all(seqnames(parent.a)==seqnames(current.a) & start(parent.a) <= start(current.a) & end(parent.a) >= end(current.a)) ) { stop("anchor ranges not nested in parent") }
+ 		if (! all(seqnames(parent.t)==seqnames(current.t) & start(parent.t) <= start(current.t) & end(parent.t) >= end(current.t)) ) { stop("target ranges not nested in parent") }
+ 	}
+ 	
+ 	if (minbox) { 
+ 		# Checking that the minimum bounding box was correctly assigned.
+ 		all.anchor1 <- all.anchor2 <- list()
+ 		for (x in 1:length(output$indices)) { 
+ 			all.anchor1[[x]] <- anchors(collected[[x]], type="first")
+ 			all.anchor2[[x]] <- anchors(collected[[x]], type="second")
+ 		}
+ 		gathered.a <- unlist(range(split(do.call(c, all.anchor1), unlist(output$indices))))
+ 		gathered.t <- unlist(range(split(do.call(c, all.anchor2), unlist(output$indices))))
+ 		names(gathered.a) <- names(gathered.t) <- NULL
+ 		if (!identical(gathered.a, anchors(output$interactions, type="first")) || 
+             !identical(gathered.t, anchors(output$interactions, type="second"))) { stop("mismatch in bounding boxes") }
+ 	}	
+ 
+     nocom <- do.call(boxPairs, c(collected, reference=reference, minbox=minbox, index.only=TRUE))
+     if (!identical(nocom, output$indices)) { stop("results aren't the same with index.only=TRUE") }
+ 	return(lapply(output$indices, FUN=head))
+ }
> 
> set.seed(74653812)
> comp(1000, c(100))
$w100
[1]  4 11 25 19 24  2

> comp(1000, c(100, 500))
$w100
[1]  1 10 16  2 21  2

$w500
[1] 46  2  8 45 13 36

> comp(1000, c(500))
$w500
[1] 20 32 40  7 57  2

> comp(1000, c(500, 1000))
$w500
[1] 84  2 59 26  2 99

$w1000
[1] 94 72 85  6 80 71

> comp(1000, c(100, 500, 1000))
$w100
[1] 15 33 13 70 37 93

$w500
[1] 126  79  19  95  15  23

$w1000
[1]  63 122  52  21  17  21

> 
> comp(150, c(10))
$w10
[1] 10 41 59 19 40 52

> comp(150, c(10, 50))
$w10
[1]  19  48   8  67 104  38

$w50
[1]  15 129  17 126  53  87

> comp(150, c(50))
$w50
[1] 50 33 37 29 45 34

> comp(150, c(50, 150))
$w50
[1]  74 122  32  45  96 114

$w150
[1] 106 103 116  31  46 129

> comp(150, c(10, 50, 150))
$w10
[1]  67  73   2  76  51 108

$w50
[1]  82  23 130  37  28  15

$w150
[1]  56  84 131  54  58 101

> 
> comp(500, c(50))
$w50
[1] 42 24 47  6 10 50

> comp(500, c(250))
$w250
[1] 43 40 21 61 69 23

> comp(500, c(50, 250))
$w50
[1] 52 13 34 46 77 40

$w250
[1] 50 59  2 39 10 80

> 
> comp(minbox=TRUE, 1000, c(100))
$w100
[1] 45 18  6 26 46 25

> comp(minbox=TRUE, 1000, c(100, 500))
$w100
[1] 61 83 73 27 64 53

$w500
[1] 42  1 23 75 32 63

> comp(minbox=TRUE, 1000, c(500))
$w500
[1] 17 17 31 49 54 34

> comp(minbox=TRUE, 1000, c(500, 1000))
$w500
[1] 18  7 82 47 85 26

$w1000
[1] 26 21 92 73 97 74

> comp(minbox=TRUE, 1000, c(100, 500, 1000))
$w100
[1]  45   8   7  73 119  41

$w500
[1]  76  20 109 124   5   5

$w1000
[1]  19  78   2  67   5 104

> 
> comp(minbox=TRUE, 150, c(10))
$w10
[1] 34 31 22  2  6 13

> comp(minbox=TRUE, 150, c(10, 50))
$w10
[1] 45 60 85 32 37 21

$w50
[1] 67 46 34 54 90 17

> comp(minbox=TRUE, 150, c(50))
$w50
[1] 73 38  4 58 67 33

> comp(minbox=TRUE, 150, c(50, 150))
$w50
[1]  92 105  44 115 133  82

$w150
[1]  70 100  15 114  89  18

> comp(minbox=TRUE, 150, c(10, 50, 150))
$w10
[1] 137  52 110  32  95 136

$w50
[1]  81 118  90  42  63   6

$w150
[1] 66 86 98 62 57 17

> 
> comp(minbox=TRUE, 500, c(50))
$w50
[1]  1 20 79 58 68 51

> comp(minbox=TRUE, 500, c(250))
$w250
[1] 25 28 19 19 27 23

> comp(minbox=TRUE, 500, c(50, 250))
$w50
[1] 29 23 58 12  7 57

$w250
[1] 24 15 55 21 39 53

> 
> ####################################################################################################
> # End.
> 
> proc.time()
   user  system elapsed 
 18.288   0.148  18.441 
