@@ -7,7 +7,7 @@ Author: Aaron Taudt, Bjorn Bakker, David Porubsky

 Maintainer: Aaron Taudt <aaron.taudt@gmail.com>

 Description: This package implements functions for CNV calling, plotting, export and analysis from whole-genome single cell sequencing data.

 Depends: R (>= 3.1.0), GenomicRanges, cowplot

-Imports: foreach, doParallel, BiocGenerics, IRanges, Rsamtools, Biostrings, GenomicAlignments, preseqR, reshape2, ggdendro, ReorderCluster, mclust

+Imports: foreach, doParallel, GenomeInfoDb, BiocGenerics, IRanges, Rsamtools, Biostrings, GenomicAlignments, preseqR, reshape2, ggdendro, ReorderCluster, mclust

 Suggests: knitr, testthat

 License: file LICENSE

 LazyLoad: yes

@@ -6,7 +6,7 @@ S3method(plot,aneuHMM)

 S3method(plot,character)

 export(Aneufinder)

 export(bam2binned)

-export(bed2GRanges)

+export(bed2binned)

 export(clusterByQuality)

 export(concGRangesInRange)

 export(correctGC)

@@ -22,13 +22,16 @@ export(getSCEcoordinates)

 export(heatmapAneuploidies)

 export(heatmapGenomewide)

 export(hotspotter)

+export(importBed)

 export(karyotypeMeasures)

 export(loadGRangesFromFiles)

 export(loadHmmsFromFiles)

+export(simulateReads)

 export(smoothBinning)

 export(stateColors)

 export(strandColors)

 export(subsetByCNVprofile)

+export(variableWidthBins)

 import(GenomicRanges)

 import(IRanges)

 import(cowplot)

@@ -38,8 +41,12 @@ import(ggdendro)

 import(preseqR)

 import(reshape2)

 importFrom(BiocGenerics,as.vector)

+importFrom(Biostrings,BString)

+importFrom(Biostrings,BStringSet)

+importFrom(Biostrings,DNAStringSet)

 importFrom(Biostrings,Views)

 importFrom(Biostrings,alphabetFrequency)

+importFrom(GenomeInfoDb,fetchExtendedChromInfoFromUCSC)

 importFrom(GenomicAlignments,first)

 importFrom(GenomicAlignments,readGAlignmentPairsFromBam)

 importFrom(GenomicAlignments,readGAlignmentsFromBam)

@@ -113,7 +113,7 @@ doParallel::registerDoParallel(cl)

 if (!file.exists(binpath.uncorrected)) { dir.create(binpath.uncorrected) }

 files <- list.files(inputfolder, full.names=TRUE, recursive=TRUE, pattern=paste0('.',conf[['format']],'$'))

 ### Binning ###

-message("Binning the data ...", appendLF=FALSE); ptm <- proc.time()

+ptm <- startTimedMessage("Binning the data ...")

 temp <- foreach (file = files, .packages=c('aneufinder')) %dopar% {

 	existing.binfiles <- grep(basename(file), list.files(binpath.uncorrected), value=TRUE)

 	existing.binsizes <- as.numeric(unlist(lapply(strsplit(existing.binfiles, split='binsize_|_reads.per.bin_|_\\.RData'), '[[', 2)))

@@ -143,10 +143,10 @@ temp <- foreach (file = files, .packages=c('aneufinder')) %dopar% {

 		})

 	}

 }

-time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+stopTimedMessage(ptm)

 ### Export read fragments as browser file ###

-message("Exporting data as browser files ...", appendLF=FALSE); ptm <- proc.time()

+ptm <- startTimedMessage("Exporting data as browser files ...")

 if (!file.exists(readsbrowserpath)) { dir.create(readsbrowserpath) }

 readfiles <- list.files(readspath,pattern='.RData$',full.names=TRUE)

 temp <- foreach (file = readfiles, .packages=c('aneufinder')) %dopar% {

@@ -160,14 +160,14 @@ temp <- foreach (file = readfiles, .packages=c('aneufinder')) %dopar% {

 		})

 	}

 }

-time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+stopTimedMessage(ptm)

 #=================

 ### Correction ###

 #=================

 if (!is.null(conf[['correction.method']])) {

-	message(paste0(conf[['correction.method']]," correction ..."), appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage(paste0(conf[['correction.method']]," correction ..."))

 	if (conf[['correction.method']]=='GC') {

 		binpath.corrected <- file.path(outputfolder,'binned_GC-corrected')

 		if (!file.exists(binpath.corrected)) { dir.create(binpath.corrected) }

@@ -202,7 +202,7 @@ if (!is.null(conf[['correction.method']])) {

 		}

 		binpath <- binpath.corrected

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 } else {

 	binpath <- binpath.uncorrected

@@ -213,7 +213,7 @@ if (!is.null(conf[['correction.method']])) {

 #===============

 if ('univariate' %in% conf[['method']]) {

-	message("Running univariate HMMs ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Running univariate HMMs ...")

 	if (!file.exists(CNVpath)) { dir.create(CNVpath) }

 	files <- list.files(binpath, full.names=TRUE, recursive=TRUE, pattern='.RData$')

@@ -228,7 +228,7 @@ if ('univariate' %in% conf[['method']]) {

 			stop(file,'\n',err)

 		})

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#===================

 	### Plotting CNV ###

@@ -241,7 +241,7 @@ if ('univariate' %in% conf[['method']]) {

 	#-----------------------

 	## Plot distributions ##

 	#-----------------------

-	message("Plotting distributions ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Plotting distributions ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		savename <- file.path(CNVplotpath,paste0('distributions_',sub('_$','',pattern),'.pdf'))

 		if (!file.exists(savename)) {

@@ -259,11 +259,11 @@ if ('univariate' %in% conf[['method']]) {

 			d <- dev.off()

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#------------------

 	## Plot heatmaps ##

 	#------------------

-	message("Plotting genomewide heatmaps ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Plotting genomewide heatmaps ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		ifiles <- list.files(CNVpath, pattern='RData$', full.names=TRUE)

 		ifiles <- grep(gsub('\\+','\\\\+',pattern), ifiles, value=TRUE)

@@ -276,8 +276,8 @@ if ('univariate' %in% conf[['method']]) {

 			warning("Plotting genomewide heatmaps: No files for pattern ",pattern," found.")

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

-	message("Plotting chromosome heatmaps ...", appendLF=FALSE); ptm <- proc.time()

+	stopTimedMessage(ptm)

+	ptm <- startTimedMessage("Plotting chromosome heatmaps ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		ifiles <- list.files(CNVpath, pattern='RData$', full.names=TRUE)

 		ifiles <- grep(gsub('\\+','\\\\+',pattern), ifiles, value=TRUE)

@@ -293,11 +293,11 @@ if ('univariate' %in% conf[['method']]) {

 			warning("Plotting chromosome heatmaps: No files for pattern ",pattern," found.")

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#------------------

 	## Plot arrayCGH ##

 	#------------------

-	message("Making arrayCGH plots ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Making arrayCGH plots ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		savename <- file.path(CNVplotpath,paste0('arrayCGH_',sub('_$','',pattern),'.pdf'))

 		if (!file.exists(savename)) {

@@ -315,11 +315,11 @@ if ('univariate' %in% conf[['method']]) {

 			d <- dev.off()

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#--------------------

 	## Plot karyograms ##

 	#--------------------

-	message("Plotting karyograms ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Plotting karyograms ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		savename <- file.path(CNVplotpath,paste0('karyograms_',sub('_$','',pattern),'.pdf'))

 		if (!file.exists(savename)) {

@@ -337,11 +337,11 @@ if ('univariate' %in% conf[['method']]) {

 			d <- dev.off()

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#-------------------------

 	## Export browser files ##

 	#-------------------------

-	message("Exporting browser files ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Exporting browser files ...")

 	if (!file.exists(CNVbrowserpath)) { dir.create(CNVbrowserpath) }

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		savename <- file.path(CNVbrowserpath,sub('_$','',pattern))

@@ -351,7 +351,7 @@ if ('univariate' %in% conf[['method']]) {

 			exportCNVs(ifiles, filename=savename, cluster=conf[['cluster.plots']], export.CNV=TRUE, export.SCE=FALSE)

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 }

 #===============

@@ -359,7 +359,7 @@ if ('univariate' %in% conf[['method']]) {

 #===============

 if ('bivariate' %in% conf[['method']]) {

-	message("Running bivariate HMMs ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Running bivariate HMMs ...")

 	if (!file.exists(SCEpath)) { dir.create(SCEpath) }

 	files <- list.files(binpath, full.names=TRUE, recursive=TRUE, pattern='.RData$')

@@ -371,24 +371,24 @@ if ('bivariate' %in% conf[['method']]) {

 				## Add SCE coordinates to model

 				reads.file <- file.path(readspath, paste0(model$ID,'.RData'))

 				model$sce <- suppressMessages( getSCEcoordinates(model, resolution=conf[['resolution']], min.segwidth=conf[['min.segwidth']], fragments=reads.file, min.reads=conf[['min.reads']]) )

-				message("Saving to file ",savename," ...", appendLF=FALSE); ptm <- proc.time()

+				ptm <- startTimedMessage("Saving to file ",savename," ...")

 				save(model, file=savename)

-				time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+				stopTimedMessage(ptm)

 # 			} else {

 # 				model <- get(load(savename))

 # 				model$sce <- suppressMessages( getSCEcoordinates(model, resolution=conf[['resolution']], min.segwidth=conf[['min.segwidth']]) )

-# 				message("Saving to file ",savename," ...", appendLF=FALSE); ptm <- proc.time()

+# 				ptm <- startTimedMessage("Saving to file ",savename," ...")

 # 				save(model, file=savename)

-# 				time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+# 				stopTimedMessage(ptm)

 			}

 		}, error = function(err) {

 			stop(file,'\n',err)

 		})

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	### Finding hotspots ###

-	message("Finding SCE hotspots ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Finding SCE hotspots ...")

 	hotspots <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		ifiles <- list.files(SCEpath, pattern='RData$', full.names=TRUE)

 		ifiles <- grep(gsub('\\+','\\\\+',pattern), ifiles, value=TRUE)

@@ -401,7 +401,7 @@ if ('bivariate' %in% conf[['method']]) {

 		return(hotspot)

 	}

 	names(hotspots) <- patterns

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#===================

 	### Plotting SCE ###

@@ -414,7 +414,7 @@ if ('bivariate' %in% conf[['method']]) {

 	#-----------------------

 	## Plot distributions ##

 	#-----------------------

-	message("Plotting distributions ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Plotting distributions ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		savename <- file.path(SCEplotpath,paste0('distributions_',sub('_$','',pattern),'.pdf'))

 		if (!file.exists(savename)) {

@@ -432,11 +432,11 @@ if ('bivariate' %in% conf[['method']]) {

 			d <- dev.off()

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#------------------

 	## Plot heatmaps ##

 	#------------------

-	message("Plotting heatmaps ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Plotting heatmaps ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		ifiles <- list.files(SCEpath, pattern='RData$', full.names=TRUE)

 		ifiles <- grep(gsub('\\+','\\\\+',pattern), ifiles, value=TRUE)

@@ -464,11 +464,11 @@ if ('bivariate' %in% conf[['method']]) {

 			warning("Plotting chromosome heatmaps: No files for pattern ",pattern," found.")

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#------------------

 	## Plot arrayCGH ##

 	#------------------

-	message("Making arrayCGH plots ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Making arrayCGH plots ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		savename <- file.path(SCEplotpath,paste0('arrayCGH_',sub('_$','',pattern),'.pdf'))

 		if (!file.exists(savename)) {

@@ -486,11 +486,11 @@ if ('bivariate' %in% conf[['method']]) {

 			d <- dev.off()

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#--------------------

 	## Plot karyograms ##

 	#--------------------

-	message("Plotting karyograms ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Plotting karyograms ...")

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		savename <- file.path(SCEplotpath,paste0('karyograms_',sub('_$','',pattern),'.pdf'))

 		if (!file.exists(savename)) {

@@ -508,11 +508,11 @@ if ('bivariate' %in% conf[['method']]) {

 			d <- dev.off()

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 	#-------------------------

 	## Export browser files ##

 	#-------------------------

-	message("Exporting browser files ...", appendLF=FALSE); ptm <- proc.time()

+	ptm <- startTimedMessage("Exporting browser files ...")

 	if (!file.exists(SCEbrowserpath)) { dir.create(SCEbrowserpath) }

 	temp <- foreach (pattern = patterns, .packages=c('aneufinder')) %dopar% {

 		savename <- file.path(SCEbrowserpath,sub('_$','',pattern))

@@ -526,7 +526,7 @@ if ('bivariate' %in% conf[['method']]) {

 			exportGRanges(hotspots[[pattern]], filename=savename, trackname=basename(savename), score=hotspots[[pattern]]$num.events)

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+	stopTimedMessage(ptm)

 }

 stopCluster(cl)

@@ -18,14 +18,15 @@ NULL

 #' @describeIn binning Bin reads in BAM format

 #' @inheritParams align2binned

 #' @inheritParams bam2GRanges

+#' @param bamfile A file in BAM format. Alternatively a \code{\link{GRanges}} with aligned reads.

 #' @export

-bam2binned <- function(bamfile, bamindex=bamfile, ID=basename(bamfile), pairedEndReads=FALSE, max.fragment.width=1000, outputfolder.binned="binned_data", binsizes=NULL, reads.per.bin=NULL, stepsize=NULL, chromosomes=NULL, save.as.RData=FALSE, calc.complexity=TRUE, min.mapq=10, remove.duplicate.reads=TRUE, reads.store=FALSE, outputfolder.reads="data", reads.return=FALSE, reads.overwrite=FALSE, reads.only=FALSE) {

+bam2binned <- function(bamfile, bamindex=bamfile, ID=basename(bamfile), pairedEndReads=FALSE, max.fragment.width=1000, outputfolder.binned="binned_data", binsizes=NULL, variable.width.reference=NULL, reads.per.bin=NULL, stepsize=NULL, chromosomes=NULL, save.as.RData=FALSE, calc.complexity=TRUE, min.mapq=10, remove.duplicate.reads=TRUE, reads.store=FALSE, outputfolder.reads="data", reads.return=FALSE, reads.overwrite=FALSE, reads.only=FALSE) {

 	call <- match.call()

 	underline <- paste0(rep('=',sum(nchar(call[[1]]))+3), collapse='')

 	message("\n",call[[1]],"():")

 	message(underline)

 	ptm <- proc.time()

-	binned.data <- align2binned(bamfile, format="bam", ID=ID, bamindex=bamindex, pairedEndReads=pairedEndReads, max.fragment.width=max.fragment.width, outputfolder.binned=outputfolder.binned, binsizes=binsizes, reads.per.bin=reads.per.bin, stepsize=stepsize, chromosomes=chromosomes, save.as.RData=save.as.RData, calc.complexity=calc.complexity, min.mapq=min.mapq, remove.duplicate.reads=remove.duplicate.reads, call=call, reads.store=reads.store, outputfolder.reads=outputfolder.reads, reads.return=reads.return, reads.overwrite=reads.overwrite, reads.only=reads.only)

+	binned.data <- align2binned(bamfile, format="bam", assembly=NULL, ID=ID, bamindex=bamindex, pairedEndReads=pairedEndReads, max.fragment.width=max.fragment.width, outputfolder.binned=outputfolder.binned, binsizes=binsizes, variable.width.reference=variable.width.reference, reads.per.bin=reads.per.bin, stepsize=stepsize, chromosomes=chromosomes, save.as.RData=save.as.RData, calc.complexity=calc.complexity, min.mapq=min.mapq, remove.duplicate.reads=remove.duplicate.reads, call=call, reads.store=reads.store, outputfolder.reads=outputfolder.reads, reads.return=reads.return, reads.overwrite=reads.overwrite, reads.only=reads.only)

 	time <- proc.time() - ptm

 	message("Time spent in ", call[[1]],"(): ",round(time[3],2),"s")

 	return(binned.data)

@@ -33,14 +34,16 @@ bam2binned <- function(bamfile, bamindex=bamfile, ID=basename(bamfile), pairedEn

 #' @describeIn binning Bin reads in BED format

 #' @inheritParams align2binned

-#' @param bedfile A file in BED format.

-bed2binned <- function(bedfile, chrom.length.file, ID=basename(bedfile), outputfolder.binned="binned_data", binsizes=NULL, reads.per.bin=NULL, stepsize=NULL, chromosomes=NULL, save.as.RData=FALSE, calc.complexity=TRUE, min.mapq=10, remove.duplicate.reads=TRUE, reads.store=FALSE, outputfolder.reads="data", reads.return=FALSE, reads.overwrite=FALSE, reads.only=FALSE) {

+#' @inheritParams bed2GRanges

+#' @param bedfile A file in BED format. Alternatively a \code{\link{GRanges}} with aligned reads.

+#' @export

+bed2binned <- function(bedfile, assembly, ID=basename(bedfile), outputfolder.binned="binned_data", binsizes=NULL, variable.width.reference=NULL, reads.per.bin=NULL, stepsize=NULL, chromosomes=NULL, save.as.RData=FALSE, calc.complexity=TRUE, min.mapq=10, remove.duplicate.reads=TRUE, reads.store=FALSE, outputfolder.reads="data", reads.return=FALSE, reads.overwrite=FALSE, reads.only=FALSE) {

 	call <- match.call()

 	underline <- paste0(rep('=',sum(nchar(call[[1]]))+3), collapse='')

 	message("\n",call[[1]],"():")

 	message(underline)

 	ptm <- proc.time()

-	binned.data <- align2binned(bedfile, format="bed", ID=ID, chrom.length.file=chrom.length.file, outputfolder.binned=outputfolder.binned, binsizes=binsizes, reads.per.bin=reads.per.bin, stepsize=stepsize, chromosomes=chromosomes, save.as.RData=save.as.RData, calc.complexity=calc.complexity, min.mapq=min.mapq, remove.duplicate.reads=remove.duplicate.reads, call=call, reads.store=reads.store, outputfolder.reads=outputfolder.reads, reads.return=reads.return, reads.overwrite=reads.overwrite, reads.only=reads.only)

+	binned.data <- align2binned(bedfile, format="bed", assembly=assembly, ID=ID, outputfolder.binned=outputfolder.binned, binsizes=binsizes, variable.width.reference=variable.width.reference, reads.per.bin=reads.per.bin, stepsize=stepsize, chromosomes=chromosomes, save.as.RData=save.as.RData, calc.complexity=calc.complexity, min.mapq=min.mapq, remove.duplicate.reads=remove.duplicate.reads, call=call, reads.store=reads.store, outputfolder.reads=outputfolder.reads, reads.return=reads.return, reads.overwrite=reads.overwrite, reads.only=reads.only)

 	time <- proc.time() - ptm

 	message("Time spent in ", call[[1]],"(): ",round(time[3],2),"s")

 	return(binned.data)

@@ -50,13 +53,14 @@ bed2binned <- function(bedfile, chrom.length.file, ID=basename(bedfile), outputf

 #'

 #' Convert aligned reads in .bam or .bed format into read counts in equidistant windows.

 #'

-#' @param file A file with aligned reads.

+#' @param file A file with aligned reads. Alternatively a \code{\link{GRanges}} with aligned reads.

 #' @param format One of \code{c('bam', 'bed')}.

 #' @param ID An identifier that will be used to identify the file throughout the workflow and in plotting.

 #' @inheritParams bam2GRanges

-#' @param chrom.length.file A file which contains the chromosome lengths in basepairs. The first column contains the chromosome name and the second column the length (see also \code{\link{chrom.length.file}}).

+#' @inheritParams bed2GRanges

 #' @param outputfolder.binned Folder to which the binned data will be saved. If the specified folder does not exist, it will be created.

 #' @param binsizes An integer vector with bin sizes. If more than one value is given, output files will be produced for each bin size.

+#' @param variable.width.reference A BAM file that is used as reference to produce variable width bins. See \code{\link{variableWidthBins}} for details.

 #' @param reads.per.bin Approximate number of desired reads per bin. The bin size will be selected accordingly. Output files are produced for each value.

 #' @param stepsize Fraction of the binsize that the sliding window is offset at each step. Example: If \code{stepsize=0.1} and \code{binsizes=c(200000,500000)}, the actual stepsize in basepairs is 20000 and 50000, respectively.

 #' @param chromosomes If only a subset of the chromosomes should be binned, specify them here.

@@ -69,7 +73,7 @@ bed2binned <- function(bedfile, chrom.length.file, ID=basename(bedfile), outputf

 #' @param reads.overwrite Whether or not an existing file with read fragments should be overwritten.

 #' @param reads.only If \code{TRUE} only read fragments are stored and/or returned and no binning is done.

 #' @return The function produces a \link{GRanges} object with one meta data column 'reads' that contains the read count. This binned data will be either written to file (\code{save.as.RData=FALSE}) or given as return value (\code{save.as.RData=FALSE}).

-align2binned <- function(file, format, ID=basename(file), bamindex=file, chromosomes=NULL, pairedEndReads=FALSE, min.mapq=10, remove.duplicate.reads=TRUE, max.fragment.width=1000, chrom.length.file, outputfolder.binned="binned_data", binsizes=200000, reads.per.bin=NULL, stepsize=NULL, save.as.RData=FALSE, calc.complexity=TRUE, call=match.call(), reads.store=FALSE, outputfolder.reads="data", reads.return=FALSE, reads.overwrite=FALSE, reads.only=FALSE) {

+align2binned <- function(file, format, assembly, ID=basename(file), bamindex=file, chromosomes=NULL, pairedEndReads=FALSE, min.mapq=10, remove.duplicate.reads=TRUE, max.fragment.width=1000, outputfolder.binned="binned_data", binsizes=200000, variable.width.reference=NULL, reads.per.bin=NULL, stepsize=NULL, save.as.RData=FALSE, calc.complexity=TRUE, call=match.call(), reads.store=FALSE, outputfolder.reads="data", reads.return=FALSE, reads.overwrite=FALSE, reads.only=FALSE) {

 	## Check user input

 	if (reads.return==FALSE & reads.only==FALSE) {

@@ -83,32 +87,34 @@ align2binned <- function(file, format, ID=basename(file), bamindex=file, chromos

 		dir.create(outputfolder.binned)

 	}

-	### Read in the data

-	message("Reading file ",basename(file)," ...", appendLF=FALSE); ptm <- proc.time()

-	## BED (0-based)

-	if (format == "bed") {

-		# File with chromosome lengths (1-based)

-		chrom.lengths.df <- read.table(chrom.length.file)

-		chrom.lengths <- chrom.lengths.df[,2]

-		names(chrom.lengths) <- chrom.lengths.df[,1]

-		# File with reads, determine classes first for faster import (0-based)

-		tab5rows <- read.table(file, nrows=5)

-		classes.in.bed <- sapply(tab5rows, class)

-		classes <- rep("NULL",length(classes.in.bed))

-		classes[c(1:3,6)] <- classes.in.bed[c(1:3,6)]

-		data <- read.table(file, colClasses=classes)

-		# Convert to GRanges object

-		data <- GenomicRanges::GRanges(seqnames=Rle(data[,1]), ranges=IRanges(start=data[,2]+1, end=data[,3]), strand=Rle(strand("*"), nrow(data)))	# start+1 to go from [0,x) -> [1,x]

-		seqlengths(data) <- as.integer(chrom.lengths[names(seqlengths(data))])

-	## BAM (1-based)

-	} else if (format == "bam") {

-		if (calc.complexity || !remove.duplicate.reads) {

-			data <- suppressMessages( bam2GRanges(file, bamindex, chromosomes=chromosomes, pairedEndReads=pairedEndReads, remove.duplicate.reads=FALSE, min.mapq=min.mapq, max.fragment.width=max.fragment.width) )

-		} else {

-			data <- suppressMessages( bam2GRanges(file, bamindex, chromosomes=chromosomes, pairedEndReads=pairedEndReads, remove.duplicate.reads=TRUE, min.mapq=min.mapq, max.fragment.width=max.fragment.width) )

+	if (is.character(file)) {

+		### Read in the data

+		if (format == "bed") {

+			## BED (0-based)

+			if (calc.complexity || !remove.duplicate.reads) {

+				data <- bed2GRanges(file, assembly=assembly, chromosomes=chromosomes, remove.duplicate.reads=FALSE, min.mapq=min.mapq, max.fragment.width=max.fragment.width)

+			} else {

+				data <- bed2GRanges(file, assembly=assembly, chromosomes=chromosomes, remove.duplicate.reads=TRUE, min.mapq=min.mapq, max.fragment.width=max.fragment.width)

+			}

+		} else if (format == "bam") {

+			## BAM (1-based)

+			if (calc.complexity || !remove.duplicate.reads) {

+				data <- bam2GRanges(file, bamindex, chromosomes=chromosomes, pairedEndReads=pairedEndReads, remove.duplicate.reads=FALSE, min.mapq=min.mapq, max.fragment.width=max.fragment.width)

+			} else {

+				data <- bam2GRanges(file, bamindex, chromosomes=chromosomes, pairedEndReads=pairedEndReads, remove.duplicate.reads=TRUE, min.mapq=min.mapq, max.fragment.width=max.fragment.width)

+			}

+		}

+	} else if (is(file, 'GRanges')) {

+		data <- file

+		err <- tryCatch({

+			!is.character(ID)

+		}, error = function(err) {

+			TRUE

+		})

+		if (err) {

+			ID <- 'GRanges'

 		}

 	}

-	time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

 	## Select chromosomes to bin

 	if (is.null(chromosomes)) {

@@ -119,16 +125,18 @@ align2binned <- function(file, format, ID=basename(file), bamindex=file, chromos

 	### Complexity estimation ###

 	complexity <- NULL

 	if (calc.complexity) {

-		message("  calculating complexity ...", appendLF=FALSE); ptm <- proc.time()

+		ptm <- startTimedMessage("Calculating complexity ...")

 		complexity <- suppressMessages( estimateComplexity(data) )

-		time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+		stopTimedMessage(ptm)

 	}

 	if (remove.duplicate.reads) {

+		ptm <- startTimedMessage("Removing duplicate reads ...")

 		sp <- start(data)[as.logical(strand(data)=='+')]

 		sp1 <- c(sp[length(sp)], sp[-length(sp)])

 		sm <- start(data)[as.logical(strand(data)=='-')]

 		sm1 <- c(sm[length(sm)], sm[-length(sm)])

 		data <- c(data[strand(data)=='+'][sp!=sp1], data[strand(data)=='-'][sm!=sm1])

+		stopTimedMessage(ptm)

 	}

 	### Return fragments if desired ###

@@ -136,7 +144,9 @@ align2binned <- function(file, format, ID=basename(file), bamindex=file, chromos

 		if (!file.exists(outputfolder.reads)) { dir.create(outputfolder.reads) }

 		filename <- file.path(outputfolder.reads,paste0(ID,'.RData'))

 		if (reads.overwrite | !file.exists(filename)) {

+			ptm <- startTimedMessage(paste0("Saving fragments to ", filename, " ..."))

 			save(data, file=filename)

+			stopTimedMessage(ptm)

 		}

 	}

 	if (reads.return) {

@@ -147,20 +157,22 @@ align2binned <- function(file, format, ID=basename(file), bamindex=file, chromos

 	}

 	### Coverage and percentage of genome covered ###

+	ptm <- startTimedMessage("Calculating coverage ...")

 	genome.length <- sum(as.numeric(seqlengths(data)))

 	data.strand <- data

 	strand(data.strand) <- '*'

 	coverage <- sum(as.numeric(width(data.strand))) / genome.length

 	genome.covered <- sum(as.numeric(width(reduce(data.strand)))) / genome.length

 	## Per chromosome

-	coverage.per.chrom <- vector()

-	genome.covered.per.chrom <- vector()

+	coverage.per.chrom <- numeric(length=length(chroms2use))

+	genome.covered.per.chrom <- numeric(length=length(chroms2use))

 	for (chr in chroms2use) {

 		data.strand.chr <- data.strand[seqnames(data.strand)==chr]

 		coverage.per.chrom[chr] <- sum(as.numeric(width(data.strand.chr))) / seqlengths(data.strand)[chr]

 		genome.covered.per.chrom[chr] <- sum(as.numeric(width(reduce(data.strand.chr)))) / seqlengths(data.strand)[chr]

 	}

 	coverage <- list(coverage=coverage, genome.covered=genome.covered, coverage.per.chrom=coverage.per.chrom, genome.covered.per.chrom=genome.covered.per.chrom)

+	stopTimedMessage(ptm)

 	## Pad binsizes and reads.per.bin with each others value

@@ -171,56 +183,67 @@ align2binned <- function(file, format, ID=basename(file), bamindex=file, chromos

 	reads.per.bin <- c(reads.per.bin.add, reads.per.bin)

 	length.binsizes <- length(binsizes)

+	### Variable width bins ###

+	if (!is.null(variable.width.reference)) {

+		message("Making variable width bins:")

+		bins.list <- variableWidthBins(variable.width.reference, bamindex=variable.width.reference, binsizes=binsizes, chromosomes=chromosomes, pairedEndReads=pairedEndReads, remove.duplicate.reads=remove.duplicate.reads, min.mapq=min.mapq, max.fragment.width=max.fragment.width)

+		message("Finished making variable width bins.")

+	}

 	### Loop over all binsizes ###

 	data.plus <- data[strand(data)=='+']

 	data.minus <- data[strand(data)=='-']

 	skipped.chroms <- character()

+	binned.data.list <- list()

 	for (ibinsize in 1:length.binsizes) {

 		binsize <- binsizes[ibinsize]

 		readsperbin <- reads.per.bin[ibinsize]

 		message("Binning into bin size ",binsize," with on average ",readsperbin," reads per bin")

-		### Loop over chromosomes ###

-		message("  binning genome ...", appendLF=FALSE); ptm <- proc.time()

-		binned.data <- GenomicRanges::GRangesList()

-		for (chromosome in chroms2use) {

-

-			## Check last incomplete bin

-			incomplete.bin <- seqlengths(data)[chromosome] %% binsize > 0

-			if (incomplete.bin) {

-				numbin <- floor(seqlengths(data)[chromosome]/binsize)	# floor: we don't want incomplete bins, ceiling: we want incomplete bins at the end

-			} else {

-				numbin <- seqlengths(data)[chromosome]/binsize

+		if (is.null(variable.width.reference)) {

+			### Fixed width bins ###

+			ptm <- startTimedMessage("Making fixed-width bins ...")

+			binned.data <- GenomicRanges::GRangesList()

+			## Loop over chromosomes

+			for (chromosome in chroms2use) {

+				## Check last incomplete bin

+				incomplete.bin <- seqlengths(data)[chromosome] %% binsize > 0

+				if (incomplete.bin) {

+					numbin <- floor(seqlengths(data)[chromosome]/binsize)	# floor: we don't want incomplete bins, ceiling: we want incomplete bins at the end

+				} else {

+					numbin <- seqlengths(data)[chromosome]/binsize

+				}

+				if (numbin == 0) {

+					skipped.chroms[chromosome] <- chromosome

+					next

+				}

+				## Initialize vectors

+				chroms <- rep(chromosome,numbin)

+				reads <- rep(0,numbin)

+				start <- seq(from=1, by=binsize, length.out=numbin)

+				end <- seq(from=binsize, by=binsize, length.out=numbin)

+	# 			end[length(end)] <- seqlengths(data)[chromosome] # last ending coordinate is size of chromosome, only if incomplete bins are desired

+

+				## Create binned chromosome as GRanges object

+				i.binned.data <- GenomicRanges::GRanges(seqnames = Rle(chromosome, numbin),

+								ranges = IRanges(start=start, end=end),

+								strand = Rle(strand("*"), numbin)

+								)

+				seqlengths(i.binned.data) <- seqlengths(data)[chromosome]

+

+				suppressWarnings(

+					binned.data[[chromosome]] <- i.binned.data

+				)

+

+			} ## end loop chromosomes

+			if (length(skipped.chroms)>0) {

+				warning("Chromosomes ", paste0(skipped.chroms, collapse=', '), " are smaller than binsize. Skipped.")

 			}

-			if (numbin == 0) {

-				skipped.chroms[chromosome] <- chromosome

-				next

-			}

-			## Initialize vectors

-			chroms <- rep(chromosome,numbin)

-			reads <- rep(0,numbin)

-			start <- seq(from=1, by=binsize, length.out=numbin)

-			end <- seq(from=binsize, by=binsize, length.out=numbin)

-# 			end[length(end)] <- seqlengths(data)[chromosome] # last ending coordinate is size of chromosome, only if incomplete bins are desired

-

-			## Create binned chromosome as GRanges object

-			i.binned.data <- GenomicRanges::GRanges(seqnames = Rle(chromosome, numbin),

-							ranges = IRanges(start=start, end=end),

-							strand = Rle(strand("*"), numbin)

-							)

-			seqlengths(i.binned.data) <- seqlengths(data)[chromosome]

-

-			suppressWarnings(

-				binned.data[[chromosome]] <- i.binned.data

-			)

-

-		} ### end loop chromosomes ###

-		if (length(skipped.chroms)>0) {

-			warning("Chromosomes ", paste0(skipped.chroms, collapse=', '), " are smaller than binsize. Skipped.")

+			binned.data <- unlist(binned.data)

+			names(binned.data) <- NULL

+			stopTimedMessage(ptm)

+		} else {

+			binned.data <- bins.list[[ibinsize]]

 		}

-		time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

-		binned.data <- unlist(binned.data)

-		names(binned.data) <- NULL

 		### Loop over offsets ###

 		countmatrices <- list()

@@ -231,7 +254,7 @@ align2binned <- function(file, format, ID=basename(file), bamindex=file, chromos

 		}

 		for (ioff in offsets) {

 			## Count overlaps

-			message(paste0("  counting overlaps for offset ",ioff," ..."), appendLF=FALSE); ptm <- proc.time()

+			ptm <- startTimedMessage(paste0("Counting overlaps for offset ",ioff," ..."))

 			binned.data.shift <- suppressWarnings( shift(binned.data, shift=ioff) )

 			if (format=="bam" | format=="bed") {

 				mcounts <- suppressWarnings( GenomicRanges::countOverlaps(binned.data.shift, data.minus) )

@@ -241,7 +264,7 @@ align2binned <- function(file, format, ID=basename(file), bamindex=file, chromos

 			countmatrix <- matrix(c(counts,mcounts,pcounts), ncol=3)

 			colnames(countmatrix) <- c('counts','mcounts','pcounts')

 			countmatrices[[as.character(ioff)]] <- countmatrix

-			time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+			stopTimedMessage(ptm)

 		}

 		mcols(binned.data) <- as(countmatrices[['0']],'DataFrame')

 		attr(binned.data,'offset.counts') <- countmatrices

@@ -263,17 +286,21 @@ align2binned <- function(file, format, ID=basename(file), bamindex=file, chromos

 		if (save.as.RData==TRUE) {

 			# Save to file

 			filename <- paste0(ID,"_binsize_",format(binsize, scientific=TRUE, trim=TRUE),"_reads.per.bin_",readsperbin,"_.RData")

-			message("Saving to file ...", appendLF=FALSE); ptm <- proc.time()

+			ptm <- startTimedMessage("Saving to file ...")

 # 			attr(binned.data, 'call') <- call # do not store along with GRanges because it inflates disk usage

 			save(binned.data, file=file.path(outputfolder.binned,filename) )

-			time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+			stopTimedMessage(ptm)

 		} else {

 # 			attr(binned.data, 'call') <- call

-			return(binned.data)

+			binned.data.list[[as.character(binsize)]] <- binned.data

 		}

 	} ### end loop binsizes ###

+	if (!save.as.RData) {

+		return(binned.data.list)

+	}

+

 }

@@ -376,16 +403,17 @@ estimateComplexity <- function(reads) {

 #'

 #' Import aligned reads from a BAM file into a \code{\link{GRanges}} object.

 #'

-#' @param bamfile A file in BAM format.

+#' @param bamfile A sorted BAM file.

 #' @param bamindex BAM index file. Can be specified without the .bai ending. If the index file does not exist it will be created and a warning is issued.

 #' @param chromosomes If only a subset of the chromosomes should be imported, specify them here.

 #' @param pairedEndReads Set to \code{TRUE} if you have paired-end reads in your file.

 #' @param remove.duplicate.reads A logical indicating whether or not duplicate reads should be removed.

 #' @param min.mapq Minimum mapping quality when importing from BAM files. Set \code{min.mapq=NULL} to keep all reads.

 #' @param max.fragment.width Maximum allowed fragment length. This is to filter out erroneously wrong fragments due to mapping errors of paired end reads.

+#' @param what A character vector of fields that are returned. Type \code{\link[Rsamtools]{scanBamWhat}} to see what is available.

 #' @importFrom Rsamtools indexBam scanBamHeader ScanBamParam scanBamFlag

 #' @importFrom GenomicAlignments readGAlignmentPairsFromBam readGAlignmentsFromBam first

-bam2GRanges <- function(bamfile, bamindex=bamfile, chromosomes=NULL, pairedEndReads=FALSE, remove.duplicate.reads=FALSE, min.mapq=10, max.fragment.width=1000) {

+bam2GRanges <- function(bamfile, bamindex=bamfile, chromosomes=NULL, pairedEndReads=FALSE, remove.duplicate.reads=FALSE, min.mapq=10, max.fragment.width=1000, what='mapq') {

 	## Check if bamindex exists

 	bamindex.raw <- sub('\\.bai$', '', bamindex)

@@ -412,21 +440,25 @@ bam2GRanges <- function(bamfile, bamindex=bamfile, chromosomes=NULL, pairedEndRe

 		diffs <- paste0(diff, collapse=', ')

 		warning(paste0('Not using chromosomes ', diffs, ' because they are not in the data.'))

 	}

+

 	## Import the file into GRanges

+	ptm <- startTimedMessage("Reading file ",basename(bamfile)," ...")

 	gr <- GenomicRanges::GRanges(seqnames=Rle(chroms2use), ranges=IRanges(start=rep(1, length(chroms2use)), end=chrom.lengths[chroms2use]))

 	if (!remove.duplicate.reads) {

 		if (pairedEndReads) {

-			data.raw <- GenomicAlignments::readGAlignmentPairsFromBam(bamfile, index=bamindex, param=Rsamtools::ScanBamParam(which=range(gr), what='mapq'))

+			data.raw <- GenomicAlignments::readGAlignmentPairsFromBam(bamfile, index=bamindex, param=Rsamtools::ScanBamParam(which=range(gr), what=what))

 		} else {

-			data.raw <- GenomicAlignments::readGAlignmentsFromBam(bamfile, index=bamindex, param=Rsamtools::ScanBamParam(which=range(gr), what='mapq'))

+			data.raw <- GenomicAlignments::readGAlignmentsFromBam(bamfile, index=bamindex, param=Rsamtools::ScanBamParam(which=range(gr), what=what))

 		}

 	} else {

 		if (pairedEndReads) {

-			data.raw <- GenomicAlignments::readGAlignmentPairsFromBam(bamfile, index=bamindex, param=Rsamtools::ScanBamParam(which=range(gr), what='mapq', flag=scanBamFlag(isDuplicate=FALSE)))

+			data.raw <- GenomicAlignments::readGAlignmentPairsFromBam(bamfile, index=bamindex, param=Rsamtools::ScanBamParam(which=range(gr), what=what, flag=scanBamFlag(isDuplicate=FALSE)))

 		} else {

-			data.raw <- GenomicAlignments::readGAlignmentsFromBam(bamfile, index=bamindex, param=Rsamtools::ScanBamParam(which=range(gr), what='mapq', flag=scanBamFlag(isDuplicate=FALSE)))

+			data.raw <- GenomicAlignments::readGAlignmentsFromBam(bamfile, index=bamindex, param=Rsamtools::ScanBamParam(which=range(gr), what=what, flag=scanBamFlag(isDuplicate=FALSE)))

 		}

 	}

+	stopTimedMessage(ptm)

+

 	if (length(data.raw) == 0) {

 		if (pairedEndReads) {

 			stop(paste0("No reads imported. Does your file really contain paired end reads? Try with 'pairedEndReads=FALSE'"))

@@ -435,11 +467,11 @@ bam2GRanges <- function(bamfile, bamindex=bamfile, chromosomes=NULL, pairedEndRe

 	}

 	## Filter by mapping quality

 	if (pairedEndReads) {

-		message("Converting to GRanges ...", appendLF=FALSE); ptm <- proc.time()

+		ptm <- startTimedMessage("Converting to GRanges ...")

 		data <- as(data.raw, 'GRanges') # treat as one fragment

-		time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+		stopTimedMessage(ptm)

-		message("Filtering reads ...", appendLF=FALSE); ptm <- proc.time()

+		ptm <- startTimedMessage("Filtering reads ...")

 		if (!is.null(min.mapq)) {

 			mapq.first <- mcols(GenomicAlignments::first(data.raw))$mapq

 			mapq.last <- mcols(GenomicAlignments::last(data.raw))$mapq

@@ -448,16 +480,16 @@ bam2GRanges <- function(bamfile, bamindex=bamfile, chromosomes=NULL, pairedEndRe

 				warning(paste0(bamfile,": Reads with mapping quality NA (=255 in BAM file) found and removed. Set 'min.mapq=NULL' to keep all reads."))

 			}

 			data <- data[which(mapq.mask)]

-			# Filter out too long fragments

-			data <- data[width(data)<=max.fragment.width]

 		}

-		time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+		# Filter out too long fragments

+		data <- data[width(data)<=max.fragment.width]

+		stopTimedMessage(ptm)

 	} else {

-		message("Converting to GRanges ...", appendLF=FALSE); ptm <- proc.time()

+		ptm <- startTimedMessage("Converting to GRanges ...")

 		data <- as(data.raw, 'GRanges')

-		time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+		stopTimedMessage(ptm)

-		message("Filtering reads ...", appendLF=FALSE); ptm <- proc.time()

+		ptm <- startTimedMessage("Filtering reads ...")

 		if (!is.null(min.mapq)) {

 			if (any(is.na(mcols(data)$mapq))) {

 				warning(paste0(bamfile,": Reads with mapping quality NA (=255 in BAM file) found and removed. Set 'min.mapq=NULL' to keep all reads."))

@@ -465,8 +497,87 @@ bam2GRanges <- function(bamfile, bamindex=bamfile, chromosomes=NULL, pairedEndRe

 			}

 			data <- data[mcols(data)$mapq >= min.mapq]

 		}

-		time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+		# Filter out too long fragments

+		data <- data[width(data)<=max.fragment.width]

+		stopTimedMessage(ptm)

+	}

+

+	return(data)

+

+}

+

+

+#' Import BED file into GRanges

+#'

+#' Import aligned reads from a BED file into a \code{\link{GRanges}} object.

+#'

+#' @param bedfile A file with aligned reads in BED format. The columns have to be c('chromosome','start','end','description','mapq','strand').

+#' @param assembly Please see \code{\link[GenomeInfoDb]{fetchExtendedChromInfoFromUCSC}} for available assemblies.

+#' @param chromosomes If only a subset of the chromosomes should be imported, specify them here.

+#' @param remove.duplicate.reads A logical indicating whether or not duplicate reads should be removed.

+#' @param min.mapq Minimum mapping quality when importing from BAM files. Set \code{min.mapq=NULL} to keep all reads.

+#' @param max.fragment.width Maximum allowed fragment length. This is to filter out erroneously wrong fragments.

+#' @importFrom GenomeInfoDb fetchExtendedChromInfoFromUCSC

+bed2GRanges <- function(bedfile, assembly, chromosomes=NULL, remove.duplicate.reads=FALSE, min.mapq=10, max.fragment.width=1000) {

+

+	# File with reads, specify classes for faster import (0-based)

+	ptm <- startTimedMessage("Reading file ",basename(bedfile)," ...")

+	classes <- c('character','numeric','numeric','NULL','integer','character')

+	data.raw <- read.table(bedfile, colClasses=classes)

+	# Convert to GRanges object

+	data <- GenomicRanges::GRanges(seqnames=Rle(data.raw[,1]), ranges=IRanges(start=data.raw[,2]+1, end=data.raw[,3]), strand=data.raw[,5])	# start+1 to go from [0,x) -> [1,x]

+	mcols(data)$mapq <- data.raw[,4]

+	remove(data.raw)

+	chroms.in.data <- seqlevels(data)

+	stopTimedMessage(ptm)

+	# Get chromosome lengths

+	ptm <- startTimedMessage("Fetching chromosome lengths from UCSC ...")

+	df <- GenomeInfoDb::fetchExtendedChromInfoFromUCSC(assembly)

+	chrom.lengths <- df$UCSC_seqlengths

+	if (grepl('^chr',seqlevels(data)[1])) {

+		names(chrom.lengths) <- df$UCSC_seqlevels

+	} else {

+		names(chrom.lengths) <- df$NCBI_seqlevels

+	}

+	seqlengths(data) <- as.integer(chrom.lengths[names(seqlengths(data))])

+	stopTimedMessage(ptm)

+

+	## Issue warnings and stuff for non-existing chromosomes

+	chroms.in.data <- names(chrom.lengths)

+	if (is.null(chromosomes)) {

+		chromosomes <- chroms.in.data

+	}

+	chroms2use <- intersect(chromosomes, chroms.in.data)

+	if (length(chroms2use)==0) {

+		chrstring <- paste0(chromosomes, collapse=', ')

+		stop('The specified chromosomes ', chrstring, ' do not exist in the data.')

+	}

+	## Issue warning for non-existent chromosomes

+	diff <- setdiff(chromosomes, chroms.in.data)

+	if (length(diff)>0) {

+		diffs <- paste0(diff, collapse=', ')

+		warning(paste0('Not using chromosomes ', diffs, ' because they are not in the data.'))

+	}

+

+	## Select only desired chromosomes

+	data <- data[seqnames(data) %in% chroms2use]

+	if (length(data) == 0) {

+		stop(paste0('No reads imported!'))

+	}

+

+	## Filter by mapping quality

+	ptm <- startTimedMessage("Filtering reads ...")

+	if (!is.null(min.mapq)) {

+		if (any(is.na(mcols(data)$mapq))) {

+			warning(paste0(bedfile,": Reads with mapping quality NA (=255 in BAM file) found and removed. Set 'min.mapq=NULL' to keep all reads."))

+			mcols(data)$mapq[is.na(mcols(data)$mapq)] <- -1

+		}

+		data <- data[mcols(data)$mapq >= min.mapq]

 	}

+	# Filter out too long fragments

+	data <- data[width(data)<=max.fragment.width]

+	stopTimedMessage(ptm)

+

 	return(data)

 }

@@ -34,7 +34,7 @@ correctGC <- function(binned.data.list, GC.BSgenome, same.GC.content=FALSE) {

 		## Calculate GC content per bin

 		if (same.GC.content & !same.GC.calculated | !same.GC.content) {

-			message("Calculating GC content per bin ...", appendLF=FALSE); ptm <- proc.time()

+			ptm <- startTimedMessage("Calculating GC content per bin ...")

 			GC.content <- list()

 			for (chrom in seqlevels(binned.data)) {

 				if (!grepl('^chr',chrom)) {

@@ -57,12 +57,12 @@ correctGC <- function(binned.data.list, GC.BSgenome, same.GC.content=FALSE) {

 			}

 			GC.content <- unlist(GC.content)

 			same.GC.calculated <- TRUE

-			time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+			stopTimedMessage(ptm)

 		}

 		binned.data$GC <- GC.content

 		### GC correction ###

-		message("GC correction ...", appendLF=FALSE); ptm <- proc.time()

+		ptm <- startTimedMessage("GC correction ...")

 		counts <- binned.data$counts

 		mcounts <- binned.data$mcounts

 		pcounts <- binned.data$pcounts

@@ -107,7 +107,7 @@ correctGC <- function(binned.data.list, GC.BSgenome, same.GC.content=FALSE) {

 		# Produce fit to check

 		ggplt <- ggplot(df) + geom_point(aes_string(x='x', y='y', size='weight')) + geom_line(aes_string(x='x', y='y'), data=data.frame(x=gc.categories[intervals], y=fitted.correction.factors)) + theme_bw() + ggtitle('GC correction') + xlab('GC content') + ylab('correction factor')

 		attr(binned.data, 'GC.correction.ggplt') <- ggplt

-		time <- proc.time() - ptm; message(" ",round(time[3],2),"s")

+		stopTimedMessage(ptm)

 		### Quality measures ###

 		## Spikyness

new file mode 100644

@@ -0,0 +1,45 @@

+

+# ============================================================================

+# Functions for a Negative Binomial to transform (mean,variance)<->(size,prob)

+# ============================================================================

+dnbinom.size <- function(mean, variance) {

+	return(mean^2 / (variance - mean))

+}

+

+dnbinom.prob <- function(mean, variance) {

+	return(mean/variance)

+}

+

+dnbinom.mean <- function(size, prob) {

+	return(size/prob - size)

+}

+

+dnbinom.variance <- function(size, prob) {

+	return( (size - prob*size) / prob^2 )

+}

+

+dgeom.mean <- function(prob) {

+	return( (1-prob)/prob )