package Bio::Graphics::Glyph::turnip_pie_multi;

# $Id: turnip_pie_multi.pm,v 1.0 2009/07/08 davey Exp $
# Glyph for drawing a pie chart with pieces representing allele frequency
# based on the allele_pie_multi.pm glyph supplied with HapMap
# http://hapmap.ncbi.nlm.nih.gov/downloads/gbrowse/2005-03_phaseI/glyph/

use strict;
use vars '@ISA';
@ISA = 'Bio::Graphics::Glyph::generic';
use Bio::Graphics::Glyph::generic;
use Data::Dumper;

# Give enough height to fit in the pie chart, min height is 20
sub height {
    my $self = shift;
    my $height = $self->SUPER::height;
    if(defined $self->option('stacked')){
    		return $height;
    }else{
		    return $height > 19 ? $height : 19;
    }
}

# Need to make room for the allele pies if there is room
sub pad_right {
  my $self = shift;
  my $right = $self->SUPER::pad_right;
  my $height = $self->height;
  my $freq = defined ($self->option('freq')) ? $self->option('freq') : "NO";
  my @pops = split /;/, $freq;
  if(defined $self->option('stacked')){
      return $right > $height + 6 ? $right : $height + 6 if $self->label;
  }else{
      return $right > $height * scalar(@pops) + 6  ? $right: $height * scalar(@pops) + 6  if $self->label;
  }
}

sub majorcolor {
    my $self = shift;
    my $color = $self->option('majorcolor') || '#0033FF';
    $self->factory->translate_color($color);
}

sub minorcolor {
    my $self = shift;
    my $color = $self->option('minorcolor') || '#FF0000';
    $self->factory->translate_color($color);
}

sub get_description{
    my $self = shift;
    my $feature = shift;
    my $counts = defined ($self->option('counts')) ? $self->option('counts') : undef;
    if($counts && $counts =~ /:/){
        my @acounts = split /:/, $counts;
        return $acounts[1];
    }else{
    		return join '; ', eval {$feature->notes};
    }
}

sub pad_bottom{
    my $self = shift;
    if (defined $self->option('stacked')){
        my $desc = $self->get_description or return 0;
        my @items = split /\s+/, $desc;
        return (scalar(@items)-2)*10;
    }else{
    		return $self->SUPER::pad_bottom;
    }
}

sub draw_description {
    my $self = shift;
    my ($gd,$left,$top,$partno,$total_parts) = @_;
    my $label = $self->description or return;
    my @items = split /\s+/, $label;
    my $x = $self->left + $left;
    $x = $self->panel->left + 1 if $x <= $self->panel->left;
    my $pie_size = $self->height;
}

sub draw_component {
    my $self = shift;
    my $gd = shift;

    # find the center and vertices
    my ($x1,$y1,$x2,$y2) = $self->calculate_boundaries(@_);
	 
    my $feature = $self->feature;
    my @alleles = $feature->attributes('alleles');
    my $refallele = $self->option('ref_allele');
    
    if (@alleles) {
		# If it is on the minus strand
		if (my $strand = $self->option('ref_strand') <0){
			foreach (@alleles) {
				tr/ACTG/TGAC/ if $self->option('complement');
			}
		}
		my $height = $self->height;
		my $freq = defined ($self->option('freq')) ? $self->option('freq') : "NO";
		my @pop_freqs = split /;/, $freq;

	# to prevent the pie chart from flipping when the MAF is 0.50;
		#$freq = 0.499 if $freq == 0.5;
		
    my $desc = $self->get_description or return;
    my @items = split /\s+/, $desc;
	   
		for (my $i=0;$i<scalar(@alleles);$i++) {
			if ($refallele eq "-") {
				##insertion
				if($alleles[$i] =~ /\-+/) {
					$gd->string(GD::Font->Small,$x1-1, -2 + $y1, "-", $self->majorcolor);
					$gd->string(GD::Font->Small,$x1+30, -2 + $y1, $items[$i], $self->majorcolor);
				}
				else {
					if (length($alleles[$i])>1) {
						$alleles[$i] = ".";
					}
									
					$gd->string(GD::Font->MediumBold,$x1-1,-2 + ($i)*10 + $y1, $alleles[$i], $self->minorcolor);
					$gd->string(GD::Font->MediumBold,$x1+30, -2 + ($i)*10 + $y1, $items[$i], $self->minorcolor);					
				}
			}
			else {
				if($alleles[$i] ne $refallele){
					if (length($alleles[$i])>1) {
						$alleles[$i] = ".";
					}
					
					$gd->string(GD::Font->MediumBold,$x1-1,-2 + ($i)*10 + $y1, $alleles[$i], $self->minorcolor);
					$gd->string(GD::Font->MediumBold,$x1+30, -2 + ($i)*10 + $y1, $items[$i], $self->minorcolor);
				}
				else {
					if (length($alleles[$i])>1) {
						$alleles[$i] = ".";
					}
					
					$gd->string(GD::Font->Small,$x1-1, -2 + $y1, $alleles[$i], $self->majorcolor);
					$gd->string(GD::Font->Small,$x1+30, -2 + $y1, $items[$i], $self->majorcolor);
				}
			}
		}
		
    # draw the pie charts
    my @s = split /:/, $freq;
		my @freqs = split /\s+/, $s[1];
    my $afreq = $freqs[0];

    $afreq = 0.499 if $afreq == 0.5;
    $afreq = 'NO' unless $afreq =~ /^[0-9.]+$/;

    my $ph = $height;
    my $xd = 0;
    my $yd = 0;

    #empty
    $gd->arc((($x1 + $ph/2)+6 + $xd), ($y1+$ph/2 + $yd),($ph - 1),($ph - 1), 
    0, 360, $self->majorcolor) if $afreq eq 'NO';

    #allele
    $gd->filledArc((($x1 + $ph/2)+6 + $xd), ($y1+$ph/2 + $yd),($ph - 1),($ph - 1),
		    270, (360 * (1- $afreq)) + 270, $self->minorcolor) unless $afreq eq 'NO';

    #ref
    $gd->filledArc( (($x1 + $ph/2)+6 + $xd), 
	    ($y1+$ph/2 + $yd),
	    ($ph - 1),
	    ($ph - 1),
	    (360*(1-$afreq))+270,
	    270+360,
	    $self->majorcolor) unless $afreq eq 'NO';
	}
}

1;

__END__

=head2 NAME

Bio::Graphics::Glyph::turnip_pie_multi - The "turnip_pie_multi" glyph

=head2 SYNOPSIS

    See <Bio::Graphics::Panel> and <Bio::Graphics::Glyph>.

=head2 DESCRIPTION

This glyph draws a letter for each allele found at a SNP/pSNP/indel position, one above the other (i.e. in a column). For example:

    A
    G

See also L<http://www.hapmap.org/cgi-perl/gbrowse/gbrowse> 'genotyped SNPs' for an example from the HapMap project.

The common options are available (except height which is calculated based on the number of alleles).

=head4 GETTING THE ALLELES

To specify the alleles, create a "refallele" attribute and an "alleles" attribute for the feature.
There should be at least two such attributes (more for complex polymorphisms where there are two or more variant alleles with respect to the consensus).
For example, for a C/T polymorphism, the GFF3 load file should look like:

    rDNA	TURNIP_YS4	pSNP	3430	3430	.	.	.	ID=YS4:pSNP:3430;Name=YS4:pSNP:3430;refallele=c;alleles=c;alleles=t;acounts=TUR:c 0.904761904761905 38 t 0.0952380952380952 4 42;Parent=gnl|ti|1750944306;

=head4 OPTIONS

 . Glyph Colour
 . Different colour for alleles on the reverse strand
 . Print out the complement for alleles on the reverse strand
 . Major allele shown in bold
 . Horizontal histogram to show allele frequency

=head4 GLYPH COLOR

The glyph color can be configured to be different if the feature is on the plus or minus strand.  Use fgcolor to define the glyph color for the plus strand and bgcolor for the minus strand.  For example:

    fgcolor     = blue
    bgcolor     = red

For this option to work, you must also set ref_strand to return the strand of the feature:
    
    ref_strand = sub {shift->strand}

=head4 REVERSE STRAND ALLELES

If the alleles on the negative strand need to be the complement of what is listed in the GFF files, (e.g. A/G becomes T/C), set the complement option to have value 1

    complement = 1

For this option to work, you must also set ref_strand to return the strand of the feature:

    ref_strand = sub {shift->strand}

=head4 MAJOR/MINOR ALLELE

Use the 'minor_allele' option to return the minor allele for the polymorphism.  If you use this option, the major allele will appear in bold type.

=head2 BUGS

Please report them.

=head2 SEE ALSO

L<Bio::Graphics::Panel>,
L<Bio::Graphics::Glyph>,
L<Bio::Graphics::Glyph::arrow>,
L<Bio::Graphics::Glyph::cds>,
L<Bio::Graphics::Glyph::crossbox>,
L<Bio::Graphics::Glyph::diamond>,
L<Bio::Graphics::Glyph::dna>,
L<Bio::Graphics::Glyph::dot>,
L<Bio::Graphics::Glyph::ellipse>,
L<Bio::Graphics::Glyph::extending_arrow>,
L<Bio::Graphics::Glyph::generic>,
L<Bio::Graphics::Glyph::graded_segments>,
L<Bio::Graphics::Glyph::heterogeneous_segments>,
L<Bio::Graphics::Glyph::line>,
L<Bio::Graphics::Glyph::pinsertion>,
L<Bio::Graphics::Glyph::primers>,
L<Bio::Graphics::Glyph::rndrect>,
L<Bio::Graphics::Glyph::segments>,
L<Bio::Graphics::Glyph::ruler_arrow>,
L<Bio::Graphics::Glyph::toomany>,
L<Bio::Graphics::Glyph::transcript>,
L<Bio::Graphics::Glyph::transcript2>,
L<Bio::Graphics::Glyph::translation>,
L<Bio::Graphics::Glyph::allele_tower>,
L<Bio::DB::GFF>,
L<Bio::SeqI>,
L<Bio::SeqFeatureI>,
L<Bio::Das>,
L<GD>

=head2 AUTHOR

Robert Davey E<lt>robert.davey@bbsrc.ac.uk<gt>, National Collection of Yeast Cultures, Institute of Food Research, Norwich, UK
Copyright (c) 2009 NCYC

Original version by:
Albert Vernon Smith E<lt>albert.smith@cshl.eduE<gt> in Lincoln Stein's lab E<lt>steinl@cshl.eduE<gt>.
Copyright (c) 2003 Cold Spring Harbor Laboratory

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut