Browse code

support textConnection

git-svn-id: https://hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/ggtree@116643 bc3139a8-67e5-0310-9ffc-ced21a209358

g.yu authored on 21/04/2016 11:51:12
Showing 12 changed files

... ...
@@ -2,6 +2,8 @@ CHANGES IN VERSION 1.3.16
2 2
 ------------------------
3 3
  o update fortify.phylo to work with phylo that has missing value of edge length <2016-04-21, Thu>
4 4
    + https://github.com/GuangchuangYu/ggtree/issues/54
5
+ o support passing textConnection(text_string) as a file <2016-04-21, Thu>
6
+   + https://github.com/GuangchuangYu/ggtree/pull/55#issuecomment-212859693
5 7
  
6 8
 CHANGES IN VERSION 1.3.15
7 9
 ------------------------
... ...
@@ -52,7 +52,7 @@ read.nhx <- function(file) {
52 52
     nhx_stats$node <- node
53 53
     
54 54
     new("nhx",
55
-        file = file,
55
+        file = filename(file),
56 56
         fields = fields,
57 57
         phylo = phylo,
58 58
         nhx_tags = nhx_stats
... ...
@@ -32,7 +32,7 @@ read.beast <- function(file) {
32 32
         phylo       = phylo,
33 33
         translation = read.trans_beast(file),
34 34
         stats       = stats,
35
-        file        = file
35
+        file        = filename(file)
36 36
         )
37 37
 }
38 38
 
... ...
@@ -20,7 +20,7 @@ read.codeml_mlc <- function(mlcfile) {
20 20
         dNdS     = dNdS,
21 21
         ## seq_type = get_seqtype(tip_seq),
22 22
         ## tip_seq  = tip_seq,
23
-        mlcfile  = mlcfile)
23
+        mlcfile  = filename(mlcfile))
24 24
 }
25 25
 
26 26
 
... ...
@@ -49,24 +49,6 @@ setMethod("scale_color", signature(object="codeml_mlc"),
49 49
               scale_color_(object, by, ...)
50 50
           })
51 51
 
52
-##' @rdname show-methods
53
-##' @exportMethod show
54
-setMethod("show", signature(object = "codeml_mlc"),
55
-          function(object) {
56
-              cat("'codeml_mlc' S4 object that stored information of\n\t",
57
-                  paste0("'", object@mlcfile, "'."),
58
-                  "\n\n")
59
-              
60
-              cat("...@ tree:")
61
-              print.phylo(get.tree(object))                  
62
-              
63
-              cat("\nwith the following features available:\n")
64
-              cat("\t", paste0("'",
65
-                                 paste(get.fields(object), collapse="',\t'"),
66
-                                 "'."),
67
-                  "\n")
68
-          }
69
-          )
70 52
 
71 53
 
72 54
 ##' @rdname get.fields-methods
... ...
@@ -79,7 +79,7 @@ read.hyphy <- function(nwk, ancseq, tip.fasfile=NULL) {
79 79
                phylo = tr,
80 80
                seq_type = type,
81 81
                ancseq = seq,
82
-               tree.file = nwk,
82
+               tree.file = filename(nwk),
83 83
                ancseq.file = ancseq
84 84
                )
85 85
 
... ...
@@ -21,7 +21,7 @@ read.jplace <- function(file) {
21 21
              placements = placements,
22 22
              version    = version,
23 23
              metadata   = metadata,
24
-             file       = file
24
+             file       = filename(file)
25 25
              )
26 26
          )
27 27
 }
... ...
@@ -27,6 +27,25 @@ setMethod("show", signature(object = "codeml"),
27 27
               print_fields(object, len=4)
28 28
           })
29 29
 
30
+##' @rdname show-methods
31
+##' @exportMethod show
32
+setMethod("show", signature(object = "codeml_mlc"),
33
+          function(object) {
34
+              cat("'codeml_mlc' S4 object that stored information of\n\t",
35
+                  paste0("'", object@mlcfile, "'."),
36
+                  "\n\n")
37
+              
38
+              cat("...@ tree:")
39
+              print.phylo(get.tree(object))                  
40
+              
41
+              cat("\nwith the following features available:\n")
42
+              cat("\t", paste0("'",
43
+                                 paste(get.fields(object), collapse="',\t'"),
44
+                                 "'."),
45
+                  "\n")
46
+          }
47
+          )
48
+
30 49
 ##' show method for \code{jplace} instance
31 50
 ##'
32 51
 ##' 
... ...
@@ -94,3 +113,48 @@ setMethod("show", signature(object = "phylip"),
94 113
               cat(msg)
95 114
           })
96 115
 
116
+##' @rdname show-methods
117
+##' @exportMethod show
118
+setMethod("show", signature(object = "paml_rst"),
119
+          function(object) {
120
+              cat("'paml_rst' S4 object that stored information of\n\t",
121
+                  paste0("'", object@rstfile, "'.\n\n"))
122
+              ## if (length(object@tip.fasfile) != 0) {
123
+              ##     cat(paste0(" and \n\t'", object@tip.fasfile, "'.\n\n"))
124
+              ## } else {
125
+              ##     cat(".\n\n")
126
+              ## }
127
+              fields <- get.fields(object)
128
+
129
+              if (nrow(object@marginal_subs) == 0) {
130
+                  fields <- fields[fields != "marginal_subs"]
131
+                  fields <- fields[fields != "marginal_AA_subs"]
132
+              }
133
+              if (nrow(object@joint_subs) == 0) {
134
+                  fields <- fields[fields != "joint_subs"]
135
+                  fields <- fields[fields != "joint_AA_subs"]
136
+              }
137
+              
138
+              cat("...@ tree:")
139
+              print.phylo(get.tree(object))                  
140
+              cat("\nwith the following features available:\n")
141
+              cat("\t", paste0("'",
142
+                               paste(fields, collapse="',\t'"),
143
+                               "'."),
144
+                  "\n")
145
+          })
146
+
147
+
148
+
149
+##' @rdname show-methods
150
+##' @importFrom ape print.phylo
151
+##' @exportMethod show
152
+setMethod("show", signature(object = "r8s"),
153
+          function(object) {
154
+              cat("'r8s' S4 object that stored information of\n\t",
155
+                  paste0("'", object@file, "'.\n\n"))
156
+              cat("...@ tree: ")
157
+              print.phylo(get.tree(object))                  
158
+              ## cat("\nwith the following features available:\n")
159
+              ## print_fields(object)
160
+          })
... ...
@@ -46,7 +46,7 @@ read.paml_rst <- function(rstfile) {
46 46
                seq_type        = type,
47 47
                marginal_ancseq = ms,
48 48
                joint_ancseq    = read.ancseq_paml_rst(rstfile, by = "Joint"),
49
-               rstfile = rstfile
49
+               rstfile = filename(rstfile)
50 50
                )
51 51
     ## if (!is.null(tip.fasfile)) {
52 52
     ##     seqs <- readBStringSet(tip.fasfile)
... ...
@@ -86,36 +86,6 @@ setMethod("get.tipseq", signature(object="paml_rst"),
86 86
               }
87 87
           })
88 88
 
89
-##' @rdname show-methods
90
-##' @exportMethod show
91
-setMethod("show", signature(object = "paml_rst"),
92
-          function(object) {
93
-              cat("'paml_rst' S4 object that stored information of\n\t",
94
-                  paste0("'", object@rstfile, "'.\n\n"))
95
-              ## if (length(object@tip.fasfile) != 0) {
96
-              ##     cat(paste0(" and \n\t'", object@tip.fasfile, "'.\n\n"))
97
-              ## } else {
98
-              ##     cat(".\n\n")
99
-              ## }
100
-              fields <- get.fields(object)
101
-
102
-              if (nrow(object@marginal_subs) == 0) {
103
-                  fields <- fields[fields != "marginal_subs"]
104
-                  fields <- fields[fields != "marginal_AA_subs"]
105
-              }
106
-              if (nrow(object@joint_subs) == 0) {
107
-                  fields <- fields[fields != "joint_subs"]
108
-                  fields <- fields[fields != "joint_AA_subs"]
109
-              }
110
-              
111
-              cat("...@ tree:")
112
-              print.phylo(get.tree(object))                  
113
-              cat("\nwith the following features available:\n")
114
-              cat("\t", paste0("'",
115
-                               paste(fields, collapse="',\t'"),
116
-                               "'."),
117
-                  "\n")
118
-          })
119 89
 
120 90
 ##' @rdname get.fields-methods
121 91
 ##' @exportMethod get.fields
... ...
@@ -34,7 +34,7 @@ read.phylip <- function(file) {
34 34
     }
35 35
     
36 36
     new("phylip",
37
-        file = file,
37
+        file = filename(file),
38 38
         phylo = trees,
39 39
         ntree = ntree,
40 40
         sequence = seq_obj
... ...
@@ -21,26 +21,13 @@ read.r8s <- function(file) {
21 21
     names(trees) <- label
22 22
 
23 23
     new("r8s",
24
-        file = file,
24
+        file = filename(file),
25 25
         fields = label,
26 26
         phylo = trees)
27 27
 }
28 28
 
29 29
 
30 30
 
31
-##' @rdname show-methods
32
-##' @importFrom ape print.phylo
33
-##' @exportMethod show
34
-setMethod("show", signature(object = "r8s"),
35
-          function(object) {
36
-              cat("'r8s' S4 object that stored information of\n\t",
37
-                  paste0("'", object@file, "'.\n\n"))
38
-              cat("...@ tree: ")
39
-              print.phylo(get.tree(object))                  
40
-              ## cat("\nwith the following features available:\n")
41
-              ## print_fields(object)
42
-          })
43
-
44 31
 
45 32
 ##' @rdname groupClade-methods
46 33
 ##' @exportMethod groupClade
... ...
@@ -1,3 +1,13 @@
1
+filename <- function(file) {
2
+    ## textConnection(text_string) will work just like a file
3
+    ## in this case, just set the filename as ""
4
+    file_name <- ""
5
+    if (is.character(file)) {
6
+        file_name <- file
7
+    }
8
+    return(file_name)
9
+}
10
+
1 11
 
2 12
 ##' @importFrom ggplot2 last_plot
3 13
 get_tree_view <- function(tree_view) {
... ...
@@ -1,5 +1,5 @@
1 1
 % Generated by roxygen2: do not edit by hand
2
-% Please edit documentation in R/RAxML.R, R/ape.R, R/codeml_mlc.R, R/hyphy.R, R/method-show.R, R/paml_rst.R, R/phangorn.R, R/r8s.R
2
+% Please edit documentation in R/RAxML.R, R/ape.R, R/hyphy.R, R/method-show.R, R/phangorn.R
3 3
 \docType{methods}
4 4
 \name{show,raxml-method}
5 5
 \alias{show}
... ...
@@ -20,14 +20,14 @@
20 20
 
21 21
 \S4method{show}{apeBootstrap}(object)
22 22
 
23
-\S4method{show}{codeml_mlc}(object)
24
-
25 23
 \S4method{show}{hyphy}(object)
26 24
 
27 25
 \S4method{show}{beast}(object)
28 26
 
29 27
 \S4method{show}{codeml}(object)
30 28
 
29
+\S4method{show}{codeml_mlc}(object)
30
+
31 31
 show(object)
32 32
 
33 33
 \S4method{show}{nhx}(object)
... ...
@@ -36,9 +36,9 @@ show(object)
36 36
 
37 37
 \S4method{show}{paml_rst}(object)
38 38
 
39
-\S4method{show}{phangorn}(object)
40
-
41 39
 \S4method{show}{r8s}(object)
40
+
41
+\S4method{show}{phangorn}(object)
42 42
 }
43 43
 \arguments{
44 44
 \item{object}{one of \code{jplace}, \code{beast} object}