
R version 3.4.0 Patched (2017-04-24 r72627) -- "You Stupid Darkness"
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 neighbor-counting code.
> 
> suppressWarnings(suppressPackageStartupMessages(require(diffHic)))
> 
> # Defining some odds and ends.
> 
> lower.left <- function(x, exclude=0) { 
+ 	out <- matrix(TRUE, nrow=nrow(x), ncol=ncol(x))
+ 	out[nrow(x)+(-exclude):0,1:(1+exclude)] <- FALSE
+ 	out
+ }
> 
> all.but.middle <- function(x, exclude=0) {
+ 	out <- matrix(TRUE, nrow=nrow(x), ncol=ncol(x))
+ 	midrow <- ceiling(nrow(x)/2) + (-exclude):exclude
+ 	midrow <- midrow[midrow > 0 & midrow <= nrow(x)]
+ 	midcol <- ceiling(ncol(x)/2) + (-exclude):exclude
+ 	midcol <- midcol[midcol > 0 & midcol <= ncol(x)]
+ 	out[midrow, midcol] <- FALSE
+ 	out
+ }
> 
> comp <- function(npairs, chromos, flanking, exclude=0) {
+ 	flanking <- as.integer(flanking)
+ 	exclude <- as.integer(exclude)
+ 
+ 	nlibs <- 4L
+ 	lambda <- 5
+ 	nbins <- sum(chromos)
+ 	all.pairs <- rbind(t(combn(nbins, 2)), cbind(1:nbins, 1:nbins))
+ 	aid <- pmax(all.pairs[,1], all.pairs[,2])
+ 	tid <- pmin(all.pairs[,1], all.pairs[,2])
+    	npairs <- min(npairs, nrow(all.pairs))
+ 
+ 	# Setting up some data.
+ 	counts <- do.call(cbind, lapply(seq_len(nlibs), FUN=function(x) { as.integer(rpois(npairs, lambda) + 1) }) )
+ 	chosen <- sample(nrow(all.pairs), npairs)
+ 	indices <- unlist(sapply(chromos, FUN=function(x) { seq_len(x) }), use.names=FALSE)
+ 	data <- InteractionSet(list(counts=counts), 
+         GInteractions(anchor1=aid[chosen], anchor2=tid[chosen],
+             regions=GRanges(rep(names(chromos), chromos), IRanges(indices, indices)), mode="reverse"),
+         colData=DataFrame(totals=rep(1e6, nlibs)))
+ 	regions(data)$nfrags <- rep(1:3, length.out=nbins)
+ 	
+ 	# Computing the reference enrichment value.
+ 	bg <- enrichedPairs(data, flank=flanking, exclude=exclude)
+ 	final.ref <- numeric(length(bg))
+ 
+ 	# Sorting them by chromosome pairs.
+ 	all.chrs <- as.character(seqnames(regions(data)))
+ 	chr.pair <- paste0(all.chrs[anchors(data, type="first", id=TRUE)], ".", all.chrs[anchors(data, type="second", id=TRUE)])
+ 	by.chr.pair <- split(seq_len(npairs), chr.pair)
+ 	first.id <- lapply(split(seq_len(nbins), all.chrs), FUN=min)
+ 
+ 	for (cpair in names(by.chr.pair)) { 
+ 		cur.pairs <- by.chr.pair[[cpair]]
+ 		two.chrs <- strsplit(cpair, "\\.")[[1]]
+ 		current <- data[cur.pairs,]
+         counts <- assay(current)
+ 
+ 		# Setting up the interaction space.
+ 		a.dex <- anchors(current, type="first", id=TRUE) - first.id[[two.chrs[1]]] + 1L
+ 		t.dex <- anchors(current, type="second", id=TRUE) - first.id[[two.chrs[2]]] + 1L
+ 		alen <- chromos[[two.chrs[1]]]
+ 		tlen <- chromos[[two.chrs[2]]]
+ 		inter.space <- matrix(0L, nrow=alen, ncol=tlen)
+ 		inter.space[(t.dex-1)*alen + a.dex] <- 1:nrow(current) # column major.
+ 		valid <- matrix(TRUE, nrow=alen, ncol=tlen)
+ 		
+ 		# Checking if we're working on the same chromosome.
+ 		if (two.chrs[1]==two.chrs[2]) { 
+ 			valid[upper.tri(valid)] <- FALSE 
+ 			starting.dex <- 1L
+ 		} else {
+ 			starting.dex <- 2L
+ 		}
+     	total.num <- 4L
+         output <- lapply(seq_len(total.num), FUN=function(x) matrix(0L, nrow(current), nlibs))
+         output.n <- lapply(seq_len(total.num), FUN=function(x) integer(nrow(current)))
+ 
+ 		for (pair in seq_len(nrow(current))) {
+ 			ax <- a.dex[pair]
+ 			tx <- t.dex[pair]
+ 
+ 			for (quad in starting.dex:total.num) {
+ 				if (quad==1L) {
+ 					cur.a <- ax - flanking:0
+ 					cur.t <- tx + 0:flanking
+ 					keep <- lower.left 
+ 				} else if (quad==2L) {
+ 					cur.a <- ax + (-flanking):flanking
+ 					cur.t <- tx
+ 					keep <- all.but.middle
+ 				} else if (quad==3L) {
+ 					cur.a <- ax
+ 					cur.t <- tx + (-flanking):flanking
+ 					keep <- all.but.middle
+ 				} else if (quad==4L) {
+ 					cur.a <- ax + (-flanking):flanking
+ 					cur.t <- tx + (-flanking):flanking
+ 					keep <- all.but.middle
+ 				}
+ 	
+ 				# Selecting the relevant entries for the chosen quadrant.
+ 				indices <- outer(cur.a, cur.t, FUN=function(x, y) { 
+ 					out <- (y-1)*alen + x
+ 					out[x > alen | x < 1 | y > tlen | y < 1] <- -1
+ 					return(out)
+ 				})
+ 				indices <- indices[keep(indices, exclude)]
+ 				indices <- indices[indices > 0]
+ 				indices <- indices[valid[indices]]
+ 
+ 				# Computing the average across this quadrant.
+ 				relevant.rows <- inter.space[indices]
+ 				is.zero <- relevant.rows==0L
+                 for (lib in seq_len(nlibs)) { 
+                     output[[quad]][pair,lib] <- sum(counts[relevant.rows[!is.zero],lib])
+                 }
+                 output.n[[quad]][pair] <- length(relevant.rows)
+ 			}
+ 
+ #			if (exclude) { # Troubleshooting.
+ #				print(c(aid[pair], tid[pair]))
+ #				print(collected)
+ #				print(collected.n)
+ #			}	
+ 		}
+         
+         for (quad in starting.dex:total.num) {
+             mat <- assay(bg, diffHic:::.neighbor_locales()[quad])
+             chosen.mat <- mat[cur.pairs,]
+             dimnames(chosen.mat) <- NULL
+             if (!identical(chosen.mat, output[[quad]])) { 
+                 stop("counts don't match up for one neighbourhood")
+             }
+             mat.n <- rowData(bg)[[paste0("N.", diffHic:::.neighbor_locales()[quad])]]
+             chosen.mat.n <- as.integer(mat.n[cur.pairs])
+             if (!identical(chosen.mat.n, output.n[[quad]])) { 
+                 stop("neighbourhood sizes don't match up")
+             }
+         }
+     }
+ 	return(head(assay(bg, diffHic:::.neighbor_locales()[1])))
+ }
> 
> ###################################################################################################
> # Simulating.
> 
> set.seed(3427675)
> comp(10, c(chrA=10), 5)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]   36   43   40   34
[3,]   30   39   33   31
[4,]    5    3    7    3
[5,]    6    8    6    6
[6,]    5    3    7    3
> comp(100, c(chrA=10, chrB=30, chrC=20), 5)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]    0    0    0    0
[3,]    0    0    0    0
[4,]    0    0    0    0
[5,]   14   11   11    9
[6,]    0    0    0    0
> comp(100, c(chrA=10, chrC=20), 5)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]    0    0    0    0
[3,]   14    8    3   10
[4,]   21   22   19   21
[5,]    0    0    0    0
[6,]   27   30   22   27
> comp(100, c(chrA=10, chrB=5, chrC=20), 5)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]   21   23   14    9
[3,]    0    0    0    0
[4,]   28   37   28   31
[5,]   43   25   30   29
[6,]    0    0    0    0
> comp(100, c(chrA=20, chrB=5), 5)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]   21   21   16   25
[3,]    4    6    6    8
[4,]    0    0    0    0
[5,]   39   48   39   63
[6,]    6    6    6    8
> 
> comp(100, c(chrA=10, chrB=30, chrC=20), 10)
     [,1] [,2] [,3] [,4]
[1,]   19   21   19   20
[2,]    0    0    0    0
[3,]    0    0    0    0
[4,]    0    0    0    0
[5,]    0    0    0    0
[6,]   17   12   13   10
> comp(100, c(chrA=10, chrC=20), 10)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]  123  140  140  138
[3,]    0    0    0    0
[4,]    3    5    9    7
[5,]  123  136  112  126
[6,]   33   37   22   26
> comp(100, c(chrA=10, chrB=5, chrC=20), 10)
     [,1] [,2] [,3] [,4]
[1,]   13   13   13   12
[2,]   17    9   11    8
[3,]   32   16   19   23
[4,]    0    0    0    0
[5,]    0    0    0    0
[6,]    0    0    0    0
> comp(100, c(chrA=20, chrB=10), 10)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]    0    0    0    0
[3,]    0    0    0    0
[4,]   24   26   28   21
[5,]    6    6    8    8
[6,]  146  106  120  118
> 
> comp(200, c(chrA=10, chrB=30, chrC=20), 3)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]    0    0    0    0
[3,]    0    0    0    0
[4,]    8    4    6    5
[5,]    0    0    0    0
[6,]    0    0    0    0
> comp(200, c(chrA=10, chrC=20), 3)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]   30   32   22   29
[3,]   44   41   46   39
[4,]   34   39   41   39
[5,]    0    0    0    0
[6,]    0    0    0    0
> comp(200, c(chrA=10, chrB=5, chrC=20), 3)
     [,1] [,2] [,3] [,4]
[1,]   17   10   21   12
[2,]    0    0    0    0
[3,]   21   13   13   15
[4,]   31   28   29   28
[5,]    0    0    0    0
[6,]    0    0    0    0
> comp(200, c(chrA=20, chrB=3), 3)
     [,1] [,2] [,3] [,4]
[1,]   54   58   66   66
[2,]   44   54   41   43
[3,]    0    0    0    0
[4,]   35   45   47   59
[5,]   62   64   71   53
[6,]   30   29   39   30
> 
> comp(200, c(chrA=10, chrB=30, chrC=20), 1)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]    0    0    0    0
[3,]    8    8    4   11
[4,]    0    0    0    0
[5,]    0    0    0    0
[6,]    0    0    0    0
> comp(200, c(chrA=10, chrC=20), 1)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]   14   12   14   14
[3,]    0    0    0    0
[4,]    0    0    0    0
[5,]    0    0    0    0
[6,]    0    0    0    0
> comp(200, c(chrA=10, chrB=5, chrC=20), 1)
     [,1] [,2] [,3] [,4]
[1,]    8    9   11   13
[2,]    8    6    8    7
[3,]    5    3    6    7
[4,]    0    0    0    0
[5,]    0    0    0    0
[6,]    0    0    0    0
> comp(200, c(chrA=20, chrB=5), 1)
     [,1] [,2] [,3] [,4]
[1,]   12   13   10   16
[2,]   11   19   16   12
[3,]    8    9   13    3
[4,]   15   11    7   13
[5,]   10    9   13   11
[6,]    0    0    0    0
> 
> comp(200, c(chrA=10, chrB=30, chrC=20), 3, exclude=1)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]    0    0    0    0
[3,]    0    0    0    0
[4,]   12    5   19   11
[5,]    0    0    0    0
[6,]    0    0    0    0
> comp(200, c(chrA=10, chrC=20), 3, exclude=1)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    0
[2,]    0    0    0    0
[3,]    0    0    0    0
[4,]    0    0    0    0
[5,]    0    0    0    0
[6,]    5   10    6    5
> comp(200, c(chrA=10, chrB=5, chrC=20), 3, exclude=1)
     [,1] [,2] [,3] [,4]
[1,]   26   32   24   29
[2,]    0    0    0    0
[3,]   14   18   12   16
[4,]    0    0    0    0
[5,]    0    0    0    0
[6,]   26   36   23   28
> comp(200, c(chrA=20, chrB=5), 3, exclude=1)
     [,1] [,2] [,3] [,4]
[1,]   52   54   37   45
[2,]   50   42   42   47
[3,]    0    0    0    0
[4,]    0    0    0    0
[5,]   35   43   42   41
[6,]    0    0    0    0
> 
> ###################################################################################################
> # Same sort of simulation, but direct from read data, for neighborCounts testing.
> 
> chromos<-c(chrA=51, chrB=31)
> source("simcounts.R")
> 
> dir.create("temp-neighbor")
> dir1<-"temp-neighbor/1.h5"
> dir2<-"temp-neighbor/2.h5"
> 
> comp2 <- function(npairs1, npairs2, width, cuts, filter=1, flank=5, exclude=0) {
+ 	simgen(dir1, npairs1, chromos)
+ 	simgen(dir2, npairs2, chromos)
+ 	param <- pairParam(fragments=cuts)
+ 
+ 	out <- neighborCounts(c(dir1, dir2), param, width=width, filter=filter, flank=flank, exclude=exclude)
+ 
+ 	ref <- squareCounts(c(dir1, dir2), width=width, param, filter=1)
+ 	keep <- rowSums(assay(ref)) >= filter
+ 	subref <- enrichedPairs(ref, flank=flank, exclude=exclude)[keep,]
+ 
+ 	if (!identical(regions(subref), regions(out))) { stop("extracted regions don't match up") }
+ 	if (!identical(anchors(subref, id=TRUE), anchors(out, id=TRUE))) { stop("extracted anchors don't match up") }
+ 	if (!identical(assays(subref), assays(out))) { stop("extracted counts don't match up") }
+ 	if (!identical(colData(subref), colData(out))) { stop("extracted colData doesn't match up") }
+ 	if (!identical(metadata(subref), metadata(out))) { stop("extracted metadata doesn't match up") }
+     if (!identical(filterPeaks(subref, get.enrich=TRUE), filterPeaks(out, get.enrich=TRUE))) { stop("enrichment values don't match up") }
+ 
+     return(head(assay(out, diffHic:::.neighbor_locales()[1])))
+ }
> 
> set.seed(2384)
> comp2(100, 50, 10000, cuts=simcuts(chromos))
     [,1] [,2]
[1,]    0    0
[2,]    2    2
[3,]    0    0
[4,]   11    6
[5,]    3    1
[6,]    0    0
> comp2(100, 50, 10000, cuts=simcuts(chromos), filter=10)
     [,1] [,2]
[1,]   10    5
[2,]   16    7
[3,]   85   41
[4,]   59   23
[5,]   38   13
[6,]    7    0
> comp2(100, 50, 10000, cuts=simcuts(chromos), flank=3)
     [,1] [,2]
[1,]    0    0
[2,]    4    4
[3,]    0    0
[4,]   17   10
[5,]    4    0
[6,]    0    0
> comp2(100, 50, 10000, cuts=simcuts(chromos))
     [,1] [,2]
[1,]    0    0
[2,]    6    3
[3,]    0    0
[4,]   17    8
[5,]    3    3
[6,]   35   14
> 
> comp2(50, 200, 5000, cuts=simcuts(chromos))
     [,1] [,2]
[1,]    0    2
[2,]    0    0
[3,]    2   11
[4,]    0    4
[5,]    0    0
[6,]    6   24
> comp2(50, 200, 5000, cuts=simcuts(chromos), filter=10)
     [,1] [,2]
[1,]   19   48
[2,]    0    0
[3,]    2    8
[4,]   17   51
[5,]    0    0
[6,]   30  120
> comp2(50, 200, 5000, cuts=simcuts(chromos), flank=3)
     [,1] [,2]
[1,]    0    0
[2,]    0    2
[3,]    0   14
[4,]    0    3
[5,]    0    0
[6,]    2   23
> comp2(50, 200, 5000, cuts=simcuts(chromos))
     [,1] [,2]
[1,]    0    0
[2,]    0    3
[3,]    0    0
[4,]    1   13
[5,]    1    4
[6,]    0    0
> 
> comp2(100, 200, 1000, cuts=simcuts(chromos))
     [,1] [,2]
[1,]    0    0
[2,]    0    0
[3,]    0    0
[4,]    2    2
[5,]    0    0
[6,]    1    1
> comp2(100, 200, 1000, cuts=simcuts(chromos), filter=5)
     [,1] [,2]
[1,]   11   12
> comp2(100, 200, 1000, cuts=simcuts(chromos), flank=3)
     [,1] [,2]
[1,]    0    0
[2,]    0    0
[3,]    1    2
[4,]    0    1
[5,]    0    0
[6,]    2    1
> comp2(100, 200, 1000, cuts=simcuts(chromos))
     [,1] [,2]
[1,]    0    0
[2,]    0    1
[3,]    0    0
[4,]    3    5
[5,]    2    1
[6,]    1    1
> 
> comp2(10, 20, 1000, cuts=simcuts(chromos))
     [,1] [,2]
[1,]    0    0
[2,]    2    0
[3,]    1    0
[4,]    0    0
[5,]    0    0
[6,]    0    0
> comp2(10, 20, 1000, cuts=simcuts(chromos), filter=5)
     [,1] [,2]
> comp2(10, 20, 1000, cuts=simcuts(chromos), flank=3)
     [,1] [,2]
[1,]    0    0
[2,]    0    0
[3,]    0    0
[4,]    0    0
[5,]    0    0
[6,]    0    0
> comp2(10, 20, 1000, cuts=simcuts(chromos))
     [,1] [,2]
[1,]    0    0
[2,]    0    0
[3,]    1    1
[4,]    0    2
[5,]    0    0
[6,]    0    1
> 
> comp2(10, 20, 1000, cuts=simcuts(chromos), exclude=1)
     [,1] [,2]
[1,]    0    0
[2,]    0    1
[3,]    0    0
[4,]    0    0
[5,]    0    1
[6,]    1    1
> comp2(50, 20, 1000, cuts=simcuts(chromos), exclude=1)
     [,1] [,2]
[1,]    1    0
[2,]    0    0
[3,]    2    0
[4,]    0    0
[5,]    1    2
[6,]    2    1
> comp2(100, 50, 1000, cuts=simcuts(chromos), exclude=2)
     [,1] [,2]
[1,]    0    0
[2,]    0    0
[3,]    0    0
[4,]    1    0
[5,]    0    0
[6,]    3    0
> comp2(50, 200, 1000, cuts=simcuts(chromos), exclude=2)
     [,1] [,2]
[1,]    0    0
[2,]    0    0
[3,]    0    0
[4,]    1    1
[5,]    0    0
[6,]    1    1
> 
> #####################################################################################################
> # Cleaning up
> 
> unlink("temp-neighbor", recursive=TRUE)
> 
> #####################################################################################################
> # End.
> 
> 
> 
> proc.time()
   user  system elapsed 
 15.508   0.184  15.733 
