Bio/PhyloNetwork/GraphViz.pm

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