#! /usr/local/bin/perl
#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

package SDTable;



sub new {
    my($this) = shift;
    my $self = {
	"format" => "default",
	"delim" => "\t",
	"titles" => [],
	"title" => undef,
	"table" => [],
	"sum" => [],
	"count" => [],
    };

    bless $self;
    $self->set(@_);

    $self;
}

sub set {
    my($self) = shift;
    local($key,$value);

    while($#_>=0) {
        ($key,$value) = (shift,shift);
        $self->{$key} = $value;
    }

    $self;
}

sub get {
    my($self,$key) = @_;

    $self->{$key};
}

sub rows {
    my($self) = @_;

    $#{$self->{"table"}}+1;
}


sub add {
    my($self) = shift;
    push(@{$self->{"table"}},[@_]);

    $self;
}

sub format {
    my($self) = shift;
    my(%args) = @_;

    my($output);
    my(@width);
    my($i,$j);
    my($style);
    my($sep);
    my($len);
    my($cols); # number of columns
    my($left,$right);
    my(@sum) = ();
    my(@count) = ();

    $output = "";
    $style = (defined $self->{'format'}) ? $self->{'format'} : "gaudy";

    # Do summation
    if ($#{$self->{"sum"}}>-1) {
	for($i=0;$i<=$#{$self->{"table"}};$i++) {
	    foreach $j ( @{$self->{"sum"}} ) {
		$sum[$j] += $self->{"table"}->[$i]->[$j];
	    }
	}
	
    }

    # Do count
    if ($#{$self->{"count"}}>-1) {
	foreach $j ( @{$self->{"count"}} ) {
	    local(%unique_values) = ();
	    for($i=0;$i<=$#{$self->{"table"}};$i++) {
		$unique_values{$self->{"table"}->[$i]->[$j]}++;
	    }
	    $count[$j] = scalar(keys %unique_values);
	    
	}
	
    }

    # Determine max width of each column
    @width = ();
    if (defined $self->{'titles'}) {
	for($i=0;$i<=$#{$self->{"titles"}};$i++) {
	    if ($width[$i] < length($self->{"titles"}->[$i])) {
		$width[$i] = length($self->{"titles"}->[$i]);
	    }
	}
    }
    for($i=0;$i<=$#{$self->{"table"}};$i++) {
	for ($j=0;$j<=$#{$self->{"table"}->[$i]};$j++) {
	    if ($width[$j] < length($self->{"table"}->[$i]->[$j])) {
		$width[$j] = length($self->{"table"}->[$i]->[$j]);
	    }
	}
    }
    if ($#{$self->{"sum"}}>-1) {
	for($i=0;$i<=$#sum;$i++) {
	    if ($width[$i] < length($sum[$i])) {
		$width[$i] = length($sum[$i]);
	    }
	}
    }
    if ($#{$self->{"count"}}>-1) {
	for($i=0;$i<=$#count;$i++) {
	    if ($width[$i] < length($count[$i])) {
		$width[$i] = length($count[$i]);
	    }
	}
    }



    if ($style eq "htg") {
	$style = "gaudy";
	$sepstart = "#";
	$titlestart = "#";
    } elsif ($style eq "gaudy") {
	$sepstart = "+";
	$titlestart = "|";
    }

    if ($style eq "tabbed") {
	# work out how width to nearest tab stop
	for ($j=0;$j<=$#width;$j++) {
	    $width[$j] += 8; # one for a space, 7 to round up
	    $width[$j] -= $width[$j]%8; # truncate to nearest 8
	}
    }

    $cols = $#width + 1;

    $sep = "";
    if ($style eq "gaudy") {
	for ($j=0;$j<=$#width;$j++) {
	    $sep .= ($j ? "+" : $sepstart) . "-" . "-" x $width[$j] . "-";
	}
	$sep .= "+";
    }

    # Print out table title
    if (defined $self->{"title"}) {
	if ($style eq "plain" || $style eq "tabbed") {
	    $output .= "$self->{'title'}\n\n";
	} elsif ($style eq "html") {
	    $output .= qq{
<TABLE width=100% border=2 cellpadding=2>
<TR><TH colspan=$cols align=center>$self->{'title'}</TH></TR>
};
	} elsif ($style eq "gaudy") {
	    $len = length($sep) - 2;

	    if (length($self->{'title'}) > $len) {
		# Expand to fit title
		$width[$#width] += length($self->{'title'}) - $len + 2;
		$sep = "";
		for ($j=0;$j<=$#width;$j++) {
		    $sep .= ($j ? "+" : $sepstart) . "-" . "-" x $width[$j] . "-";
		}
		$sep .= "+";
		$len = length($sep) - 2;
	    }
	    $left = int(($len - length($self->{'title'})) / 2);
	    $right = $len - length($self->{'title'}) - $left;
	    $output .=  $sepstart . "-" x $len . "+\n";
	    $output .=  $titlestart . " "x$left . $self->{'title'} . " "x$right . "|\n";
	}
    }

    $output .=  $sep . "\n";

    # Print out column headings
    if (defined $self->{'titles'} && $#{$self->{'titles'}} >= 0) {
	$output .=  "<TR align=center>" if $style eq "html";
	for ($i=0;$i<=$#width;$i++) {

	    $output .=  ($i ? "| " : "$titlestart ") if $style eq "gaudy";

	    if ($style eq "delimited") {
		$output .= $self->{"titles"}->[$i];
		$output .= $self->{"delim"} if $i < $#width;
	    } elsif ($style eq "tabbed") {
		if ($self->{"titles"}->[$i] eq "") {
		    $output .= " ";
		} else {
		    $output .= $self->{"titles"}->[$i];
		}
		$output .= "\t" x (int(($width[$i] - length($self->{"titles"}->[$i])+7)/8)) if $i < $#width;
	    } elsif ($style eq "html") {
		$output .= "<TH>$self->{'titles'}->[$i]</TH>";
	    } else {
		$output .= sprintf "%-$width[$i]s ",$self->{"titles"}->[$i];
	    }
	}
	$output .=  "|" if $style eq "gaudy";
	$output .=  "</TR>" if $style eq "html";
	$output .=  "\n";
	$output .=  $sep . "\n";
    }

    # Print out table
    for($i=0;$i<=$#{$self->{"table"}};$i++) {
	$output .=  "<TR align=left>" if $style eq "html";
	for ($j=0;$j<=$#width;$j++) {
	    $output .=  "| " if $style eq "gaudy";
	    if ($style eq "delimited") {
		$output .= $self->{"table"}->[$i]->[$j];
		$output .= $self->{"delim"} if $j < $#width;
	    } elsif ($style eq "tabbed") {
		if ($self->{"table"}->[$i]->[$j] eq "") {
		    $output .= " ";
		} else {
		    $output .= $self->{"table"}->[$i]->[$j];
		}
		$output .= "\t" x (int(($width[$j] - length($self->{"table"}->[$i]->[$j])+7)/8)) if $j < $#width;
	    } elsif ($style eq "html") {
		$output .= "<TD>$self->{'table'}->[$i]->[$j]</TD>";
	    } else {
		$output .= sprintf "%-$width[$j]s ",$self->{"table"}->[$i]->[$j];
	    }
	}
	$output .=  "|" if $style eq "gaudy";
	$output .=  "</TR>" if $style eq "html";
	$output .=  "\n";
    }
    $output .=  $sep . "\n";
    
    # Print out totals (sum)
    if ($#{$self->{"sum"}}>-1) {
	$output .=  "<TR align=right>" if $style eq "html";
	for ($i=0;$i<=$#width;$i++) {
	    $output .=  "| " if $style eq "gaudy";
	    if ($style eq "delimited") {
		$output .= $sum[$i];
		$output .= $self->{"delim"} if $i < $#width;
	    } elsif ($style eq "tabbed") {
		if ($sum[$i] eq "") {
		    $output .= " ";
		} else {
		    $output .= $sum[$i];
		}
		$output .= "\t" x (int(($width[$i] - length($sum[$i])+7)/8)) if $i < $#width;
	    } elsif ($style eq "html") {
		$output .= "<TH>$sum[$i]</TH>";
	    } else {
		$output .= sprintf "%-$width[$i]s ",$sum[$i];
	    }
	}
	$output .=  "|" if $style eq "gaudy";
	$output .=  "</TR>" if $style eq "html";
	$output .=  "\n";
	$output .=  $sep . "\n";
    }

    # Print out counts
    if ($#{$self->{"count"}}>-1) {
	$output .=  "<TR align=right>" if $style eq "html";
	for ($i=0;$i<=$#width;$i++) {
	    $output .=  "| " if $style eq "gaudy";
	    if ($style eq "delimited") {
		$output .= $count[$i];
		$output .= $self->{"delim"} if $i < $#width;
	    } elsif ($style eq "tabbed") {
		if ($count[$i] eq "") {
		    $output .= " ";
		} else {
		    $output .= $count[$i];
		}
		$output .= "\t" x (int(($width[$i] - length($count[$i])+7)/8)) if $i < $#width;
	    } elsif ($style eq "html") {
		$output .= "<TH>$count[$i]</TH>";
	    } else {
		$output .= sprintf "%-$width[$i]s ",$count[$i];
	    }
	}
	$output .=  "|" if $style eq "gaudy";
	$output .=  "</TR>" if $style eq "html";
	$output .=  "\n";
	$output .=  $sep . "\n";
    }

    $output .=  "</TABLE>\n" if $style eq "html";

    $output;
}




############################################################
# Create a new table, selecting rows and columns
############################################################
sub select {
    my($self) = shift;
    my(%args) = @_;

    $newtable = SDTable->new;
    my $i;

    # Set titles
    if (defined $args{'select'}) {
	my @titles = ();
	foreach $i (@{$args{'select'}}) {
	    push(@titles,$self->{'titles'}->[$i]);
	}
	$newtable->set("titles"=>[@titles]);
    } else {
	$newtable->set("titles"=>[@{$self->{'titles'}}]);
    }

    $select = 1;
    for($i=0;$i<=$#{$self->{"table"}};$i++) {

	if (defined $args{"func"}) {
	    $select = &{$args{"func"}}(@{$self->{"table"}->[$i]});
	}
    	if ( $select ) {
	    if (defined $args{'select'}) {
		my @row = ();
		foreach $j (@{$args{'select'}}) {
		    push(@row,$self->{'table'}->[$i]->[$j]);
		}
		$newtable->add(@row);
	    } else {
		$newtable->add(@{$self->{"table"}->[$i]});
	    }
	}
    }

    $newtable;

}


sub sort {
    my($self) = shift;
    my(%args) = @_;

    if (defined $args{'func'}) {
	local($func) = $args{'func'};
	$self->{'table'} = [ sort custom_sort @{$self->{'table'}} ];
    } else {
	$self->{'table'} = [ sort default_sort @{$self->{'table'}} ];
    }

    $self;
}


sub default_sort {
    join(" ",@{$a}) cmp join(" ",@{$b});
}
sub custom_sort {
    &$func();
}

1;
