R/Methods-Iterator.R

Defines functions SeqVarListIterator SeqVarWindowIterator SeqVarRangeIterator SeqVarBlockIterator SeqVarIterator

Documented in SeqVarBlockIterator SeqVarIterator SeqVarListIterator SeqVarRangeIterator SeqVarWindowIterator

SeqVarIterator <- function(seqData, variantFilter, verbose=TRUE) {
    class(seqData) <- "SeqVarIterator"
    seqData@variantFilter <- variantFilter

    ## set filter to first element
    seqSetFilter(seqData, variant.sel=variantFilter[[1]], verbose=verbose)
    
    ## pass-by-reference slot for lastFilter
    seqData@lastFilter <- new.env()
    lastFilter(seqData) <- 1
    
    seqData
}


SeqVarBlockIterator <- function(seqData, variantBlock=10000, verbose=TRUE) {

    if (variantBlock > .nVar(seqData)) {
        variantBlock <- .nVar(seqData)
    }
    
    ## original filter
    current.sel <- which(seqGetFilter(seqData)$variant.sel)

    ## divide selected variants into blocks
    variantFilter <- split(current.sel, ceiling(seq_along(current.sel)/variantBlock))
    
    seqData <- SeqVarIterator(seqData, variantFilter, verbose=verbose)
    class(seqData) <- "SeqVarBlockIterator"
    seqData@variantBlock <- as.integer(variantBlock)

    seqData
}


SeqVarRangeIterator <- function(seqData, variantRanges, verbose=TRUE) {
    ## original filter
    current.sel <- which(seqGetFilter(seqData)$variant.sel)

    ## filter for iterator ranges
    variants <- granges(seqData)
    new.sel <- .subjectByQuery(variantRanges, variants, hits.only=FALSE)$subjectHits
    variantFilter <- lapply(new.sel, function(x) current.sel[x])
    
    seqData <- SeqVarIterator(seqData, variantFilter, verbose=verbose)
    class(seqData) <- "SeqVarRangeIterator"
    seqData@variantRanges <- variantRanges

    seqData
}


SeqVarWindowIterator <- function(seqData, windowSize=10000, windowShift=5000, verbose=TRUE) {
    ## original filter
    current.sel <- which(seqGetFilter(seqData)$variant.sel)
    
    # identify windows
    variants <- granges(seqData)
    windows <- do.call("c", lapply(unique(seqnames(variants)), function(chr) {
        start <- seq(1, max(end(variants[seqnames(variants) == chr])), windowShift)
        GRanges(seqnames=chr, ranges=IRanges(start=start, width=windowSize))
    }))

    ## variants in each window
    sbq <- .subjectByQuery(windows, variants, hits.only=TRUE)
    new.sel <- sbq$subjectHits

    ## only keep unique windows
    keep <- !duplicated(new.sel)
    new.sel <- new.sel[keep]
    windows <- windows[sbq$queryHits[keep]]

    variantFilter <- lapply(new.sel, function(x) current.sel[x])
    
    seqData <- SeqVarIterator(seqData, variantFilter, verbose=verbose)
    class(seqData) <- "SeqVarWindowIterator"
    seqData@variantRanges <- windows
    seqData@windowSize <- as.integer(windowSize)
    seqData@windowShift <- as.integer(windowShift)
        
    seqData
}


SeqVarListIterator <- function(seqData, variantRanges, verbose=TRUE) {
    ## original filter
    current.sel <- which(seqGetFilter(seqData)$variant.sel)
    
    ## filter for iterator ranges
    variants <- granges(seqData)
    new.sel <- .subjectByQuery(variantRanges, variants, hits.only=FALSE)$subjectHits
    variantFilter <- lapply(new.sel, function(x) current.sel[x])
    
    seqData <- SeqVarIterator(seqData, variantFilter, verbose=verbose)
    class(seqData) <- "SeqVarListIterator"
    seqData@variantRanges <- variantRanges

    seqData
}


setMethod("variantFilter",
          "SeqVarIterator",
          function(x) {
              x@variantFilter
          })

setMethod("lastFilter",
          "SeqVarIterator",
          function(x) {
              x@lastFilter$i
          })

setReplaceMethod("lastFilter",
                 c("SeqVarIterator", "numeric"),
                 function(x, value) {
                     x@lastFilter$i <- as.integer(value)
                     x
                 })

setMethod("iterateFilter",
          "SeqVarIterator",
          function(x, verbose=TRUE) {
              ## set filter for next element
              if (lastFilter(x) < length(variantFilter(x))) {
                  i <- lastFilter(x) + 1
                  seqSetFilter(x, variant.sel=variantFilter(x)[[i]], verbose=verbose)
                  lastFilter(x) <- i
                  return(TRUE)
              } else {
                  .emptyVarFilter(x, verbose=verbose)
                  return(FALSE)
              }
          })

setMethod("resetIterator",
          "SeqVarIterator",
          function(x, verbose=TRUE) {
              ## set filter for first element
              seqSetFilter(x, variant.sel=variantFilter(x)[[1]], verbose=verbose)
              lastFilter(x) <- 1
          })


setMethod("variantBlock",
          "SeqVarBlockIterator",
          function(x) {
              x@variantBlock
          })


setMethod("variantRanges",
          "SeqVarRangeIterator",
          function(x) {
              x@variantRanges
          })

setMethod("variantRanges",
          "SeqVarListIterator",
          function(x) {
              x@variantRanges
          })


setMethod("currentRanges",
          "SeqVarBlockIterator",
          function(x) {
              granges(x)
          })

setMethod("currentRanges",
          "SeqVarRangeIterator",
          function(x) {
              variantRanges(x)[lastFilter(x)]
          })

setMethod("currentRanges",
          "SeqVarListIterator",
          function(x) {
              variantRanges(x)[[lastFilter(x)]]
          })

setMethod("currentVariants",
          "SeqVarIterator",
          function(x) {
              variant <- granges(x)
              range <- currentRanges(x)
              mergeByOverlaps(variant, range)
          })

setMethod("currentVariants",
          "SeqVarBlockIterator",
          function(x) {
              df <- as(granges(x), "DataFrame")
              names(df)[1] <- "variant"
              df
          })


setMethod("show",
          "SeqVarIterator",
          function(object) {
              cat(class(object), "object; on iteration",
                  lastFilter(object), "of", length(variantFilter(object)), "\n")
              cat(" | GDS:\n")
              print(object)
              cat(" | sampleData:\n")
              show(sampleData(object))
              cat(" | variantData:\n")
              show(variantData(object))
          })

setMethod("show",
          "SeqVarRangeIterator",
          function(object) {
              callNextMethod(object)
              cat(" | variantRanges:\n")
              show(variantRanges(object))
          })

setMethod("show",
          "SeqVarListIterator",
          function(object) {
              callNextMethod(object)
              cat(" | variantRanges:\n")
              show(variantRanges(object))
          })
smgogarten/SeqVarTools documentation built on July 4, 2023, 2:34 a.m.