1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
|
#
# Module for Bio::PhyloNetwork::GraphViz
#
# Please direct questions and support issues to <bioperl-l@bioperl.org>
#
# Cared for by Gabriel Cardona <gabriel(dot)cardona(at)uib(dot)es>
#
# Copyright Gabriel Cardona
#
# You may distribute this module under the same terms as perl itself
# POD documentation - main docs before the code
=head1 NAME
Bio::PhyloNetwork::GraphViz - Interface between PhyloNetwork and GraphViz
=head1 SYNOPSIS
use Bio::PhyloNetwork;
use Bio::PhyloNetwork::GraphViz;
my $net=Bio::PhyloNetwork->new(
-eNewick=>'((H1,(H1,(H2,l))),H2)t0; (some long label)H1; ("quoted label")H2;'
);
my $gv=Bio::PhyloNetwork::GraphViz->new(-net=>$net,-short_labels=>1);
foreach my $u ($net->nodes()) {
print "$u:".$gv->nodePN_to_nodeGV->{$u}."\n";
}
print $gv->as_text;
open my $PS, '>', "net.ps" or die "Could not write file 'net.ps': $!\n";
print $PS $gv->as_ps;
close $PS;
=head1 DESCRIPTION
This is a module to create GraphViz objects representing phylogenetic networks.
=head1 AUTHOR
Gabriel Cardona, gabriel(dot)cardona(at)uib(dot)es
=head1 SEE ALSO
L<Bio::PhyloNetwork>, L<GraphViz>
=head1 APPENDIX
The rest of the documentation details each of the object methods.
=cut
package Bio::PhyloNetwork::GraphViz;
use strict;
use warnings;
use base qw(Bio::Root::Root GraphViz);
use Bio::PhyloNetwork;
=head2 new
Title : new
Usage : my $graphv = new Bio::PhyloNetwork::GraphViz();
Function: Creates a new Bio::PhyloNetwork::GraphViz object
Returns : Bio::PhyloNetwork::GraphViz
Args : -net => Bio::PhyloNetwork object
-short_labels => boolean (optional)
Returns a Bio::PhyloNetwork::GraphViz object, which is an extension of
a GraphViz object. The GraphViz object is a representation of the
phylogenetic network given. The extra information the created object
holds is a hash table with keys the nodes of the PhyloNetwork object
and values the nodes of the GraphViz object. If the optional argument
-short_labels=E<gt>1 is given, the labels of the nodes in GraphViz are
shortened to a maximum of 3 letters.
=cut
sub new {
my ($pkg,@args)=@_;
my $self=$pkg->SUPER::new(@args);
my ($net,$short_labels)=
$self->_rearrange([qw(NET
SHORT_LABELS)],@args);
if (! defined $short_labels) {
$short_labels=0;
}
my $gv=GraphViz->new();
my $nodePN_to_nodeGV={};
my @nodes=$net->nodes();
foreach my $node (@nodes) {
# my $namenode=generate_name($node);
# $names->{$node}=$namenode;
###
my $labelnodeint=$net->{labels}->{$node};
###
my $labelnode=($short_labels ? find_short_label($labelnodeint) : find_label($labelnodeint));
my $nodeGV=
$gv->add_node(#$namenode,
label=>$labelnode,
shape=>($net->is_tree_node($node) ? 'circle' : 'box'));
$nodePN_to_nodeGV->{$node}=$nodeGV;
}
my @edges=$net->edges();
foreach my $edge (@edges) {
my $node1=$edge->[0];
# my $namenode1=generate_name($node1);
my $node2=$edge->[1];
# my $namenode2=generate_name($node2);
$gv->add_edge($nodePN_to_nodeGV->{$node1},$nodePN_to_nodeGV->{$node2});
}
$self=$gv;
$self->{nodePN_to_nodeGV}=$nodePN_to_nodeGV;
bless($self,$pkg);
}
#sub generate_name {
# my ($var)=@_;
# if ($var =~ /\D/) {
# print "$var contains a number.\b";
# return $var;
# }
# return "N$var";
#}
sub find_short_label {
my ($str)=@_;
return substr(find_label($str),0,3);
}
sub find_label {
my ($str)=@_;
$str =~ tr/A-Za-z0-9//cd;
return $str;
}
=head2 nodePN_to_nodeGV
Title : nodePN_to_nodeGV
Usage : my $hashR=$graphv->nodePN_to_nodeGV()
Function: returns (a reference to) a hash holding the translation between
nodes of the Bio::PhyloNetwork object and nodes of the GraphViz
object
Returns : reference to hash
Args : none
=cut
sub nodePN_to_nodeGV {
my ($self)=@_;
return $self->{nodePN_to_nodeGV};
}
1;
|
