#!/usr/bin/perl -w

# Test script for Bio::ToolBox::Data
# working with a Bio::DB::SeqFeature::Store database
# using in memory database for simplicity here....

use strict;
use Test::More;
use File::Spec;
use FindBin '$Bin';
use Statistics::Lite qw(min max);

BEGIN {
	if (eval {require Bio::DB::SeqFeature::Store::memory; 1}) {
		plan tests => 88;
	}
	else {
		plan skip_all => 'Bio::DB::SeqFeature::Store::memory or DB_File not available';
	}
	$ENV{'BIOTOOLBOX'} = File::Spec->catfile($Bin, "Data", "biotoolbox.cfg");
}

require_ok 'Bio::ToolBox::Data' or 
	BAIL_OUT "Cannot load Bio::ToolBox::Data";


### Collect features from a database
my $infile = File::Spec->catfile($Bin, "Data", "chrI.gff3");
my $Data = Bio::ToolBox::Data->new(
	'db'      => $infile,
	'feature' => 'gene:SGD',
);
isa_ok($Data, 'Bio::ToolBox::Data', 'db collected gene table');

# check metadata
is($Data->feature, 'gene:SGD', 'feature');
is($Data->feature_type, 'named', 'feature type');
is($Data->program, undef, 'program');
is($Data->gff, 0, 'gff format');
is($Data->bed, 0, 'bed format');
is($Data->filename, undef, 'filename');

# check data table
is($Data->number_columns, 3, 'number of columns');
is($Data->last_row, 33, 'last row'); # this now includes dubious genes as of 1.54

# columns
is($Data->id_column, 0, 'primary ID column');
is($Data->name_column, 1, 'identify name column');
is($Data->type_column, 2, 'identify type column');

# test database
is($Data->database, $infile, 'database name');
my $db = $Data->open_database;
isa_ok($db, 'Bio::DB::SeqFeature::Store', 'opened database');

# since we are dealing with a memory database, the features returned 
# are not in a predictable order suitable for testing
# so we will sort the data table by increasing name
$Data->sort_data(1, 'i');

# test row_stream
my $stream = $Data->row_stream;
isa_ok($stream, 'Bio::ToolBox::Data::Iterator', 'row stream iterator');

# look at first row
my $row = $stream->next_row;
isa_ok($row, 'Bio::ToolBox::Data::Feature', 'row Feature');
ok($row->row_index, 'row index'); # could be anything
is($row->type, 'gene:SGD', 'Feature type');
is($row->name, 'YAL043C', 'Feature name');
cmp_ok($row->id, '>=', 1, 'primary id'); # in memory db, could be anything?
is($row->start, undef, 'Feature start, undefined'); # not in table, returns nothing
is($row->stop, undef, 'Feature stop, undefined'); # not in table, returns nothing

# test SeqFeature
my $feature = $row->feature;
isa_ok($feature, 'Bio::DB::SeqFeature', 'db SeqFeature from row Feature');
is($row->start, 58695, 'Feature start, defined'); # uses db feature for start
is($row->stop, 61052, 'Feature stop, defined'); # uses db feature for stop
my $segment = $row->segment;
isa_ok($segment, 'Bio::DB::SeqFeature::Segment', 'db segment from row Feature');



### Using a second test database for data collection
# verify data from a data database
my $ddb = File::Spec->catfile($Bin, "Data", "sample2.gff3");
my $verified = $Data->verify_dataset('data:sample2', $ddb);
is($verified, 'data:sample2', 'dataset in data database verified');

# collect mean score
my $score = $row->get_score(
	ddb     => $ddb,
	dataset => 'data',
	'method'  => 'mean',
);
# print "mean score with data and ddb is $score\n";
is(sprintf("%.2f", $score), 0.18, 'mean score across feature');
 
# collect max score
$score = $row->get_score(
	ddb     => $ddb,
	dataset => 'data:sample2',
	'method'  => 'max',
);
# print "max score is $score\n";
is(sprintf("%.2f", $score), 0.46, 'max score across feature');

# collect median score
$score = $row->get_score(
	ddb     => $ddb,
	dataset => 'data:sample2',
	'method'  => 'median',
);
# print "median score is $score\n";
is(sprintf("%.2f", $score), 0.19, 'median score across feature');

# collect 5' mean score
$score = $row->get_score(
	ddb     => $ddb,
	dataset => 'data:sample2',
	'method'  => 'mean',
	start   => $row->stop - 1000,
	stop    => $row->stop,
);
# print "5 prime mean score is $score\n";
is(sprintf("%.2f", $score), '0.30', 'mean score across 5 prime feature');

# collect sum count score
$score = $row->get_score(
	ddb     => $ddb,
	dataset => 'data:sample2',
	'method' => 'count',
);
# print "median score is $score\n";
is($score, 60, 'count across feature');

# collect pcount score
$score = $row->get_score(
	ddb     => $ddb,
	dataset => 'data:sample2',
	'method' => 'pcount',
);
# print "pcount score is $score\n";
is($score, 60, 'pcount across feature');

# collect ncount score
$score = $row->get_score(
	ddb     => $ddb,
	dataset => 'data:sample2',
	'method' => 'ncount',
);
# print "ncount score is $score\n";
is($score, 60, 'ncount across feature');

# collect position scores
my %score1 = $row->get_region_position_scores(
	ddb     => $ddb,
	dataset => 'data:sample2',
);
# print "position_score is \n" . print_hash(\%score1);
is(min(keys %score1), 58, 'min position in positioned score hash');
is(max(keys %score1), 2342, 'max position in positioned score hash');
is($score1{686}, 0.26, 'score at position 686 in positioned score hash');

%score1 = $row->get_region_position_scores(
	ddb     => $ddb,
	dataset => 'data:sample2',
	'method' => 'ncount',
);
# print "position_score ncount is \n" . print_hash(\%score1);
is(min(keys %score1), 58, 'min position in positioned ncount hash');
is(max(keys %score1), 2342, 'max position in positioned ncount hash');
is($score1{686}, 1, 'score at position 686 in positioned ncount hash');



# move to next gene to get better relative scores
$row = $stream->next_row;
isa_ok($row, 'Bio::ToolBox::Data::Feature', 'row Feature');
is($row->name, 'YAL044C', 'Feature name');

# collect 5' relative position scores
%score1 = $row->get_relative_point_position_scores(
	ddb     => $ddb,
	dataset => 'data:sample2',
	extend  => 500,
	position => 5,
);
is(min(keys %score1), -467, 'min 5prime relative position in positioned score hash');
is(max(keys %score1), 467, 'max 5prime relative position in positioned score hash');
is($score1{218}, 0.62, 'score at position 218 in 5prime relative positioned score hash');

# collect 3' relative position scores
%score1 = $row->get_relative_point_position_scores(
	ddb     => $ddb,
	dataset => 'data:sample2',
	extend  => 500,
	position => 3,
);
# print "3' position_score is \n" . print_hash(\%score1);
is(min(keys %score1), -430, 'min 3prime relative position in positioned score hash');
is(max(keys %score1), 481, 'max 3prime relative position in positioned score hash');
is($score1{187}, 0.75, 'score at position 187 in 3prime relative positioned score hash');

# collect region extended relative position scores
%score1 = $row->get_region_position_scores(
	ddb     => $ddb,
	dataset => 'data:sample2',
	extend  => 500,
	absolute => 1,
);
# print "extended position_score is \n" . print_hash(\%score1);
is(min(keys %score1), 57469, 'min extended relative position in positioned score hash');
is(max(keys %score1), 58929, 'max extended relative position in positioned score hash');
is($score1{58532}, 0.34, 'score at position 58532 in extended relative positioned score hash');
is(scalar(keys %score1), 39, 'number of keys extended relative positioned score hash');

# collect avoided extended relative position scores
%score1 = $row->get_region_position_scores(
	ddb     => $ddb,
	dataset => 'data:sample2',
	extend  => 1000,
	absolute => 1,
	avoid   => 1,
);
# print "avoided extended position_score is \n" . print_hash(\%score1);
is(min(keys %score1), 56969, 'min avoided extended relative position in positioned score hash');
is(max(keys %score1), 58683, 'max avoided extended relative position in positioned score hash');
is($score1{58532}, 0.34, 'score at position 58532 in avoided extended relative positioned score hash');
is(scalar(keys %score1), 26, 'number of keys avoided extended relative positioned score hash');

# collect absolute position scores
%score1 = $row->get_relative_point_position_scores(
	ddb     => $ddb,
	dataset => 'data:sample2',
	extend  => 500,
	position => 4,
	'method' => 'count',
);
# print "position_score is \n" . print_hash(\%score1);
is($score1{-5}, 1, 'count at relative position -5 in positioned score hash');



### Repeat score collection with advanced annotation
undef(%score1);
undef($score);
undef($feature);
undef($row);
undef($stream);
undef($Data);
$Data = Bio::ToolBox::Data->new(
	'db'      => $ddb,
	'feature' => 'mRNA:tim',
	# we need to work with transcripts here, not genes
);
isa_ok($Data, 'Bio::ToolBox::Data', 'db collected gene table');

# check metadata
is($Data->feature, 'mRNA:tim', 'feature');
is($Data->feature_type, 'named', 'feature type');

# check data table
is($Data->number_columns, 3, 'number of columns');
is($Data->last_row, 4, 'last row');

# columns
is($Data->id_column, 0, 'primary ID column');
is($Data->name_column, 1, 'identify name column');
is($Data->type_column, 2, 'identify type column');

# check first feature
$Data->sort_data(1, 'i');
$stream = $Data->row_stream;
isa_ok($stream, 'Bio::ToolBox::Data::Iterator', 'row stream iterator');
$row = $stream->next_row;
isa_ok($row, 'Bio::ToolBox::Data::Feature', 'row Feature');
is($row->type, 'mRNA:tim', 'Feature type');
is($row->name, 'YAL030W', 'Feature name');

# test SeqFeature
$feature = $row->feature;
isa_ok($feature, 'Bio::DB::SeqFeature', 'db SeqFeature from row Feature');

# test subfeature scores, should use same database
$score = $row->get_score(
	dataset => 'data',
	'method'  => 'count',
);
is($score, 13, 'count score across mRNA');
$score = $row->get_score(
	dataset => 'data',
	'method'  => 'count',
	subfeature => 'exon',
);
is($score, 9, 'count score across subfeature exons');
$score = $row->get_score(
	dataset => 'data',
	'method'  => 'count',
	subfeature => 'cds',
);
is($score, 8, 'count score across subfeature CDS');
$score = $row->get_score(
	dataset => 'data',
	'method'  => 'pcount',
	subfeature => '5p_utr',
);
# we do a precise count here because a quirk of BDBSFS adapter returns EVERYTHING found
# when nothing fits in the coordinate search window. bug or feature? ugh.
is($score, 0, 'pcount score across subfeature 5p UTR');
$score = $row->get_score(
	dataset => 'data:sample2',
	'method'  => 'pcount',
	subfeature => '3p_utr',
);
# another bug? should return 1 with method count, but it returns all????
is($score, 1, 'pcount score across subfeature 3p UTR');

%score1 = $row->get_region_position_scores(
	dataset => 'data:sample2',
	subfeature => 'CDS',
);
# print "CDS position_score is \n" . print_hash(\%score1);
is($score1{3}, 0.482, 'score at position 3 in CDS region position scores');
is($score1{161}, 0.392, 'score at position 161 in CDS region position scores');



# test next feature 
$row = $stream->next_row;
is($row->name, 'YAL043C', 'Feature name');
$score = $row->get_score(
	dataset => 'data',
	'method'  => 'count',
	subfeature => 'exon',
);
is($score, 61, 'count score across exon');
$score = $row->get_score(
	dataset => 'data',
	'method'  => 'count',
	subfeature => 'cds',
);
is($score, 60, 'count score across multi-subfeature CDS');

%score1 = $row->get_region_position_scores(
	dataset => 'data:sample2',
	subfeature => 'cds',
);
# print "CDS position_score is \n" . print_hash(\%score1);
is($score1{322}, 0.461, 'score at position 321 in CDS region position scores');
is($score1{2314}, 0.262, 'score at position 2313 in CDS region position scores');



### Extra test for checking non-conforming chromosome name
# using sample.bed file as in other tests
undef $Data;
undef $stream;
$Data = Bio::ToolBox::Data->new(file => File::Spec->catfile($Bin, "Data", "sample.bed"));
isa_ok($Data, 'Bio::ToolBox::Data', 'BED Data');
$stream = $Data->row_stream;
$row = $stream->next_row;
$score = $row->get_score(
	db      => $ddb,
	dataset => 'data',
	'method'  => 'mean',
);
is(sprintf("%.2f", $score), -0.14, 'mean score across first bed feature');
$row = $stream->next_row;
$score = $row->get_score(
	db      => $ddb,
	dataset => 'data',
	'method'  => 'median',
);
is(sprintf("%.1f", $score), 0.5, 'median score across second bed feature with alt chromo');



### Test for sequence retrieval using Bio::DB::Fasta
# reusing the Data object immediately above
$Data->bam_adapter('none'); # to ensure we use BioPerl's Bio::DB::Fasta
my $fasta = File::Spec->catfile($Bin, "Data", "sequence.fa");
print "opening $fasta...\n";
my $fdb = Bio::ToolBox::Data->open_database($fasta);
isa_ok($fdb, 'Bio::DB::Fasta', 'BioPerl fasta adapter database');
# reuse row object from above, but we will specify our own coordinates since our 
# fasta file is too small and doesn't cover the bed coordinates
my $sequence = $row->get_sequence(
	db      => $fdb,
	seq_id  => 'chrI',
	start   => 257,
	end     => 275,
	strand  => 1,
);
is($sequence, 'ACCCTACCATTACCCTACC', 'fetched fasta sequence');
undef $fdb;
unlink "$fasta.index";


sub print_hash {
	my $hash = shift;
	foreach (sort {$a <=> $b} keys %$hash) {
		print "    $_\t=> " . $hash->{$_} . "\n";
	}
}
