R/iit_store-command.R
b22faf0d
 ### =========================================================================
 ### iit_store command
 ### -------------------------------------------------------------------------
 ###
 
 ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ### High-level wrapper
 ###
 
f053c5f3
 setGeneric("iit_store", function(x, dest, BPPARAM=MulticoreParam(1), ...)
     standardGeneric("iit_store"))
b22faf0d
 
 gmapRange <- function(x) {
   pos <- strand(x) == "+"
   range <- paste0(seqnames(x), ":", ifelse(pos, start(x), end(x)))
   if (!all(width(x) == 1L)) {
     range <- paste0(range, "..", ifelse(pos, end(x), start(x)))
   }
   range
 }
 
c78be696
 
 
 .make_iit_interval = function(grange, name) {
     pos = runValue(strand(grange))[1] == "+"
     strts = start(grange)
     ends = end(grange)
     o = order(strts, decreasing = !pos)
     
     strtpos = if(pos) min(strts) else max(ends)
     endpos = if(!pos) min(strts) else max(ends)
f053c5f3
     hdr = paste0(">", name, " ", runValue(seqnames(grange))[1], ":", strtpos,
         "..", endpos)
c78be696
 
     datline = paste(name, name, "NA")
     rngst = if(pos) strts[o] else ends[o]
     rngend = if(!pos) strts[o] else ends[o]
     rnglines = paste0(rngst , " ", rngend)
     c(hdr, datline, rnglines)
 }
     
     
 
 setMethod("iit_store", c("GenomicRangesList"),
           function(x, dest =  tempfile(pattern="iit", fileext=".iit"), BPPARAM= MulticoreParam(1)) {
               nms = gsub("( |:|\\.)", "_", names(x))
               lines = unlist(bpmapply(.make_iit_interval, x, nms, BPPARAM = BPPARAM), use.names = FALSE)
               p <- .iit_store(sort = "none", output = dest)
               #writeLines(lines, p)
               cat(paste(lines, collapse="\n"), file =p)
               close(p)
               dest
           })
 
 
 setMethod("iit_store", c("GenomicRanges"),
           function(x, dest =  tempfile(pattern="iit", fileext=".iit"),
                    info = colnames(values(x))[1]) {
b22faf0d
             lines <- paste0(">", names(x), " ", gmapRange(x), " ",
                             values(x)[[info]])
             p <- .iit_store(sort = "none", output = dest)
             writeLines(lines, p)
             close(p)
             dest
           })
 
c78be696
 
 setMethod("iit_store", c("character"),
           function(x, dest =  tempfile(pattern="iit", fileext=".iit"),
                    gff = file_ext(x) == "gff",
b22faf0d
                    label = if (gff) "ID" else NULL)
           {
             .iit_store(gff = gff, label = label, sort = "none",
f053c5f3
                        output = dest, .inputfile = x)
b22faf0d
           })
 
 ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ### Low-level wrapper
 ###
 
 .iit_store <- function(fields = FALSE, gff = FALSE,
                        label = if (gff) "ID" else NULL,
                        sort = c("chrom", "none", "alpha", "numeric-alpha"),
                        output, .inputfile = NULL)
 {
 ### TODO: assertions
   sort <- match.arg(sort)
   cl <- commandLine("iit_store")
   if (is.null(.inputfile))
     pipe(cl, open = "w")
   else .system(cl)
 }