Browse code

general cleanup and fixes, doc updates

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/gmapR@111183 bc3139a8-67e5-0310-9ffc-ced21a209358

Michael Lawrence authored on 03/12/2015 21:11:09
Showing 1 changed files
... ...
@@ -7,7 +7,8 @@
7 7
 ### High-level wrapper
8 8
 ###
9 9
 
10
-setGeneric("iit_store", function(x, dest, BPPARAM=MulticoreParam(1), ...) standardGeneric("iit_store"))
10
+setGeneric("iit_store", function(x, dest, BPPARAM=MulticoreParam(1), ...)
11
+    standardGeneric("iit_store"))
11 12
 
12 13
 gmapRange <- function(x) {
13 14
   pos <- strand(x) == "+"
... ...
@@ -28,7 +29,8 @@ gmapRange <- function(x) {
28 29
     
29 30
     strtpos = if(pos) min(strts) else max(ends)
30 31
     endpos = if(!pos) min(strts) else max(ends)
31
-    hdr = paste0(">", name, " ", runValue(seqnames(grange))[1], ":", strtpos, "..", endpos )
32
+    hdr = paste0(">", name, " ", runValue(seqnames(grange))[1], ":", strtpos,
33
+        "..", endpos)
32 34
 
33 35
     datline = paste(name, name, "NA")
34 36
     rngst = if(pos) strts[o] else ends[o]
... ...
@@ -69,7 +71,7 @@ setMethod("iit_store", c("character"),
69 71
                    label = if (gff) "ID" else NULL)
70 72
           {
71 73
             .iit_store(gff = gff, label = label, sort = "none",
72
-                       output = dest, inputfile = x)
74
+                       output = dest, .inputfile = x)
73 75
           })
74 76
 
75 77
 ### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Browse code

add codon tally support. No vbump yet

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/gmapR@93316 bc3139a8-67e5-0310-9ffc-ced21a209358

Gabriel Becker authored on 11/08/2014 23:42:48
Showing 1 changed files
... ...
@@ -7,7 +7,7 @@
7 7
 ### High-level wrapper
8 8
 ###
9 9
 
10
-setGeneric("iit_store", function(x, dest, ...) standardGeneric("iit_store"))
10
+setGeneric("iit_store", function(x, dest, BPPARAM=MulticoreParam(1), ...) standardGeneric("iit_store"))
11 11
 
12 12
 gmapRange <- function(x) {
13 13
   pos <- strand(x) == "+"
... ...
@@ -18,8 +18,42 @@ gmapRange <- function(x) {
18 18
   range
19 19
 }
20 20
 
21
-setMethod("iit_store", c("GenomicRanges", "character"),
22
-          function(x, dest, info = colnames(values(x))[1]) {
21
+
22
+
23
+.make_iit_interval = function(grange, name) {
24
+    pos = runValue(strand(grange))[1] == "+"
25
+    strts = start(grange)
26
+    ends = end(grange)
27
+    o = order(strts, decreasing = !pos)
28
+    
29
+    strtpos = if(pos) min(strts) else max(ends)
30
+    endpos = if(!pos) min(strts) else max(ends)
31
+    hdr = paste0(">", name, " ", runValue(seqnames(grange))[1], ":", strtpos, "..", endpos )
32
+
33
+    datline = paste(name, name, "NA")
34
+    rngst = if(pos) strts[o] else ends[o]
35
+    rngend = if(!pos) strts[o] else ends[o]
36
+    rnglines = paste0(rngst , " ", rngend)
37
+    c(hdr, datline, rnglines)
38
+}
39
+    
40
+    
41
+
42
+setMethod("iit_store", c("GenomicRangesList"),
43
+          function(x, dest =  tempfile(pattern="iit", fileext=".iit"), BPPARAM= MulticoreParam(1)) {
44
+              nms = gsub("( |:|\\.)", "_", names(x))
45
+              lines = unlist(bpmapply(.make_iit_interval, x, nms, BPPARAM = BPPARAM), use.names = FALSE)
46
+              p <- .iit_store(sort = "none", output = dest)
47
+              #writeLines(lines, p)
48
+              cat(paste(lines, collapse="\n"), file =p)
49
+              close(p)
50
+              dest
51
+          })
52
+
53
+
54
+setMethod("iit_store", c("GenomicRanges"),
55
+          function(x, dest =  tempfile(pattern="iit", fileext=".iit"),
56
+                   info = colnames(values(x))[1]) {
23 57
             lines <- paste0(">", names(x), " ", gmapRange(x), " ",
24 58
                             values(x)[[info]])
25 59
             p <- .iit_store(sort = "none", output = dest)
... ...
@@ -28,8 +62,10 @@ setMethod("iit_store", c("GenomicRanges", "character"),
28 62
             dest
29 63
           })
30 64
 
31
-setMethod("iit_store", c("character", "character"),
32
-          function(x, dest, gff = file_ext(x) == "gff",
65
+
66
+setMethod("iit_store", c("character"),
67
+          function(x, dest =  tempfile(pattern="iit", fileext=".iit"),
68
+                   gff = file_ext(x) == "gff",
33 69
                    label = if (gff) "ID" else NULL)
34 70
           {
35 71
             .iit_store(gff = gff, label = label, sort = "none",
Browse code

renaming gmapR2 to gmapR: it lives again

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/gmapR@68172 bc3139a8-67e5-0310-9ffc-ced21a209358

Michael Lawrence authored on 02/08/2012 22:24:24
Showing 1 changed files
1 1
new file mode 100644
... ...
@@ -0,0 +1,54 @@
1
+### =========================================================================
2
+### iit_store command
3
+### -------------------------------------------------------------------------
4
+###
5
+
6
+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
7
+### High-level wrapper
8
+###
9
+
10
+setGeneric("iit_store", function(x, dest, ...) standardGeneric("iit_store"))
11
+
12
+gmapRange <- function(x) {
13
+  pos <- strand(x) == "+"
14
+  range <- paste0(seqnames(x), ":", ifelse(pos, start(x), end(x)))
15
+  if (!all(width(x) == 1L)) {
16
+    range <- paste0(range, "..", ifelse(pos, end(x), start(x)))
17
+  }
18
+  range
19
+}
20
+
21
+setMethod("iit_store", c("GenomicRanges", "character"),
22
+          function(x, dest, info = colnames(values(x))[1]) {
23
+            lines <- paste0(">", names(x), " ", gmapRange(x), " ",
24
+                            values(x)[[info]])
25
+            p <- .iit_store(sort = "none", output = dest)
26
+            writeLines(lines, p)
27
+            close(p)
28
+            dest
29
+          })
30
+
31
+setMethod("iit_store", c("character", "character"),
32
+          function(x, dest, gff = file_ext(x) == "gff",
33
+                   label = if (gff) "ID" else NULL)
34
+          {
35
+            .iit_store(gff = gff, label = label, sort = "none",
36
+                       output = dest, inputfile = x)
37
+          })
38
+
39
+### - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
40
+### Low-level wrapper
41
+###
42
+
43
+.iit_store <- function(fields = FALSE, gff = FALSE,
44
+                       label = if (gff) "ID" else NULL,
45
+                       sort = c("chrom", "none", "alpha", "numeric-alpha"),
46
+                       output, .inputfile = NULL)
47
+{
48
+### TODO: assertions
49
+  sort <- match.arg(sort)
50
+  cl <- commandLine("iit_store")
51
+  if (is.null(.inputfile))
52
+    pipe(cl, open = "w")
53
+  else .system(cl)
54
+}