endomorphic overlaps, etc

g_range.R

suppressPackageStartupMessages({
    library(tibble)
    library(GenomicRanges)
})

.g_range <- setClass("g_range", contains="GRanges")

.g_columns <- c("chr", "start", "end", "strand")

setAs("GRanges", "g_range", function(from) {
    .g_range(from)
})

tbl_sum.g_range <- function(x)
    sprintf("A g_range object with %d rows and %d metadata columns:",
            nrow(x), ncol(x) - 4L)

setMethod("dim", "g_range", function(x) {
    dim(mcols(g)) + c(0L, 4L)
})

setMethod("dimnames", "g_range", function(x) {
    list(names(GRanges(g)), c(.g_columns, names(mcols(x))))
})

## can't contradict existing GRanges API
##
## setMethod("length", "g_range", function(x) {
##     ncol(x)
## })

setMethod("$", "g_range", function(x, name) {
    if (name %in% .g_columns) {
        as.data.frame(granges(x))[[name]]
    } else {
        mcols(x)[[name]]
    }
})

## [[,g_range-method OK, or contradict GRagnes API?

setMethod("show", "g_range", function(object) {
    tbl0 <- tibble(
        chr=factor(
            as.character(seqnames(object)),
            levels=levels(seqnames(object))),
        start=start(object),
        end=end(object),
        strand=factor(
            as.character(strand(object)),
            levels=levels(strand(object))))
    tbl1 <- as_tibble(as.data.frame(mcols(object)))
    tbl <- structure(
        as_tibble(cbind(tbl0, tbl1)),
        class=c("g_range", class(tbl0)))
    print(tbl)
})

##

g_range <- function(chr, start, end, strand, ...)
    .g_range(GRanges(chr, IRanges(start, end), strand, ...))

as_g_range <- function(x) as(x, "g_range")

overlap <- function(query, subject, ...) {
    hits <- findOverlaps(query, subject, ...)
    df <- setNames(as(hits, "DataFrame"), c("query", "subject"))
    olaps <- pintersect(query[df$query], subject[df$subject])
    mcols(olaps) <- df
    olaps
}

overlap_count<- function(query, subject, ...) {
    query$overlap_count <- countOverlaps(query, subject, ...)
    query
}

##

gr <- GRanges(c("chr1:1-10", "chr1:6-15"), foo=1:2)
g <- as_g_range(gr)
g

g$start
g$foo
g$bar <- sqrt(g$foo)
dim(g)

g[2:1, c("bar", "foo")]
g[2:1, 2:1]                             # weird, j starts at mcols()

overlap(g, g)
overlap_count(sample(g, 100, TRUE), g[1], type="within")
shift(g, 2)