comparison variant_effect_predictor/Bio/TreeIO/tabtree.pm @ 0:1f6dce3d34e0

Uploaded
author mahtabm
date Thu, 11 Apr 2013 02:01:53 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:1f6dce3d34e0
1 # $Id: tabtree.pm,v 1.6 2002/10/22 07:45:25 lapp Exp $
2 #
3 # BioPerl module for Bio::TreeIO::tabtree
4 #
5 # Cared for by Jason Stajich <jason@bioperl.org>
6 #
7 # Copyright Jason Stajich
8 #
9 # You may distribute this module under the same terms as perl itself
10
11 # POD documentation - main docs before the code
12
13 =head1 NAME
14
15 Bio::TreeIO::tabtree - A simple output format which displays a tree as an ASCII drawing
16
17 =head1 SYNOPSIS
18
19 use Bio::TreeIO;
20 my $in = new Bio::TreeIO(-file => 'input', -format => 'newick');
21 my $out = new Bio::TreeIO(-file => '>output', -format => 'tabtree');
22
23 while( my $tree = $in->next_tree ) {
24 $out->write_tree($tree);
25 }
26
27 =head1 DESCRIPTION
28
29 This is a made up format just for outputting trees as an ASCII drawing.
30
31 =head1 FEEDBACK
32
33 =head2 Mailing Lists
34
35 User feedback is an integral part of the evolution of this and other
36 Bioperl modules. Send your comments and suggestions preferably to
37 the Bioperl mailing list. Your participation is much appreciated.
38
39 bioperl-l@bioperl.org - General discussion
40 http://bioperl.org/MailList.shtml - About the mailing lists
41
42 =head2 Reporting Bugs
43
44 Report bugs to the Bioperl bug tracking system to help us keep track
45 of the bugs and their resolution. Bug reports can be submitted via
46 email or the web:
47
48 bioperl-bugs@bioperl.org
49 http://bugzilla.bioperl.org/
50
51 =head1 AUTHOR - Jason Stajich
52
53 Email jason@bioperl.org
54
55 Describe contact details here
56
57 =head1 CONTRIBUTORS
58
59 Additional contributors names and emails here
60
61 =head1 APPENDIX
62
63 The rest of the documentation details each of the object methods.
64 Internal methods are usually preceded with a _
65
66 =cut
67
68
69 # Let the code begin...
70
71
72 package Bio::TreeIO::tabtree;
73 use vars qw(@ISA);
74 use strict;
75
76 # Object preamble - inherits from Bio::Root::Root
77
78 use Bio::TreeIO;
79
80
81 @ISA = qw(Bio::TreeIO );
82
83 =head2 new
84
85 Title : new
86 Usage : my $obj = new Bio::TreeIO::tabtree();
87 Function: Builds a new Bio::TreeIO::tabtree object
88 Returns : Bio::TreeIO::tabtree
89 Args :
90
91
92 =cut
93
94 sub new {
95 my($class,@args) = @_;
96
97 my $self = $class->SUPER::new(@args);
98
99 }
100
101 =head2 write_tree
102
103 Title : write_tree
104 Usage : $treeio->write_tree($tree);
105 Function: Write a tree out to data stream in newick/phylip format
106 Returns : none
107 Args : Bio::Tree::TreeI object
108
109 =cut
110
111 sub write_tree{
112 my ($self,$tree) = @_;
113 my @data = _write_tree_Helper($tree->get_root_node,0);
114 $self->_print(join("\n", @data), "\n");
115 $self->flush if $self->_flush_on_write && defined $self->_fh;
116 return;
117 }
118
119 sub _write_tree_Helper {
120 my ($node,$depth) = @_;
121 return () if (!defined $node);
122
123 my @data;
124 my @d = $node->each_Descendent();
125
126 push @data,sprintf("%s%s","\t"x$depth,
127 $node->to_string);
128 if( @d ) {
129 my $c = 0;
130 foreach my $n ( @d ) {
131 push @data, _write_tree_Helper($n,$depth+1);
132 }
133 }
134
135 return @data;
136 }
137
138 =head2 next_tree
139
140 Title : next_tree
141 Usage :
142 Function: Sorry not possible with this format
143 Returns : none
144 Args : none
145
146
147 =cut
148
149 sub next_tree{
150 $_[0]->throw("Sorry the format 'tabtree' can only be used as an output format at this time");
151 }
152
153 1;