@@ -39,6 +39,7 @@ Imports:

     futile.logger,

     VGAM,

     tools,

+    methods,

     rhdf5,

     Matrix

 Suggests:

@@ -122,6 +122,7 @@ importFrom(graphics,strwidth)

 importFrom(graphics,symbols)

 importFrom(graphics,text)

 importFrom(gridExtra,grid.arrange)

+importFrom(methods,is)

 importFrom(rhdf5,H5Fopen)

 importFrom(rtracklayer,import)

 importFrom(stats,C)

@@ -329,7 +329,7 @@ c(test.num.copy, round(opt.C))[i], prior.K, mapping.bias.ok, seg.id, min.variant

     tmp <- sapply(prior.purity, .checkFraction, "prior.purity")

-    if (!is.null(sampleid) && (class(sampleid) != "character" ||

+    if (!is.null(sampleid) && (!is(sampleid, "character") ||

         length(sampleid) != 1)) {

         .stopUserError("sampleid not a character string.")

     }

@@ -838,7 +838,7 @@ c(test.num.copy, round(opt.C))[i], prior.K, mapping.bias.ok, seg.id, min.variant

     required.colnames2 <- c("ID", "chromosome", "start", "end", "num_probes", 

         "mean")

     if (ncol(seg) > length(required.colnames)) {

-        seg <- seg[,1:length(required.colnames)]

+        seg <- seg[,seq_along(required.colnames)]

     }    

     if (identical(colnames(seg), required.colnames2)) {

         colnames(seg) <- required.colnames

@@ -899,7 +899,7 @@ c(test.num.copy, round(opt.C))[i], prior.K, mapping.bias.ok, seg.id, min.variant

             flog.info("Provided log2-ratio looks too noisy, using segmentation only.")

         }

     }

-    if (class(seg.file)=="character") {

+    if (is(seg.file, "character")) {

         seg <- .loadSegFile(seg.file, sampleid, model.homozygous, verbose=FALSE)    

     } else {

         seg <-.checkSeg(seg.file, sampleid, model.homozygous, verbose=FALSE)

@@ -32,11 +32,13 @@ annotateTargets <- function(x, txdb, org) {

     txdb <- .checkSeqlevelStyle(x, txdb, "txdb", "interval file")

     id <- transcriptsByOverlaps(txdb, ranges = x[idx], columns = "GENEID")

     id$SYMBOL <- suppressWarnings(

-        select(org, sapply(id$GENEID, function(x)x[1]), "SYMBOL")[, 2])

+        select(org, vapply(id$GENEID, function(x) x[1], character(1)), 

+               "SYMBOL")[, 2])

     idExons <- exonsByOverlaps(txdb, ranges = x[idx], columns = "GENEID")

     idExons$SYMBOL <- suppressWarnings(

-        select(org, sapply(idExons$GENEID, function(x)x[1]), "SYMBOL")[, 2])

+        select(org, vapply(idExons$GENEID, function(x) x[1], character(1)),

+               "SYMBOL")[, 2])

     ov <- findOverlaps(x[idx], id)

     ovExons <- findOverlaps(x[idx], idExons)

@@ -58,16 +58,16 @@ calculateBamCoverageByInterval <- function(bam.file, interval.file,

     x <- xDupFiltered

     if (keep.duplicates) x <- xAll

-    intervalGr$coverage <- sapply(seq_along(x), function(i)

+    intervalGr$coverage <- vapply(seq_along(x), function(i)

         sum(coverage(IRanges(x[[i]][["pos"]], width = x[[i]][["qwidth"]]),

-            shift = -start(intervalGr)[i], width = width(intervalGr)[i])))

+            shift = -start(intervalGr)[i], width = width(intervalGr)[i])), integer(1))

     intervalGr$average.coverage <- intervalGr$coverage / width(intervalGr)

-    intervalGr$counts <- as.numeric(sapply(x, function(y) length(y$pos)))

+    intervalGr$counts <- as.numeric(vapply(x, function(y) length(y$pos), integer(1)))

     intervalGr$duplication.rate <- 1 -

-        sapply(xDupFiltered, function(y) length(y$pos)) /

-        sapply(xAll, function(y) length(y$pos))

+        vapply(xDupFiltered, function(y) length(y$pos), integer(1)) /

+        vapply(xAll, function(y) length(y$pos), integer(1))

     if (!is.null(output.file)) {

         .writeCoverage(intervalGr, output.file)

@@ -29,7 +29,7 @@

 callAlterations <- function(res, id = 1, cutoffs = c(0.5, 6, 7),

 log.ratio.cutoffs = c(-0.9, 0.9), failed = NULL, all.genes = FALSE) {

-    if (class(res$results[[id]]$gene.calls) != "data.frame") {

+    if (!is(res$results[[id]]$gene.calls, "data.frame")) {

         .stopUserError("This function requires gene-level calls.\n",

             "Please add a column 'Gene' containing gene symbols to the ",

             "interval.file.")

@@ -76,7 +76,7 @@ callLOH <- function(res, id = 1, arm.cutoff = 0.9) {

 .getCentromeres <- function(res) {

     # TODO remove this support for old data.frame centromeres in PureCN 1.12

-    if (class(res$input$centromeres) == "GRanges" || 

+    if (is(res$input$centromeres, "GRanges") || 

             is.null(res$input$centromeres)) {

         return(res$input$centromeres)

     }    

@@ -72,11 +72,11 @@ callMutationBurden <- function(res, id = 1, remove.flagged = TRUE,

     # calculate the callable genomic region for # mutations/MB calculation

     if (!is.null(callable)) {

-        if (class(callable) != "GRanges") {

+        if (!is(callable, "GRanges")) {

             .stopUserError("callable not a GRanges object.")

         } 

         if (!is.null(exclude)) {

-            if (class(exclude) != "GRanges") {

+            if (!is(exclude, "GRanges")) {

                 .stopUserError("exclude not a GRanges object.")

             } 

             callable <- setdiff(callable, exclude)

@@ -102,7 +102,7 @@ callMutationBurden <- function(res, id = 1, remove.flagged = TRUE,

     # filter mutations, for example if the user wants to 

     # calculate missense burden

     if (!is.null(fun.countMutation)) {

-        if (class(fun.countMutation) != "function") {

+        if (!is(fun.countMutation, "function")) {

             .stopUserError("fun.countMutation not a function.")        

         }

         vcf <-  res$input$vcf

@@ -98,7 +98,7 @@ filterTargets <- function(...) {

 }  

 .checkNormalDB <- function(tumor, normalDB) {

-    if (!class(normalDB) == "list") {

+    if (!is(normalDB, "list")) {

         .stopUserError("normalDB not a valid normalDB object. ",

             "Use createNormalDatabase to create one.")

     }    

@@ -313,9 +313,9 @@ function(vcf, tumor.id.in.vcf, allowed=0.05) {

 .readAndCheckVcf <- function(vcf.file, genome, DB.info.flag = "DB", 

                              POPAF.info.field = "POP_AF", 

                              min.pop.af = 0.001, check.DB = TRUE) {

-    if (class(vcf.file) == "character") {

+    if (is(vcf.file, "character")) {

         vcf <- readVcf(vcf.file, genome)

-    } else if (class(vcf.file) != "CollapsedVCF") {

+    } else if (!is(vcf.file, "CollapsedVCF")) {

         .stopUserError("vcf.file neither a filename nor a CollapsedVCF ", 

             "object.") 

     } else {

@@ -67,7 +67,7 @@ verbose=TRUE) {

         if (m == 0) return(1)

         dbinom(m, size=coverage, prob=error/3)    

      }

-     k <- min(which(sapply(0:coverage,.pk) < fpr)) - 1

+     k <- min(which(vapply(seq(0, coverage),.pk, double(1)) < fpr)) - 1

      if (verbose) message("Minimum ", k, " supporting reads.")

      # find allelic fraction to test

@@ -44,7 +44,7 @@ predictSomatic <- function(res, id = 1, return.vcf = FALSE,

 }

 .addSymbols <- function(result) {

-    if (class(result$gene.calls) == "data.frame") {

+    if (is(result$gene.calls, "data.frame")) {

         g.gr <- GRanges(result$gene.calls)

         p.gr <- GRanges(result$SNV.posterior$posteriors)

         ov <- findOverlaps(p.gr, g.gr)

@@ -66,6 +66,7 @@

 #' @importFrom GenomicRanges tileGenome

 #' @importFrom S4Vectors mcols

 #' @importFrom rtracklayer import

+#' @importFrom methods is

 #' @importFrom stats aggregate

 preprocessIntervals <- function(interval.file, reference.file,

                                 output.file = NULL, off.target = FALSE,

@@ -81,7 +82,7 @@ preprocessIntervals <- function(interval.file, reference.file,

                                 off.target.seqlevels=c("targeted", "all"),

                                 small.targets=c("resize", "drop")) {

-    if (class(interval.file)=="GRanges") {

+    if (is(interval.file, "GRanges")) {

         interval.gr <- .checkIntervals(interval.file)

     } else {

         interval.gr <- readCoverageFile(interval.file)

@@ -239,7 +240,7 @@ calculateGCContentByInterval <- function() {

 .checkColScore <- function(y, label) {

     colScore <- if (is.null(y$score)) 1 else "score"

-    if (class(mcols(y)[, colScore]) != "numeric") {

+    if (!is(mcols(y)[, colScore], "numeric")) {

         flog.warn("Score column in %s file is not numeric.", label)

         class(mcols(y)[, colScore]) <- "numeric"

     }

@@ -332,10 +333,10 @@ calculateGCContentByInterval <- function() {

 .checkSeqlevelStyle <- function(ref, x, name1, name2="reference") {

     refSeqlevelStyle <- try(seqlevelsStyle(ref), silent=TRUE)

     # if unknown, we cannot check and correct

-    if (class(refSeqlevelStyle) == "try-error") return(x)

+    if (is(refSeqlevelStyle, "try-error")) return(x)

     xSeqlevelStyle <- try(seqlevelsStyle(x), silent=TRUE)

-    if (class(xSeqlevelStyle) == "try-error") {

+    if (is(xSeqlevelStyle, "try-error")) {

         .stopUserError("Chromosome naming style of ", name1, 

             " file unknown, should be ", refSeqlevelStyle, ".") 

     }    

@@ -105,10 +105,12 @@ processMultipleSamples <- function(tumor.coverage.files, sampleids, normalDB,

     lrsw <- copynumber::winsorize(lrs, arms = arms, verbose = FALSE)

     if (is.null(w)) {

         w <- 1

-        dupr <- sapply(tumors, function(x) median(x[x$on.target]$duplication.rate, na.rm = TRUE))

+        dupr <- vapply(tumors, function(x) 

+                       median(x[x$on.target]$duplication.rate, na.rm = TRUE),

+                       double(1))

         if (!sum(is.na(dupr)) && min(dupr, na.rm = TRUE) > 0) { 

-            w <- (1/dupr)

-            w <- w/max(w)

+            w <- (1 / dupr)

+            w <- w / max(w)

             flog.info("Setting weights by duplication rate. Lowest weight for %s (%.2f), heighest for %s.",

                 sampleids[which.min(w)], min(w), sampleids[which.max(w)])

@@ -626,13 +626,14 @@ runAbsoluteCN <- function(normal.coverage.file = NULL,

     # estimate stand. dev. for target logR within targets. this will be used as proxy

     # for sample error.

-    targetsPerSegment <- sapply(exon.lrs, length)

+    targetsPerSegment <- vapply(exon.lrs, length, double(1))

     if (!sum(targetsPerSegment > 50, na.rm = TRUE)) {

         .stopRuntimeError("Only tiny segments.")

     }

-    sd.seg <- max(median(sapply(exon.lrs, sd), na.rm = TRUE), min.logr.sdev)

+    sd.seg <- max(median(vapply(exon.lrs, sd, double(1)), na.rm = TRUE),

+                  min.logr.sdev)

     # if user provided seg file, then we do not have access to the log-ratios and

     # need to use the user provided noise estimate also, don't do outlier smoothing

@@ -760,7 +761,8 @@ runAbsoluteCN <- function(normal.coverage.file = NULL,

                     function(i) .calcLlikSegment(subclonal = subclonal[i], lr = exon.lrs[[i]] + 

                       log.ratio.offset[i], sd.seg = sd.seg, p = px, Ci = C[i], total.ploidy = total.ploidy, 

                       max.exon.ratio = max.exon.ratio), double(1)))

-                  px.rij.s <- sapply(px.rij, sum, na.rm = TRUE) + log(prior.purity.local)

+                  px.rij.s <- vapply(px.rij, sum, na.rm = TRUE, double(1)) + 

+                      log(prior.purity.local)

                   if (simulated.annealing) 

                     px.rij.s <- px.rij.s * exp(iter/4)

@@ -959,7 +961,8 @@ runAbsoluteCN <- function(normal.coverage.file = NULL,

                         Ci = sol$ML.C[i], total.ploidy = px * (sum(sol$seg$size * sol$ML.C))/sum(sol$seg$size) + (1 - 

                           px) * 2, max.exon.ratio = max.exon.ratio), double(1)))

-                      px.rij.s <- sapply(px.rij, sum, na.rm = TRUE) + log(pp) + vapply(res.snvllik, 

+                      px.rij.s <- vapply(px.rij, sum, na.rm = TRUE, double(1)) + 

+                          log(pp) + vapply(res.snvllik, 

                         function(x) x$llik, double(1))

                       idx <- which.max(px.rij.s)

                   }

@@ -998,14 +1001,14 @@ runAbsoluteCN <- function(normal.coverage.file = NULL,

     nBefore <- length(results)

     results <- .filterDuplicatedResults(results, purity.cutoff = 0.05)

     # bring back in original order for progress output

-    results <- results[order(sapply(results, function(sol) sol$candidate.id))]

+    results <- results[order(vapply(results, function(sol) sol$candidate.id, integer(1)))]

     if (length(results) < nBefore) { 

         flog.info("Skipping %i solutions that converged to the same optima.",

                   nBefore - length(results))

     }

-    idxFailed <- sapply(results, function(sol) 

-                        sol$fraction.subclonal > max.non.clonal)

+    idxFailed <- vapply(results, function(sol) 

+                        sol$fraction.subclonal > max.non.clonal, logical(1))

     if (sum(is.na(idxFailed))) .stopRuntimeError("NAs in fraction.subclonal.")

     if (sum(idxFailed)) {

         flog.info("Skipping %i solutions exceeding max.non.clonal (%.2f).",

@@ -1095,8 +1098,8 @@ runAbsoluteCN <- function(normal.coverage.file = NULL,

             test.num.copy = test.num.copy,

             sex = sex, sex.vcf = sex.vcf, chr.hash = chr.hash, centromeres = centromeres,

             args=list(

-                filterVcf = args.filterVcf[sapply(args.filterVcf, object.size) < 1000],

-                filterIntervals = args.filterIntervals[sapply(args.filterIntervals, object.size) < 1000])

+                filterVcf = args.filterVcf[vapply(args.filterVcf, object.size, double(1)) < 1000],

+                filterIntervals = args.filterIntervals[vapply(args.filterIntervals, object.size, double(1)) < 1000])

         )

     )

 }

@@ -203,7 +203,7 @@ segmentationCBS <- function(normal, tumor, log.ratio, seg, plot.cnv,

             sum(queryHits(ov) == i))

         dx <- cbind(seg$seg.mean,xx)

         hc <- hclust(dist(dx), method=method)

-        seg.hc <- data.frame(id=1:nrow(dx), dx, num=numVariants, 

+        seg.hc <- data.frame(id=seq(nrow(dx)), dx, num=numVariants, 

             cluster=cutree(hc,h=h))[hc$order,]

         # cluster only segments with at least n variants    

@@ -244,7 +244,7 @@ segmentationCBS <- function(normal, tumor, log.ratio, seg, plot.cnv,

 .pruneByVCF <- function(x, vcf, tumor.id.in.vcf, min.size=5, max.pval=0.00001,

     iterations=3, chr.hash, debug=FALSE) {

     seg <- try(segments.p(x$cna), silent=TRUE)

-    if (class(seg) == "try-error") return(x)

+    if (is(seg, "try-error")) return(x)

     for (iter in seq_len(iterations)) {

         seg.gr <- GRanges(seqnames=.add.chr.name(seg$chrom, chr.hash), 

             IRanges(start=seg$loc.start, end=seg$loc.end))

@@ -179,5 +179,5 @@ normal.panel.vcf.file = NULL, min.normals = 2, smooth = TRUE, smooth.n = 5) {

     x[1, ] <- x[1, ] + shape1

     x[2, ] <- x[2, ] + shape2

     # get the alt allelic fraction for all SNPs

-    apply(x, 2, function(y) y[2] / sum(y[1:2]))

+    apply(x, 2, function(y) y[2] / sum(head(y,2)))

 }

@@ -42,7 +42,7 @@ in.file <- normalizePath(opt$infile, mustWork=TRUE)

 suppressPackageStartupMessages(library(rtracklayer))

 intervals <- try(import(in.file), silent=TRUE)

-if (class(intervals) == "try-error") intervals <- in.file

+if (is(intervals, "try-error")) intervals <- in.file

 knownGenome <- list(

     hg18="TxDb.Hsapiens.UCSC.hg18.knownGene",

@@ -89,7 +89,7 @@ reference.file <- normalizePath(opt$fasta, mustWork = TRUE)

 suppressPackageStartupMessages(library(rtracklayer))

 intervals <- try(import(in.file), silent = TRUE)

-if (class(intervals) == "try-error") { 

+if (is(intervals, "try-error")) { 

     intervals <- in.file

 } else {

     if (sum(c("MT", "chrM", "chMT") %in% seqlevels(intervals))) {