The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#
# 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;