#Copyright (c) 2010 Joachim Bargsten <code at bargsten dot org>. All rights reserved.

package Bio::Gonzales::Phylo::Dendroscope;

use Mouse;

use warnings;
use strict;
use Carp;

use 5.010;
use Color::Spectrum qw/generate/;
use Data::Dumper;
use List::MoreUtils qw/any/;
use List::Util qw/sum/;
use Bio::Gonzales::Util::Graphics::Color::Generator;

our $VERSION = '0.078'; # VERSION

has file => ( is => 'rw', required => 1 );

sub _mean {
  return sum(@_) / @_;
}

=head1 NAME

Bio::Gonzales::Phylo::Dendroscope - Color phylogenetic trees in Dendroscope format

=head1 SYNOPSIS

    use Bio::Gonzales::Phylo::Dendroscope;

    my $file = "/path/to/dendroscope.tree";
    my $v->Bio::Gonzales::Phylo::Dendroscope(file => $file);
    
    $v->color_by_groups( $newfile, [ [ node_label1, node_label3, node_label5], [node_label2, node_label22, node_label51] ]);

=head1 DESCRIPTION
    
    Colors node labels of phylogenetic trees in Dendroscope file format

=head1 METHODS

=head2 $v->color_by_groups($newfile, $groups)

Colors the labels given in $groups and saves the resulting tree in $newfile.
See L<SYNOPSIS> for structure of $groups.

=cut

sub color_by_groups {
  my ( $self, $to_file, $id_groups ) = @_;

  my @colors = $self->_create_distinct_colors( scalar @{$id_groups} );

  say STDERR "using colors: " . Dumper \@colors;

  my %id_color_map;
  for my $id_group ( @{$id_groups} ) {
    my $color = shift @colors;

    %id_color_map = ( %id_color_map, map { $_ => $color } @{$id_group} );
  }
  $self->_update_id_background( $to_file, \%id_color_map );
}

sub _update_id_background {
  my ( $self, $file, $id_color_map ) = @_;

  open my $phy_fh,     '<', $self->file or croak "Can't open filehandle: $!";
  open my $new_phy_fh, '>', $file       or croak "Can't open filehandle: $!";

  my $node_section;
  while (<$phy_fh>) {

    $node_section = 0 if (/^edges$/);

    my $color     = 'null';
    my $textcolor = '0 0 0';
    if (
      $node_section &&     # are we in a node section?
      /lb='([^']+)'/ &&    # find node id in dendroscope file
      any { /^\Q$1\E/ || $1 =~ /\Q$_\E/ } keys %{$id_color_map}
      # check for matches, firstly does a dendroscope id match the beginning of a
      # group id or secondly is a group id part of a dendroscope id?
      )
    {
      my @ids = grep { $1 =~ /\Q$_\E/ || /^\Q$1\E/ } keys %{$id_color_map};
      say STDERR "Found matching group: $ids[0] -- $1";
      die "ids ambigous $1:" . join( "//", @ids ) if ( @ids != 1 );
      $color = $id_color_map->{ $ids[0] };

      if ( _mean( split /\s+/, $color ) > 127 ) {
        $textcolor = '0 0 0';
      } else {
        $textcolor = '255 255 255';
      }

      say STDERR "$ids[0] -- $color -- $textcolor";
    }

    #substitute foreground/text color
    if (/lc=(\d+\s+){3}/) {
      s/lc=(\d+\s+){3}/lc=$textcolor /;
    } else {
      s/^(\d+:.*\s+)(lb=)/$1lc=$textcolor $2/;
    }

    #substitute background color
    if (/lk=(\d+\s+){3}/) {
      s/lk=(\d+\s+){3}/lk=$color /;
    } else {
      s/^(\d+:.*\s+)(lb=)/$1lk=$color $2/;
    }

    $node_section = 1 if (/^nodes$/);

    print $new_phy_fh $_;
  }
}

sub _create_distinct_colors {
  my ( $self, $num_colors ) = @_;

  my $t      = Bio::Gonzales::Util::Graphics::Color::Generator->new;
  my @colors = $t->generate_as_string($num_colors);
  return @colors;
}

1;

__END__

=head1 SEE ALSO

=head1 AUTHOR

jw bargsten, C<< <joachim.bargsten at wur.nl> >>

=cut