
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 script is designed to test the pair-identifying capabilities of the hiC machinery i.e. preparePairs. 
> # We start with unit tests for individual components of the preparePairs C++ code.
> 
> suppressPackageStartupMessages(require(diffHic))
> suppressPackageStartupMessages(require(GenomicAlignments))
> source("simsam.R")
> 
> dir<-"hic-test"
> dir.create(dir)
> 
> # Checking CIGAR.
> 
> checkCIGAR <- function(cigar, rstrand) {
+     output <- simsam(file.path(dir, "whee"), "chrA", 1, !rstrand, c("chrA"=1000), 
+            cigar=cigar, len=cigarWidthAlongQuerySpace(cigar))
+ 
+ 	out <- .Call(diffHic:::cxx_test_parse_cigar, output)
+ 	if (is.character(out)) { stop(out) }
+ 	
+ 	true.alen <- cigarWidthAlongReferenceSpace(cigar)
+ 	if (out[1]!=true.alen) { stop("mismatch in alignment length") }
+ 
+ 	offset <- 0
+ 	as.rle <- cigarToRleList(cigar)[[1]]
+ 	if (rstrand) { as.rle <- rev(as.rle) }
+ 	if (runValue(as.rle)[1]=="H") { offset <- runLength(as.rle)[1] } 
+ 	if (out[2]!=offset) { stop("mismatch in offsets") }
+ 
+ 	return(c(alen=true.alen, offset=offset))
+ }
> 
> checkCIGAR("5H20M", TRUE)
  alen offset 
    20      0 
> checkCIGAR("5H20M", FALSE)
  alen offset 
    20      5 
> 
> checkCIGAR("5H20M6H", TRUE)
  alen offset 
    20      6 
> checkCIGAR("5H20M6H", FALSE)
  alen offset 
    20      5 
> 
> checkCIGAR("5H20M6S", TRUE)
  alen offset 
    20      0 
> checkCIGAR("5H20M6S", FALSE)
  alen offset 
    20      5 
> 
> checkCIGAR("20M5I30M", TRUE)
  alen offset 
    50      0 
> checkCIGAR("20M5D30M", TRUE)
  alen offset 
    55      0 
> checkCIGAR("20M5N30M", TRUE)
  alen offset 
    55      0 
> checkCIGAR("20M5P30M", TRUE)
  alen offset 
    50      0 
> 
> checkCIGAR("20M5X30M", TRUE)
  alen offset 
    55      0 
> checkCIGAR("20M5=30M", TRUE)
  alen offset 
    55      0 
> 
> checkCIGAR("10M2I5M3D20M", TRUE)
  alen offset 
    38      0 
> checkCIGAR("10M2I3D5N20M", TRUE)
  alen offset 
    38      0 
> checkCIGAR("10M2P5M3D20I", TRUE)
  alen offset 
    18      0 
> checkCIGAR("10M2I3D5N20D", TRUE)
  alen offset 
    38      0 
> 
> checkCIGAR("5H11M5D8I9X6=6H", TRUE)
  alen offset 
    31      6 
> checkCIGAR("5H20X5D8P9N72M", FALSE)
  alen offset 
   106      5 
> checkCIGAR("5S19M34=55D8X20M6S", TRUE)
  alen offset 
   136      0 
> checkCIGAR("5S1M3=5D18X2M6S", FALSE)
  alen offset 
    29      0 
> 
> # Checking fragment assignment.
> 
> assign2fragment <- function(starts, ends, chr, pos, rstrand, len) {
+ 	out <- .Call(diffHic:::cxx_test_fragment_assign, starts, ends, chr, pos, rstrand, len)
+ 	if (is.character(out)) { stop(out) }
+ 
+ 	chr <- chr + 1L
+ 	if (rstrand) { 
+ 		fiveprime <- min(pos + len -1L, tail(ends[[chr]], 1))
+ 		stopifnot(ends[[chr]][out] >= fiveprime && (out==1L || ends[[chr]][out-1] < fiveprime))
+ 	} else { 
+ 		fiveprime <- pos 
+ 		stopifnot(starts[[chr]][out] <= fiveprime && (out==length(starts[[chr]]) || starts[[chr]][out+1] > fiveprime))
+ 	}
+ 	
+ 	out
+ }
> 
> starts <- list( c(1L, 100L, 200L, 300L, 400L, 500L), # chr1
+                 c(1L, 100L, 200L, 300L, 400L, 500L)) # chr2
> ends <- list( c(103L, 203L, 303L, 403L, 503L, 1000L), # chr1
+               c(103L, 203L, 303L, 403L, 503L, 1000L)) # chr2
> 
> assign2fragment(starts, ends, 0L, 94L, TRUE, 10L)
[1] 1
> assign2fragment(starts, ends, 0L, 95L, TRUE, 10L)
[1] 2
> assign2fragment(starts, ends, 0L, 99L, FALSE, 10L)
[1] 1
> assign2fragment(starts, ends, 0L, 100L, FALSE, 10L)
[1] 2
> 
> assign2fragment(starts, ends, 0L, 203L, TRUE, 1L)
[1] 2
> assign2fragment(starts, ends, 0L, 204L, TRUE, 1L)
[1] 3
> assign2fragment(starts, ends, 0L, 209L, FALSE, 1L)
[1] 3
> assign2fragment(starts, ends, 0L, 300L, FALSE, 1L)
[1] 4
> 
> assign2fragment(starts, ends, 1L, 1L, FALSE, 10L)
[1] 1
> assign2fragment(starts, ends, 1L, 991L, FALSE, 10L)
[1] 6
> assign2fragment(starts, ends, 1L, 992L, FALSE, 10L)
[1] 6
> assign2fragment(starts, ends, 1L, 991L, TRUE, 10L)
[1] 6
> assign2fragment(starts, ends, 1L, 992L, TRUE, 10L)
[1] 6
Warning message:
In assign2fragment(starts, ends, 1L, 992L, TRUE, 10L) :
  read aligned off end of chromosome
> 
> starts <- list( c(1L, 1L, 100L, 200L, 300L, 400L, 500L, 997L), # chr1, with nesting at the start and end.
+                 c(1L, 1L, 100L, 200L, 300L, 400L, 500L, 997L)) # chr2
> ends <- list( c(4L, 103L, 203L, 303L, 403L, 503L, 1000L, 1000L), # chr1
+               c(4L, 103L, 203L, 303L, 403L, 503L, 1000L, 1000L)) # chr2
> 
> assign2fragment(starts, ends, 0L, 1L, FALSE, 10L)
[1] 2
> assign2fragment(starts, ends, 0L, 1L, TRUE, 10L)
[1] 2
> assign2fragment(starts, ends, 0L, 991L, FALSE, 10L)
[1] 7
> assign2fragment(starts, ends, 0L, 991L, TRUE, 10L)
[1] 7
> try(assign2fragment(starts, ends, 0L, 1000L, TRUE, 10L)) # This should fail, as it gets assigned into the nested fragment.
Error in assign2fragment(starts, ends, 0L, 1000L, TRUE, 10L) : 
  ends[[chr]][out] >= fiveprime && (out == 1L || ends[[chr]][out -  .... is not TRUE
In addition: Warning message:
In assign2fragment(starts, ends, 0L, 1000L, TRUE, 10L) :
  read aligned off end of chromosome
> 
> ###################################################################################################
> # We also set up a full simulation for the entire function.
> 
> suppressPackageStartupMessages(require("rhdf5"))
> 
> comp <- function (fname, npairs, max.cuts, sizes=c(100, 500), singles=0, rlen=10, overhang=0L, pseudo=FALSE, extras=NULL, storage=5000) {
+ 
+     ################ SETTING UP THE FRAGMENTS ###################
+ 
+ 	rlen <- as.integer(rlen)
+ 	overhang <- as.integer(overhang)
+ 	if (min(sizes) <= rlen) { stop("min fragment must be greater than read length") } 
+ 	# Necessary for proper assignment, especially at the start of the chromosome when reverse 
+ 	# reads are bounded at zero (i.e. their 5' ends would not be defined if 1+rlen > fragmentsize)
+ 
+ 	# Randomly generating fragment lengths for the chromosome.
+ 	fragments <- cut.starts <- outfrags <- list()
+ 	chromosomes <- integer(length(max.cuts))
+ 	for (i in seq_along(max.cuts)) { 
+ 		fragments[[i]] <- as.integer(round(runif(max.cuts[[i]], sizes[1], sizes[2])))
+ 		ends <- cumsum(fragments[[i]]) - seq_len(max.cuts[[i]])*overhang
+ 		if (max.cuts[[i]] > 1L) { 
+ 			cut.starts[[i]] <- c(1L, (ends+1L)[seq_len(max.cuts[[i]]-1)])
+ 		} else {
+ 			cut.starts[[i]] <- 1L
+ 		}
+ 		outfrags[[i]] <- GRanges(names(max.cuts)[i], IRanges(cut.starts[[i]], ends+overhang))
+ 		chromosomes[i] <- tail(ends, 1)+overhang
+ 	}
+ 
+     seq.names <- names(max.cuts)
+     seq.lengths <- chromosomes
+        
+ 	suppressWarnings(outfrags <- do.call(c, outfrags))
+     seqlevels(outfrags) <- seq.names
+     seqlengths(outfrags) <- setNames(seq.lengths, seq.names)
+ 	names(chromosomes) <- names(max.cuts)
+ 	names(fragments) <- names(max.cuts)
+ 	names(cut.starts) <- names(max.cuts)
+ 
+     ################ SETTING UP THE READ PAIRS ###################
+ 
+ 	# Randomly generating reads (a la getPESizes' example).
+ 
+     names <- paste('x', rep(seq_len(npairs), 2), sep=".")
+     chrs <- sample(length(chromosomes), length(names), replace=TRUE)
+     pos <- integer(length(names));
+ 	frag.ids <- integer(length(names))
+     str <- rbinom(length(names), 1, 0.5)==1 
+ 
+     # Assigning positions to all of them. Some finesse is necessary when 
+ 	# there is no overhang (i.e. original genome with positive overhang). We
+ 	# still allow reads to span restriction sites, though.
+     for (i in seq_along(chromosomes)) {
+         current <- chrs==i
+ 		chosen.frags <- as.integer(runif(sum(current), 1, length(fragments[[i]])+1))
+ 		frag.ids[current] <- chosen.frags
+ 		my.ends <- cut.starts[[i]] + fragments[[i]]
+ 
+     	# Note that as.integer(runif(1, a, b)) samples from [a, b), as runif() will never actually generate 'b'.
+         # So, this will only generate positions after and including the start position for the chosen fragment,
+         # but before and not including the start position for the next fragment (or 1-past the end of the chromosome).
+     	cur.for <- str[current]
+         forward.frag <- chosen.frags[cur.for]
+         forward.min <- cut.starts[[i]][forward.frag]
+         forward.max <- ifelse(forward.frag!=length(cut.starts[[i]]), cut.starts[[i]][forward.frag+1L], my.ends[forward.frag])
+         pos[current][cur.for] <- as.integer(runif(sum(cur.for), forward.min, forward.max))
+ 
+         # Recall that the 'ends' are 1-past the last base of the fragment, so this runif() will sample from 
+         # the first non-overlapping base of the current fragment to the last base of the current fragment
+         # (it's [a, b), so when b is 1-past the last base, sampling will include the last base).
+ 		reverse.frag <- chosen.frags[!cur.for]
+         reverse.min <- integer(sum(!cur.for))
+         possible.zero <- reverse.frag==1L
+         reverse.min[possible.zero] <- 1L
+         reverse.min[!possible.zero] <- my.ends[reverse.frag[!possible.zero]-1L] 
+         reverse.max <- my.ends[reverse.frag]
+         pos[current][!cur.for] <- pmax(1L, as.integer(runif(sum(!cur.for), reverse.min, reverse.max)) - rlen + 1L)
+     }
+ 
+     # Throwing them into the SAM file generator. Note that chromosome names are ordered inside. 
+     # If this differs from the order in 'max.cuts', it will test the ability of preparePairs to match them up correctly.
+ 	reversi <- c(seq_len(npairs) + npairs, seq_len(npairs))
+     out <- simsam(fname, names(chromosomes)[chrs], pos, str, chromosomes, names=names, len=rlen, 
+                   is.first=rep(c(TRUE, FALSE), each=npairs), is.paired=TRUE,
+                   mate.chr=names(chromosomes)[chrs][reversi], mate.pos=pos[reversi], mate.str=str[reversi])
+ 
+ 	if (singles) { 
+ 	    # Adding some singles. You'll get some warnings regarding overhang regions as we're not finessing it.
+     	snames <- schrs <- spos <- NULL
+         snames <- paste('y', seq_len(singles), sep=".")
+         schrs <- sample(length(chromosomes), singles, replace=TRUE)
+         spos <- integer(singles);
+ 		for (i in seq_along(chromosomes)) {
+ 	       	scurrent <- schrs==i;
+         	spos[scurrent] <- as.integer(round(runif(sum(scurrent), 1, chromosomes[i])))
+ 		}
+ 	
+     	tempname <- file.path(dir, "temp")
+     	sstr <- rbinom(singles, 1, 0.5)==1 
+ 		out2 <- simsam(tempname, names(chromosomes)[schrs], spos, sstr, chromosomes, names=snames, len=rlen)
+ 		more.temp <- file.path(dir, "temp2")
+ 		out <- mergeBam(c(out, out2), more.temp, indexDestination=TRUE, overwrite=TRUE)
+ 		file.rename(more.temp, out)
+ 	}
+ 
+ 	# Resorting by name.
+ 	temp <- sortBam(out, "temp", byQname=TRUE)
+ 	file.rename(temp, out)
+ 
+ 	################ THEORETICAL MATCH ###################
+ 
+     # This gets the status: 0 for okay, 1 for dangling end, 3 for self.circles and and 2 for other stuff.
+     getstatus <- function(chr1, pos1, frag1, str1, chr2, pos2, frag2, str2) {
+         codes <- integer(length(chr1))
+         potentials <- chr1==chr2 & frag1==frag2
+         
+         same.str <- str1==str2;
+         codes[ same.str & potentials ] <- 2L
+         potentials <- potentials & !same.str
+         
+         self.circle <- (str1 & pos2+rlen <= pos1) | (str2 & pos1+rlen <= pos2);
+         codes[ self.circle & potentials ] <- 3L
+         potentials <- potentials & !self.circle
+ 
+         # Not worrying about overextension; these are now considered to be dangling ends,
+         # as sequencing/trimming/alignment errors can often result in a few overextended bases.
+ #        overextension <- (str1 & pos1 > pos2) | (str2 & pos2 > pos1) # Don't need to check +rlen, as they're al the same.
+ #        codes[ overextension & potentials ] <- 2L
+ #        potentials <- potentials & !overextension
+         
+         codes[potentials] <- 1L
+         return(codes)
+     }
+ 
+     # This gets the distance from the 5' end of the read to the next restriction site that it is pointing to (past the one it covers, if it is incomplete).
+     getlen <- function(chr, pos, start, str) {
+         len.out <- integer(length(chr))
+         for (x in seq_along(cut.starts)) { 
+             chosen <- x==chr
+             dist2cut <- ifelse(str[chosen], cut.starts[[x]][start[chosen]]+fragments[[x]][start[chosen]]-pos[chosen],
+                                pos[chosen]+rlen-cut.starts[[x]][start[chosen]])
+             len.out[chosen] <- dist2cut
+         }
+         return(len.out)
+     }	
+ 
+ 	# Now, actually assembling the theoretical values.
+ 	primary <- seq_len(npairs)
+ 	secondary<- npairs + primary
+ 	pchrs <- chrs[primary]
+ 	ppos <- pos[primary]
+ 	pfrag <- frag.ids[primary]
+ 	pstr <- str[primary]
+ 	schrs <- chrs[secondary]
+ 	spos <- pos[secondary]
+ 	sfrag <- frag.ids[secondary]
+ 	sstr <- str[secondary]
+ 	codes <- getstatus(pchrs, ppos, pfrag, pstr, schrs, spos, sfrag, sstr)
+ 
+     if (pseudo) { 
+         frag.lens <- rep(NA_integer_, npairs)
+         pfrag[] <- 0L
+         sfrag[] <- 0L
+     } else {
+         frag.lens <- getlen(pchrs, ppos, pfrag, pstr) + getlen(schrs, spos, sfrag, sstr)
+     }
+     ppos5 <- ifelse(pstr, ppos, ppos+rlen -1L) 
+     spos5 <- ifelse(sstr, spos, spos+rlen -1L) 
+     panchor <- pchrs > schrs | (pchrs==schrs & pfrag > sfrag) | (pchrs==schrs & pfrag==sfrag & ppos5 > spos5)
+     inserts <- ifelse(pchrs==schrs, pmax(ppos, spos)-pmin(spos, ppos)+rlen, NA)
+ 	orientations <- ifelse(pstr, 0L, ifelse(panchor, 1L, 2L))+ifelse(sstr, 0L, ifelse(panchor, 2L, 1L))
+ 
+ 	################ ACTUAL MATCH ###################
+ 	# Assembling the output list for comparison.
+ 
+     # Adding an extra chromosome to the start, to see if the match is still correct when it's not 1:1.
+     # Also deleting a chromosome to trigger an error.
+     if (!is.null(extras)) { 
+         if (extras[1]==-1L) {
+             used.frags <- dropSeqlevels(outfrags, seqnames(outfrags)[1], pruning.mode="coarse")
+         } else { 
+             used.frags <- suppressWarnings(c(GRanges(extras, IRanges(1, 100)), outfrags))
+         }
+     } else {
+         used.frags <- outfrags
+     }
+ 
+ 	tmpdir<-paste0(fname, "_temp")
+ 	param <- pairParam(fragments=used.frags)
+ 	if (pseudo) {
+ 		# Special behaviour; faster assignment into bins, no removal of dangling ends/self-cirlces
+ 		# (as these concepts are meaningless for arbitrary bins).
+         param <- pairParam(used.frags[0])
+ 		diagnostics <- preparePairs(out, param, tmpdir, output.dir=file.path(dir, "whee"), storage=storage)
+ 	} else {
+ 		diagnostics <- preparePairs(out, param, tmpdir, output.dir=file.path(dir, "whee"), storage=storage)
+ 		
+ 		stopifnot(sum(codes==1L)==diagnostics$same.id[["dangling"]])
+ 		stopifnot(sum(codes==3L)==diagnostics$same.id[["self.circle"]])
+ 		stopifnot(length(codes)==diagnostics$pairs[["total"]])
+ 		stopifnot(singles==diagnostics$singles)
+ 
+ 		# No support for testing chimeras, we use a fixed example below.
+ 		stopifnot(diagnostics$unmapped.chimeras==0L) 
+ 		stopifnot(diagnostics$chimeras[["total"]]==0L)
+ 		stopifnot(diagnostics$chimeras[["mapped"]]==0L)
+ 		stopifnot(diagnostics$chimeras[["invalid"]]==0L)
+ 	}
+ 
+ 	# Anchor1/anchor2 synchronisation is determined by order in 'fragments' (and thusly, in max.cuts).
+     if (pseudo) { 
+         offset <- integer(length(chromosomes)) # 'extras' don't matter, as ID is set to zero anyway.
+     } else { 
+         offset <- c(0L, cumsum(max.cuts))
+         names(offset) <- NULL
+         offset <- offset + length(extras)
+     }
+ 
+     indices <- diffHic:::preloader(tmpdir)
+ 	fchrs <- as.character(seqnames(used.frags))
+ 	for (i in seq_along(max.cuts)) {
+ 		for (j in seq_len(i)) {
+ 
+             # Getting the fragment IDs for the remaining pairs for this chromosome.
+ 			stuff <- (pchrs==i & schrs==j) | (pchrs==j & schrs==i) 
+ 			if (!pseudo) { stuff <- stuff & (codes==0L | codes==2L) }
+ 			pids <- pfrag[stuff]
+ 			sids <- sfrag[stuff]
+ 			pps <- ppos[stuff]
+ 			sps <- spos[stuff]
+             pls <- ifelse(pstr[stuff], 1L, -1L)*rlen
+             sls <- ifelse(sstr[stuff], 1L, -1L)*rlen
+ 
+             which.is.which <- panchor[stuff]
+     	    anchor1 <- ifelse(which.is.which, pids, sids) + offset[i]
+             anchor2 <- ifelse(which.is.which, sids, pids) + offset[j]
+             ap1 <- ifelse(which.is.which, pps, sps)
+             ap2 <- ifelse(which.is.which, sps, pps)
+             al1 <- ifelse(which.is.which, pls, sls)
+             al2 <- ifelse(which.is.which, sls, pls)
+ 
+ 			totes <- frag.lens[stuff]
+ 			cur.ori <- orientations[stuff]
+ 			cur.insert <- inserts[stuff]
+ 			o <- order(anchor1, anchor2, ap1, ap2, al1, al2, totes, cur.ori, cur.insert)
+ 
+             # Extracting data from HDF5 and computing statistics.
+ 			achr <- names(max.cuts)[i]
+ 			tchr <- names(max.cuts)[j]
+ 			if (!(achr%in%names(indices)) || !(tchr %in% names(indices[[achr]]))) { 
+ 				if (length(o)) { stop("true interactions are missing") }
+ 				next
+ 			}
+ 			current <- h5read(tmpdir, file.path(achr, tchr))
+ 			for (x in seq_len(ncol(current))) { attributes(current[,x]) <- NULL }
+             collated <- diffHic:::.getStats(current, achr==tchr, used.frags)
+             
+ 			# Checking anchor1/anchor2/length/orientation/insert statistics (sorting on everything to ensure comparability).
+ 			o2 <- order(current$anchor1.id, current$anchor2.id, current$anchor1.pos, current$anchor2.pos, 
+                         current$anchor1.len, current$anchor2.len, collated$length, collated$orientation, collated$insert)
+             stopifnot(identical(current$anchor1.id[o2], anchor1[o]))
+             stopifnot(identical(current$anchor2.id[o2], anchor2[o]))
+             stopifnot(identical(current$anchor1.pos[o2], ap1[o]))
+             stopifnot(identical(current$anchor2.pos[o2], ap2[o]))
+             stopifnot(identical(current$anchor1.len[o2], al1[o]))
+             stopifnot(identical(current$anchor2.len[o2], al2[o]))
+ 
+             stopifnot(identical(collated$length[o2], totes[o]))
+ 			stopifnot(identical(collated$orientation[o2], cur.ori[o]))
+ 			stopifnot(identical(collated$insert[o2], cur.insert[o]))
+ 	
+             # Checking that choice and ordering of anchor1 and anchor2 is sane.
+             current5.1 <- current$anchor1.pos - pmin(0L, current$anchor1.len + 1L)
+             current5.2 <- current$anchor2.pos - pmin(0L, current$anchor2.len + 1L)
+             if (!pseudo) { 
+                 stopifnot(all(current$anchor1.id >= current$anchor2.id))
+                 stopifnot(all((current5.1 >= current5.2)[current$anchor1.id==current$anchor2.id]))
+                 o <- order(current$anchor1.id, current$anchor2.id)
+                 stopifnot(!is.unsorted(o))
+             } else {
+                 stopifnot(all(current$anchor1.id==0L & current$anchor2.id==0L))
+                 if (i==j) {
+                     if (!all(current5.1 >= current5.2)) {
+                         print(current)
+                     }
+                     stopifnot(all(current5.1 >= current5.2)) 
+                 }    
+             }
+ 			
+ 			# Checking that we're looking at the right combination.
+             if (!pseudo) { 
+                 uniq.a <- unique(fchrs[current$anchor1.id])
+                 uniq.t <- unique(fchrs[current$anchor2.id])
+                 if (length(uniq.a)!=1L || length(uniq.t)!=1L) { stop("file contains more than one combination") }
+                 if (achr!=uniq.a || tchr!=uniq.t) { stop("file contains the incorrect combination") }
+             }
+ 
+             # Wiping it out to indicate that we've visited this place.
+             indices[[achr]][[tchr]]<-NULL
+         }
+ 	}
+ 
+ 	# Checking there's nothing left.
+ 	if (!is.null(unlist(indices))) { stop("objects left unused in the directory") }
+ 
+ 	# Length insert and orientation checking.
+ 	if (!pseudo) { 
+ 		keepers<-codes==0L | codes==2L
+ 	} else { 
+ 		keepers <- !logical(length(codes)) 
+ 	}
+ 	valid.len <- frag.lens[keepers]
+ 	valid.insert <- inserts[keepers]
+ 	valid.ori <- orientations[keepers]
+ 	o <- order(valid.len, valid.ori, valid.insert)
+ 	auxiliary <- getPairData(tmpdir, param)
+ 	o2 <- do.call(order, auxiliary)
+ 	if (!identical(valid.len[o], auxiliary$length[o2])) { stop("extracted fragment sizes don't match up") }
+ 	if (!identical(valid.insert[o], auxiliary$insert[o2])) { stop("extracted inserts don't match up") }
+ 	if (!identical(valid.ori[o], auxiliary$orientation[o2])) { stop("extracted orientations don't match up") }
+ 
+ 	curdex <- h5ls(tmpdir)
+ 	curdex <- curdex[curdex$otype=="H5I_DATASET",][1,]
+ 	returned <- h5read(tmpdir, file.path(curdex$group, curdex$name))
+ 	processed <- diffHic:::.getStats(returned, basename(curdex$group)==curdex$name, used.frags)
+ 	return(head(data.frame(anchor1.id=returned$anchor1.id, anchor2.id=returned$anchor2.id, length=processed$length,
+ 		orientation=processed$orientation, insert=processed$insert)))
+ }
> 
> ####################################################################################################
> # Initiating testing with something fairly benign.
> 
> set.seed(0)
> fname<-file.path(dir, "out");
> max.cuts<-c(chrA=20L, chrB=10L, chrC=5L)
> 
> comp(fname, npairs=20, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1         22          1    483           1     NA
2         26         10    330           1     NA
3         26         20    101           2     NA
4         27          3    372           3     NA
5         29         15    244           1     NA
> comp(fname, npairs=50, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1         11          2    310           3   2467
2         11         10    164           0     42
3         17          1    203           2   4526
4         19          4    763           3   4165
5         19         14    320           2   1472
6         19         15    221           3   1436
> comp(fname, npairs=100, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1          7          1    217           0   1972
2          8          5    117           2    980
3         14          5    419           3   2988
4         15         10    263           2   1837
5         16         10    498           2   2019
6         19          7    177           3   3375
> 
> # Ramping up the aggression in terms of self-circles.
> 
> comp(fname, npairs=20, max.cuts=c(chrA=3L))
  anchor1.id anchor2.id length orientation insert
1          2          1    266           1    266
2          2          1    144           3     68
3          2          1    211           2    187
4          2          2    323           0     67
5          2          2    130           0    102
6          3          1    137           1    357
> comp(fname, npairs=50, max.cuts=c(chrA=3L))
  anchor1.id anchor2.id length orientation insert
1          1          1    689           3    131
2          1          1    627           0    331
3          1          1    347           0    151
4          2          1    497           0    608
5          2          1     54           2    703
6          2          1    484           2    273
> comp(fname, npairs=100, max.cuts=c(chrA=3L))
  anchor1.id anchor2.id length orientation insert
1          1          1    197           3     67
2          1          1    502           0     16
3          1          1    205           3     93
4          1          1    423           0    111
5          1          1    206           3     26
6          2          1    169           3    275
> 
> # Increasing the number of reads all round.
> 
> comp(fname, npairs=200, size=c(500, 1000), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          7          2   1414           1   5068
2          7          6    975           1    975
3          8          2   1254           2   5116
4          8          6    713           0   1440
5          9          6    919           2   2548
6         10          6   1340           0   3858
> comp(fname, npairs=1000, size=c(500, 1000), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          2          1    656           3    871
2          2          2    813           0    561
3          4          3    191           2   1296
4          5          1    861           0   3389
5          5          4    699           0    764
6          6          1     91           3   4160
> 
> # Adding some singletons.
> 
> comp(fname, npairs=200, size=c(20, 100), max.cuts=max.cuts, singles=10)
  anchor1.id anchor2.id length orientation insert
1          5          3     49           3    109
2          7          3     42           1    197
3          9          5     53           0    210
4          9          5     49           3    187
5          9          5     90           1    234
6         12          5     45           1    411
> comp(fname, npairs=200, size=c(20, 100), max.cuts=max.cuts, singles=50)
  anchor1.id anchor2.id length orientation insert
1          6          5     59           3     57
2          9          8     64           0     51
3         10          2     47           2    477
4         12          1     84           2    649
5         12          1     67           0    678
6         12          4     68           2    506
> 
> # Making the fragments smaller.
> 
> comp(fname, npairs=200, size=c(60, 100), rlen=50, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1          4          2     67           2    267
2          5          3     51           2    302
3          8          5     84           2    315
4          9          4     86           1    385
5          9          7     45           2    278
6          9          8    112           1    112
> comp(fname, npairs=500, size=c(60, 100), rlen=50, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1          6          2    116           1    362
2          6          3    106           2    313
3          8          7     71           1     71
4          9          1    135           1    708
5          9          4     43           0    382
6         10          4     47           1    414
> 
> # Trying out negative spacings (i.e., non-filled genomes)
> 
> comp(fname, npairs=200, size=c(500, 1000), overhang=2, max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          4          2    467           3   1559
2          5          3    621           0   1539
3          7          1   1266           3   4733
4          7          2    927           2   3642
5          7          2    176           2   4393
6          7          6    738           2    869
> comp(fname, npairs=1000, size=c(500, 1000), overhang=2, max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          2          2    734           0    312
2          3          1    391           2   2017
3          4          2   1172           3   1254
4          4          4     42           0     32
5          5          3    322           2   1609
6          5          3    672           1   1301
> comp(fname, npairs=200, size=c(500, 1000), overhang=4, max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          5          4    821           0   1134
2          6          5    625           0    582
3          9          4   1046           1   3885
4          9          5    988           0   2417
5         11          3   1669           0   6388
6         11          9   1060           3   2204
> comp(fname, npairs=1000, size=c(500, 1000), overhang=4, max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          3          1   1037           2   1267
2          5          2   1329           3   2343
3          5          3    799           1   1309
4          6          5    812           0    625
5          7          1    483           3   4855
6          7          2    882           0   3521
> 
> comp(fname, npairs=200, size=c(20, 100), overhang=2, max.cuts=max.cuts, singles=10)
  anchor1.id anchor2.id length orientation insert
1          2          1     72           2     94
2          5          1     94           2    300
3          7          2     79           1    388
4          7          3     62           1    311
5          9          1     34           2    611
6          9          3     64           3    443
> comp(fname, npairs=200, size=c(20, 100), overhang=2, max.cuts=max.cuts, singles=50)
  anchor1.id anchor2.id length orientation insert
1          1          1     28           0     30
2          6          5    106           1    104
3          8          4     56           0    244
4          8          8     25           3     27
5         11          1     41           1    527
6         12          8     72           2    234
> comp(fname, npairs=200, size=c(20, 100), overhang=4, max.cuts=max.cuts, singles=10)
  anchor1.id anchor2.id length orientation insert
1          6          2     39           1    227
2          7          1     82           3    389
3          8          1    100           0    428
4          9          1     31           2    503
5         10          2     45           1    472
6         10          6     69           0    239
> comp(fname, npairs=200, size=c(20, 100), overhang=4, max.cuts=max.cuts, singles=50)
  anchor1.id anchor2.id length orientation insert
1          3          2     30           0     39
2          5          2     24           0    154
3          5          2     88           1    153
4          5          4     94           2     47
5          8          5     22           0    194
6         10          3     45           3    424
> 
> comp(fname, npairs=200, size=c(60, 100), overhang=4, rlen=50, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1          5          2     86           3    270
2          5          3     96           2    246
3          6          4     79           0    223
4          7          3     59           1    317
5          7          4     99           2    357
6          8          1     63           2    689
> comp(fname, npairs=500, size=c(60, 100), overhang=4, rlen=50, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1          2          1    152           3    101
2          6          3     88           1    269
3          8          1     79           2    708
4          8          1    142           3    618
5          9          1     55           0    683
6          9          6     39           1    194
> comp(fname, npairs=200, size=c(60, 100), overhang=2, rlen=50, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1          2          1    135           3    132
2          3          1     67           3    158
3         10          3    116           2    614
4         10          5    114           1    436
5         12          3     23           3    756
6         12          7     91           1    413
> comp(fname, npairs=500, size=c(60, 100), overhang=2, rlen=50, max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1          4          2     73           3    201
2          5          4     76           3     93
3          6          1     74           2    450
4          7          2     52           1    336
5          7          4     74           1    203
6          8          8     99           0     69
> 
> # Trying it out with some more elements in a more restricted space.
> 
> comp(fname, npairs=500, size=c(100, 500), max.cuts=c(chrA=2L))
  anchor1.id anchor2.id length orientation insert
1          1          1    244           3    166
2          1          1    365           0    305
3          1          1    540           0     32
4          1          1    313           3    189
5          1          1    554           0    150
6          1          1    389           0    153
> comp(fname, npairs=200, size=c(500, 1000), max.cuts=c(chrA=2L, chrB=1L))
  anchor1.id anchor2.id length orientation insert
1          1          1   1044           0    104
2          1          1    999           3     51
3          1          1    454           0    436
4          1          1    848           3    344
5          1          1    265           0     31
6          1          1    892           3     50
> comp(fname, npairs=1000, size=c(20, 50), max.cuts=c(chrA=1L))
  anchor1.id anchor2.id length orientation insert
1          1          1     32           0     18
2          1          1     58           3     32
3          1          1     25           0     29
4          1          1     51           3     11
5          1          1     46           0     12
6          1          1     48           3     14
> 
> # Adding lots of chromosomes.
> 
> max.cuts<-c(chrA=5L, chrB=6L, chrC=7L, chrD=4L, chrE=3L, chrF=1L, chrG=2L)
> comp(fname, npairs=200, size=c(500, 1000), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          3          3    976           0    144
> comp(fname, npairs=1000, size=c(50, 100), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          2          2     61           3     23
2          2          2     46           0     48
3          2          2    100           3     50
4          3          1     39           0    191
5          3          1    107           0    245
6          3          1     88           2    178
> comp(fname, npairs=200, size=c(100, 500), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          3          1    156           1    372
2          3          1    153           2    422
3          4          3    218           0    143
4          5          2    248           0    520
5          5          3    303           2    323
> comp(fname, npairs=1000, size=c(200, 300), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1          3          1    230           0    714
2          3          1    166           1    412
3          3          2    250           0    370
4          3          3    128           3     30
5          4          1    186           0    625
6          4          1    375           1    857
> 
> max.cuts<-c(chrD=5L, chrC=6L, chrA=7L, chrE=4L, chrG=3L, chrB=1L, chrF=2L) # Shuffled, to test effect of non-trivial 'm'.
> comp(fname, npairs=200, size=c(500, 1000), max.cuts=max.cuts)
  anchor1.id anchor2.id length orientation insert
1         15         14    551           2    794
2         16         16    183           3     15
3         18         13    528           1   2914
4         18         13    808           3   2642
> comp(fname, npairs=1000, size=c(50, 100), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1         13         13     73           0     45
2         14         12     86           2    167
3         14         12     39           3    165
4         14         12    127           0    115
5         14         13     77           2    107
6         14         13    110           3     63
> comp(fname, npairs=200, size=c(100, 500), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1         12          6    242           0     NA
2         12         11    267           2     NA
3         13         11    370           0     NA
4         14         10     52           3     NA
5         15          9    147           1     NA
6         15         10     51           1     NA
> comp(fname, npairs=1000, size=c(200, 300), max.cuts=max.cuts);
  anchor1.id anchor2.id length orientation insert
1         13         12    290           2    308
2         14         12    351           1    639
3         14         12    485           0    584
4         15         12    141           1    724
5         15         12    184           3    965
6         16         12    489           0   1220
> 
> # Checking results with pseudo-ness
> max.cuts<-c(chrA=20L, chrB=10L, chrC=5L)
> comp(fname, npairs=20, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(100, 100))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           3    145
2          0          0     NA           3    860
> comp(fname, npairs=50, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(100, 100))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           2    759
2          0          0     NA           0   1397
3          0          0     NA           1   1472
4          0          0     NA           3    700
5          0          0     NA           0   1347
> comp(fname, npairs=100, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(100, 100))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           2    298
2          0          0     NA           1    307
3          0          0     NA           1    276
4          0          0     NA           2    506
5          0          0     NA           3    314
6          0          0     NA           2    194
> comp(fname, npairs=100, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(200, 200))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           1    380
2          0          0     NA           3   2629
3          0          0     NA           3   1361
4          0          0     NA           0    905
5          0          0     NA           3   2711
6          0          0     NA           1   1292
> comp(fname, npairs=1000, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(500, 500))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           0   1851
2          0          0     NA           1   3408
3          0          0     NA           0   3025
4          0          0     NA           3    591
5          0          0     NA           3   9115
6          0          0     NA           2   5464
> 
> max.cuts<-c(chrB=20L, chrC=10L, chrA=5L) # Shuffled
> comp(fname, npairs=20, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(100, 100))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           2     NA
2          0          0     NA           0     NA
3          0          0     NA           2     NA
4          0          0     NA           3     NA
5          0          0     NA           0     NA
6          0          0     NA           1     NA
> comp(fname, npairs=50, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(100, 100))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           1    141
2          0          0     NA           2     65
3          0          0     NA           2    321
4          0          0     NA           1    301
5          0          0     NA           2    452
6          0          0     NA           3    132
> comp(fname, npairs=100, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(100, 100))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           0    236
2          0          0     NA           0    193
3          0          0     NA           1    226
4          0          0     NA           1     76
5          0          0     NA           0     60
6          0          0     NA           2    162
> comp(fname, npairs=100, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(200, 200))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           0    254
2          0          0     NA           3    240
3          0          0     NA           3    256
4          0          0     NA           0    342
5          0          0     NA           3    494
6          0          0     NA           2    254
> comp(fname, npairs=1000, max.cuts=max.cuts, pseudo=TRUE, overhang=0, sizes=c(500, 500))
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           1   1971
2          0          0     NA           2     29
3          0          0     NA           1    565
4          0          0     NA           1     21
5          0          0     NA           1    349
6          0          0     NA           2    831
> 
> # Checking what happens when I add more or less chromosomes 
> 
> max.cuts<-c(chrA=20L, chrB=10L)
> comp(fname, npairs=20, max.cuts=max.cuts, overhang=0, sizes=c(100, 100), extras="chrX") # should work
  anchor1.id anchor2.id length orientation insert
1         13          6     56           2    764
2         13          9    154           0    374
3         18         11    127           3    773
4         19          9    123           0    981
> comp(fname, npairs=20, max.cuts=max.cuts, overhang=0, sizes=c(100, 100), extras="chrX", pseudo=TRUE)
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           3   1418
2          0          0     NA           1   1713
3          0          0     NA           1    781
4          0          0     NA           0   1766
5          0          0     NA           2   1613
6          0          0     NA           3     73
> try({
+     comp(fname, npairs=20, max.cuts=max.cuts, overhang=0, sizes=c(100, 100), extras=-1L)  # fails due to removal of first chromosome.
+ })
Error in preparePairs(out, param, tmpdir, output.dir = file.path(dir,  : 
  missing chromosomes in cut site list
> try({
+     comp(fname, npairs=20, max.cuts=max.cuts, overhang=0, sizes=c(100, 100), extras=-1L, pseudo=TRUE)
+ })
Error in .prepFreePairs(bam = bam, fragments = fragments, file = file,  : 
  missing chromosomes in cut site list
> 
> # Throwing more than 5000 read pairs in, to check that it still behaves past the 5000 read pair threshold for file dumping. 
> max.cuts<-c(chrA=20L, chrB=10L)
> comp(fname, npairs=10000, max.cuts=max.cuts, sizes=c(50, 100))
  anchor1.id anchor2.id length orientation insert
1          1          1     81           3     21
2          1          1     50           3     40
3          1          1     25           3     15
4          1          1     43           0     39
5          2          1     95           2     53
6          2          1     99           2     49
> comp(fname, npairs=10000, max.cuts=max.cuts, overhang=0, sizes=c(100, 100), pseudo=TRUE) 
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           2    800
2          0          0     NA           2   1399
3          0          0     NA           1   1826
4          0          0     NA           2   1745
5          0          0     NA           0   1384
6          0          0     NA           0    779
> comp(fname, npairs=10000, max.cuts=max.cuts, sizes=c(50, 100), storage=10) # Also checking that it does the same when we turn down the storage.
  anchor1.id anchor2.id length orientation insert
1          1          1    134           3     40
2          1          1     73           0     19
3          1          1    110           0     16
4          2          1     48           3     54
5          2          1     31           0     61
6          2          1     31           0     75
> comp(fname, npairs=10000, max.cuts=max.cuts, overhang=0, sizes=c(100, 100), pseudo=TRUE, storage=10) 
  anchor1.id anchor2.id length orientation insert
1          0          0     NA           1    637
2          0          0     NA           2    175
3          0          0     NA           1    589
4          0          0     NA           1   1496
5          0          0     NA           1    531
6          0          0     NA           1   1723
> 
> ###################################################################################################
> # Trying to do simulations with chimeras is hellishly complicated, so we're just going to settle for 
> # consideration of chimeras with a fixed example.
> 
> hic.file<-system.file("exdata", "hic_sort.bam", package="diffHic")
> break.file<-system.file("exdata", "cuts.rds", package="diffHic")
> cuts<-readRDS(break.file)
> param <- pairParam(cuts)
> tmpdir<-file.path(dir, "gunk")
> cntdir<-file.path(dir, "gunkcount")
> 
> # Setting up a function to name all read pairs based on their position, length and strand.
> 
> what <- c("qname", "rname", "pos", "qwidth", "strand")
> first.read <- Rsamtools::scanBam(hic.file, param=ScanBamParam(flag=scanBamFlag(isPaired=TRUE, isFirstMateRead=TRUE, isSecondary=FALSE), what=what))[[1]]
> second.read <- Rsamtools::scanBam(hic.file, param=ScanBamParam(flag=scanBamFlag(isPaired=TRUE, isFirstMateRead=FALSE, isSecondary=FALSE), what=what))[[1]]
> fchar <- paste(first.read$rname, first.read$pos, first.read$strand, first.read$qwidth, sep=".")
> schar <- paste(second.read$rname, second.read$pos, second.read$strand, second.read$qwidth, sep=".")
> fqnames <- first.read$qname
> sqnames <- second.read$qname
> 
> namefun <- function(extracted) {
+     xchar <- paste(seqnames(cuts[as.vector(extracted$anchor1.id)]), extracted$anchor1.pos, 
+                    ifelse(extracted$anchor1.len > 0, "+", "-"), abs(extracted$anchor1.len), sep=".")
+     ychar <- paste(seqnames(cuts[as.vector(extracted$anchor2.id)]), extracted$anchor2.pos, 
+                    ifelse(extracted$anchor2.len > 0, "+", "-"), abs(extracted$anchor2.len), sep=".")
+ 
+     output <- integer(nrow(extracted))    
+     for (i in seq_len(nrow(extracted))) {
+         curx <- xchar[i]
+         cury <- ychar[i]
+         m <- (fchar %in% curx & schar %in% cury) | (fchar %in% cury & schar %in% curx) 
+         stopifnot(sum(m)==1L)
+         output[i] <- which(m)
+     }
+ 
+     my.names <- fqnames[output]
+     stopifnot(identical(my.names, sqnames[output]))
+     return(my.names)
+ }
> 
> printfun<-function(dir) {
+ 	output<-list()
+ 	ix <- 1L
+ 	indices <- suppressWarnings(diffHic:::preloader(tmpdir))
+ 	for (ax in names(indices)) {
+ 		if (is.null(output[[ax]])) { output[[ax]]<-list() }
+ 		for (tx in names(indices[[ax]])) {
+ 			extracted <- h5read(dir, file.path(ax, tx))
+ 			processed <- diffHic:::.getStats(extracted, ax==tx, cuts)
+ 			output[[ax]][[tx]] <- data.frame(anchor1.id=extracted$anchor1.id, anchor2.id=extracted$anchor2.id,
+ 				length=processed$length, orientation=processed$orientation, insert=processed$insert)
+             rownames(output[[ax]][[tx]]) <- namefun(extracted)
+ 			ix <- ix + 1L
+ 		}
+ 	}
+ 	return(output)
+ }
> 
> # We also have 3 unmapped reads, 5 dangling ends, 2 self-circles, 2 singletons.
> # For chimeras, all have mapped 5' and 3' ends, 7 of which are invalid.
> 
> preparePairs(hic.file, param, tmpdir, dedup=FALSE)
$pairs
   total   marked filtered   mapped 
      32        7        3       29 

$same.id
   dangling self.circle 
          5           2 

$singles
[1] 2

$chimeras
  total  mapped   multi invalid 
     12      12      12       7 

> printfun(tmpdir)
$chrA
$chrA$chrA
                   anchor1.id anchor2.id length orientation insert
chimeric.invalid.5          2          1     40           1     40
good.1                      2          1     80           1     80
good.2                      2          1     60           2     54
good.3                      4          1     40           3    160
chimeric.invalid.4          4          2     20           1     66
good.4                      4          2     80           0    114
chimeric.invalid.6          4          3     10           1     10
other.1                     4          4     65           0     35


$chrB
$chrB$chrA
                   anchor1.id anchor2.id length orientation insert
good.8                      5          2     10           2     NA
good.5                      5          3     30           2     NA
chimeric.good.4             5          4     30           2     NA
chimeric.good.5             5          4     25           0     NA
chimeric.good.1             6          1     35           0     NA
chimeric.invalid.2          6          2     10           1     NA
chimeric.invalid.1          6          3     10           1     NA
chimeric.invalid.3          6          3     20           3     NA
chimeric.invalid.7          6          3     15           3     NA
chimeric.good.2             7          3     20           1     NA

$chrB$chrB
                anchor1.id anchor2.id length orientation insert
good.7                   6          5     25           2     64
good.6                   7          5     35           3     84
chimeric.good.3          7          6     10           1     10
other.2                  7          7     30           3     10


> 
> # Alright, so once duplicates are removed, we lose:
> #  	self.1 (--mapped/self.circles)
> #   other.1 (--mapped/other)	
> #   dangling.1 (--mapped/dangling)
> #   chimeric.good.2 (--mapped/chimeric$mapped/multi)
> #	chimeric.invalid.1 (--mapped/chimeric$mapped/multi/invalid)
> #   chimeric.invalid.4 (--chimeric$multi/invalid)
> #	chimeric.good.4 (--mapped/chimeric$mapped/multi)
> #	chimeric.good.5 (--mapped/chimeric$mapped/multi)
> #
> # So, a loss of -7 to mapped, a loss of -1 to each of dangling and self.circles, 
> # a loss of -4 to chimeric$mapped, -5 to  chimeric$multi and -2 to chimeric$invalid. 
> #
> # Note that this will be considered the reference to which all downstream
> # tests are compared, as dedup=TRUE is the default setting.
> 
> tmpdir2<-file.path(dir, "gunk2")
> preparePairs(hic.file, param, tmpdir2)
$pairs
   total   marked filtered   mapped 
      32        7        3       22 

$same.id
   dangling self.circle 
          4           1 

$singles
[1] 2

$chimeras
  total  mapped   multi invalid 
     12       8       7       5 

> printfun(tmpdir2)
$chrA
$chrA$chrA
                   anchor1.id anchor2.id length orientation insert
chimeric.invalid.5          2          1     40           1     40
good.1                      2          1     80           1     80
good.2                      2          1     60           2     54
good.3                      4          1     40           3    160
chimeric.invalid.4          4          2     20           1     66
good.4                      4          2     80           0    114
chimeric.invalid.6          4          3     10           1     10


$chrB
$chrB$chrA
                   anchor1.id anchor2.id length orientation insert
good.8                      5          2     10           2     NA
good.5                      5          3     30           2     NA
chimeric.good.1             6          1     35           0     NA
chimeric.invalid.2          6          2     10           1     NA
chimeric.invalid.3          6          3     20           3     NA
chimeric.invalid.7          6          3     15           3     NA

$chrB$chrB
                anchor1.id anchor2.id length orientation insert
good.7                   6          5     25           2     64
good.6                   7          5     35           3     84
chimeric.good.3          7          6     10           1     10
other.2                  7          7     30           3     10


> 
> # Once invalid chimeras are removed, we see a loss of all rows corresponding to
> # invalid chimeras in printfun. No change in the statistics should be observed.
> # Note that chimeric.invalid.4 is still okay as ther invalid component is removed
> # by duplicate removal (for some reason; that shouldn't happen in real data).
> 
> preparePairs(hic.file, param, tmpdir2, ichim=FALSE)
$pairs
   total   marked filtered   mapped 
      32        7        3       22 

$same.id
   dangling self.circle 
          4           1 

$singles
[1] 2

$chimeras
  total  mapped   multi invalid 
     12       8       7       5 

> printfun(tmpdir2)
$chrA
$chrA$chrA
                   anchor1.id anchor2.id length orientation insert
good.1                      2          1     80           1     80
good.2                      2          1     60           2     54
good.3                      4          1     40           3    160
chimeric.invalid.4          4          2     20           1     66
good.4                      4          2     80           0    114


$chrB
$chrB$chrA
                anchor1.id anchor2.id length orientation insert
good.8                   5          2     10           2     NA
good.5                   5          3     30           2     NA
chimeric.good.1          6          1     35           0     NA

$chrB$chrB
                anchor1.id anchor2.id length orientation insert
good.7                   6          5     25           2     64
good.6                   7          5     35           3     84
chimeric.good.3          7          6     10           1     10
other.2                  7          7     30           3     10


> 
> # Throwing out those with poor mapping quality. We lose:
> #   good.1 (mapped -> filtered)
> #   good.3 (mapped -> filtered)
> #   dangling.2 (mapped/dangling -> filtered)
> #   dangling.3 (mapped/dangling -> filtered)
> #   chimeric.good.1 (--chimeric$multi)
> #	chimeric.invalid.2 (mapped/chimeric$mapped/multi/invalid -> filtered)
> #   chimeric.invalid.3 (--chimeric$multi/invalid)
> # 	chimeric.invalid.6 (mapped/chimeric$mapped/multi/invalid -> filtered)
> #
> # So, a gain of +6 for filtered, a loss of -6 for mapped, a loss of -2
> # for dangling, a loss of -2 for chimeric$mapped, -4 for chimeric$multi
> # and -3 for chimeric$invalid. For printfun, we see:
> # 	A/A = chimeric.invalid.5, good.2, chimeric.invalid.4, good.4
> #	B/A = good.8, good.5, chimeric.good.1, chimeric.invalid.3, chimeric.invalid.7
> # 	B/B = good.7, good.6, chimeric.good.3, other.2
> 
> preparePairs(hic.file, param, tmpdir2, minq=100)
$pairs
   total   marked filtered   mapped 
      32        7        9       16 

$same.id
   dangling self.circle 
          2           1 

$singles
[1] 2

$chimeras
  total  mapped   multi invalid 
     12       6       3       2 

> printfun(tmpdir2)
$chrA
$chrA$chrA
                   anchor1.id anchor2.id length orientation insert
chimeric.invalid.5          2          1     40           1     40
good.2                      2          1     60           2     54
chimeric.invalid.4          4          2     20           1     66
good.4                      4          2     80           0    114


$chrB
$chrB$chrA
                   anchor1.id anchor2.id length orientation insert
good.8                      5          2     10           2     NA
good.5                      5          3     30           2     NA
chimeric.good.1             6          1     35           0     NA
chimeric.invalid.3          6          3     20           3     NA
chimeric.invalid.7          6          3     15           3     NA

$chrB$chrB
                anchor1.id anchor2.id length orientation insert
good.7                   6          5     25           2     64
good.6                   7          5     35           3     84
chimeric.good.3          7          6     10           1     10
other.2                  7          7     30           3     10


> 
> # Defining invalid chimeras based on distance instead of fragment ID. chimeric.good.1
> # becomes an invalid chimera, as the distance between the 3' segment and the mate is
> # 30 bp. This results in a +1 increase for invalid.chim.
> 
> preparePairs(hic.file, param, tmpdir2, chim.dist=20, ichim=FALSE)
$pairs
   total   marked filtered   mapped 
      32        7        3       22 

$same.id
   dangling self.circle 
          4           1 

$singles
[1] 2

$chimeras
  total  mapped   multi invalid 
     12       8       7       6 

> printfun(tmpdir2)
$chrA
$chrA$chrA
                   anchor1.id anchor2.id length orientation insert
good.1                      2          1     80           1     80
good.2                      2          1     60           2     54
good.3                      4          1     40           3    160
chimeric.invalid.4          4          2     20           1     66
good.4                      4          2     80           0    114


$chrB
$chrB$chrA
       anchor1.id anchor2.id length orientation insert
good.8          5          2     10           2     NA
good.5          5          3     30           2     NA

$chrB$chrB
                anchor1.id anchor2.id length orientation insert
good.7                   6          5     25           2     64
good.6                   7          5     35           3     84
chimeric.good.3          7          6     10           1     10
other.2                  7          7     30           3     10


> 
> # chimeric.invalid.6 now becomes a valid chimera, as each pair of 5' end and 3' mate end
> # is now a proper pair (inward-facing and less than chim.dist). The same applies for
> # chimeric.invalid.7. -2 for invalid.chim.
> 
> preparePairs(hic.file, param, tmpdir2, chim.dist=2000, ichim=FALSE)
$pairs
   total   marked filtered   mapped 
      32        7        3       22 

$same.id
   dangling self.circle 
          4           1 

$singles
[1] 2

$chimeras
  total  mapped   multi invalid 
     12       8       7       3 

> printfun(tmpdir2)
$chrA
$chrA$chrA
                   anchor1.id anchor2.id length orientation insert
good.1                      2          1     80           1     80
good.2                      2          1     60           2     54
good.3                      4          1     40           3    160
chimeric.invalid.4          4          2     20           1     66
good.4                      4          2     80           0    114
chimeric.invalid.6          4          3     10           1     10


$chrB
$chrB$chrA
                   anchor1.id anchor2.id length orientation insert
good.8                      5          2     10           2     NA
good.5                      5          3     30           2     NA
chimeric.good.1             6          1     35           0     NA
chimeric.invalid.7          6          3     15           3     NA

$chrB$chrB
                anchor1.id anchor2.id length orientation insert
good.7                   6          5     25           2     64
good.6                   7          5     35           3     84
chimeric.good.3          7          6     10           1     10
other.2                  7          7     30           3     10


> 
> ###################################################################################################
> # This tests what happens with chimeras where one of the segments is unmapped. This requires some
> # care because unmapped reads don't get CIGAR strings, which makes diagnosing 5' behaviour difficult.
> 
> generator <- function(cig1, cig2, cig3, cig4) {
+     mapped <- "chrA 100"
+     unmapped <- "* 0"
+     out <- sprintf("@HD VN:1.3  SO:queryname
+ @SQ SN:chrA LN:200
+ x1 %i %s 200 %s * 0 0 NNNNN hhhhh
+ x1 %i %s 200 %s * 0 0 NNNNN hhhhh
+ x1 %i %s 200 %s * 0 0 NNNNN hhhhh
+ x1 %i %s 200 %s * 0 0 NNNNN hhhhh",
+     1+64 +ifelse(cig1=="*", 4, 0),     ifelse(cig1!="*", mapped, unmapped), cig1,
+     1+64 +ifelse(cig2=="*", 4, 0)+256, ifelse(cig2!="*", mapped, unmapped), cig2,
+     1+128+ifelse(cig3=="*", 4, 0),     ifelse(cig3!="*", mapped, unmapped), cig3,
+     1+128+ifelse(cig4=="*", 4, 0)+256, ifelse(cig4!="*", mapped, unmapped), cig4)
+     return(gsub(" +", "\t", out))
+ }
> fout <- file.path(dir, "umap.sam")
> 
> # None of these should show up as a pair.
> for (scenario in list(list("*", "*", "*", "*"),
+                       list("5M5H", "*", "*", "*"),
+                       list("*", "*", "5M5H", "*"),
+                       list("*", "*", "*", "5H5M"),
+                       list("*", "5H5M", "5M5H", "*"),
+                       list("5M5H", "*", "*", "5H5M"))) {
+     writeLines(do.call(generator, scenario), con=fout)
+     sout <- Rsamtools::asBam(fout, file.path(dir, "umap"), overwrite=TRUE)
+     x <- preparePairs(sout, param=pairParam(GRanges("chrA", IRanges(c(1, 71), c(70, 200)))), file=file.path(dir, "whee.h5"))
+     stopifnot(x$pairs[["total"]]==1L)
+     stopifnot(x$pairs[["filtered"]]==1L)
+     stopifnot(x$chimeras[["total"]]==1L)
+     stopifnot(x$chimeras[["mapped"]]==0L)
+ }
> 
> # All of these should show up as a pair.
> writeLines(generator("5M5H", "*", "5M5H", "*"), con=fout)
> sout <- Rsamtools::asBam(fout, file.path(dir, "umap"), overwrite=TRUE)
> x <- preparePairs(sout, param=pairParam(GRanges("chrA", IRanges(c(1, 71), c(70, 200)))), file=file.path(dir, "whee.h5"))
> stopifnot(x$pairs[["total"]]==1L)
> stopifnot(x$pairs[["mapped"]]==1L)
> stopifnot(x$chimeras[["total"]]==1L)
> stopifnot(x$chimeras[["mapped"]]==1L)
> stopifnot(x$chimeras[["multi"]]==0L)
> 
> for (scenario in list(list("5M5H", "5H5M", "5M5H", "*"),
+                       list("5M5H", "*", "5M5H", "5H5M"),
+                       list("5M5H", "5H5M", "5M5H", "5H5M"))) {
+     writeLines(do.call(generator, scenario), con=fout)
+     sout <- Rsamtools::asBam(fout, file.path(dir, "umap"), overwrite=TRUE)
+     x <- preparePairs(sout, param=pairParam(GRanges("chrA", IRanges(c(1, 71), c(70, 200)))), file=file.path(dir, "whee.h5"))
+     stopifnot(x$pairs[["total"]]==1L)
+     stopifnot(x$pairs[["mapped"]]==1L)
+     stopifnot(x$chimeras[["total"]]==1L)
+     stopifnot(x$chimeras[["mapped"]]==1L)
+     stopifnot(x$chimeras[["multi"]]==1L)
+ }
> 
> ###################################################################################################
> 
> unlink(dir, recursive=TRUE) # Cleaning up
> 
> ###################################################################################################
> 
> 
> proc.time()
   user  system elapsed 
 19.996   0.368  20.382 
