R/stat_table-method.R

In tengfei/ggbio: Visualization tools for genomic data

## ..score..
setGeneric("stat_table", function(data, ...) standardGeneric("stat_table"))

setMethod("stat_table", "GRanges", function(data, ..., xlab, ylab, main,
                                            geom = NULL, stat = NULL){

  args <- list(...)
  
  args.aes <- parseArgsForAes(args)
  args.non <- parseArgsForNonAes(args)

  if(length(data)){
    tab <- table(paste(seqnames(data), start(data), end(data), strand(data), sep = ":"))
    key_mat <- matrix(unlist(strsplit(names(tab), ":", fixed=TRUE)), 4)
    gr <- GRanges(key_mat[1,],
                  IRanges(as.integer(key_mat[2,]), as.integer(key_mat[3,])),
                  key_mat[4,], score = as.integer(tab),
                  seqlengths = seqlengths(data))
    seqinfo(gr) <- seqinfo(data)
    args.non$data <- gr
    
    .ggbio.geom <- c("rect", "chevron", "alignment", "arrowrect", "arrow", "segment", "arch")
    .ggbio.stat <- c("identity", "coverage", "stepping", "aggregate")

    ## if(is.null(stat)){
    ## }
    ## ------------------------------
    ## geom/stat check
    ## ------------------------------
    if(is.null(stat) & is.null(geom)){
      stat <- "stepping"
      args.non$geom <- "rect"
      args.non$stat <- stat
      if(!"color" %in% names(args.aes) && !"colour" %in% names(args.aes))
        args.aes$color <- args.aes$fill <- as.name("score")
      .fun <- stat_stepping
    }else{
      .fun <- getDrawFunFromGeomStat(geom, stat)
      if(!is.null(geom)){
        if(geom != "arch"){
          if(is.null(stat)){
            args.non$stat <- stat <- "identity"
          }else{
            args.non$geom <- geom
          }}}
    }
    aes.res <- do.call(aes, args.aes)
    args.res <- c(args.non, list(aes.res))
    p <- do.call(.fun, args.res)
  }else{
    p <- NULL
  }

  labels <- Labels(xlab, ylab, main, fallback = c(x = ""))
  p <- c(p, labels)
  p <- setStat(p)
  p
})  


setMethod("stat_table", "GRangesList", function(data, ..., 
                                                xlab, ylab, main,
                                                facets = NULL, 
                                                geom = NULL){
  
  args <- list(...)

  args.aes <- parseArgsForAes(args)
  args.non <- parseArgsForNonAes(args)
  aes.res <- do.call(aes, args.aes)
  gr <- flatGrl(data)
  args.non$data <- gr
  p <- do.call(stat_table, c(list(aes.res), args.non))
  labels <- Labels(xlab, ylab, main, fallback =
                   c(x = "Genomic Coordinates", y = "Score"))
  p <- c(p, labels)
  p <- setStat(p)  
  p
})