# $Id: 09-matrix.t 1622 2011-03-23 15:02:21Z rvos $
use strict;
use Bio::Phylo::Util::CONSTANT 'looks_like_instance';
use Test::More 'no_plan';
use Bio::Phylo::Matrices::Datum;
use Bio::Phylo::Matrices::Matrix;
use Bio::Phylo;
use Bio::Phylo::Taxa::Taxon;
use Bio::Phylo::Taxa;
ok( my $matrix = Bio::Phylo::Matrices::Matrix->new( -type => 'STANDARD' ),
    '1 initialize' );
$matrix->VERBOSE( -level => 0 );
eval { $matrix->insert('BAD!') };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::ObjectMismatch' ),
    '2 insert bad data' );
my $datum = Bio::Phylo::Matrices::Datum->new;
my $taxon = Bio::Phylo::Taxa::Taxon->new;
my $taxa  = Bio::Phylo::Taxa->new;
$datum->set_name('datum');
$datum->set_type('STANDARD');
$datum->set_char('5');
$datum->set_taxon($taxon);
$taxa->insert($taxon);
$matrix->set_taxa($taxa);
ok( $matrix->insert($datum), '3 insert good data' );

# the get method
eval { $matrix->get('frobnicate') };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::UnknownMethod' ),
    '4 get bad method' );
ok( $matrix->get('get_entities'), '5 get good method' );

# the get_data method
ok( $matrix->get_entities, '6 get data' );

# the get_by_value method
ok( $matrix->get_by_value( -value => 'get_char', -lt => 6 ),
    '7 get by value lt' );
ok( $matrix->get_by_value( -value => 'get_char', -le => 5 ),
    '8 get by value le' );
ok( $matrix->get_by_value( -value => 'get_char', -gt => 4 ),
    '9 get by value gt' );
ok( $matrix->get_by_value( -value => 'get_char', -ge => 5 ),
    '10 get by value ge' );
ok( $matrix->get_by_value( -value => 'get_char', -eq => 5 ),
    '11 get by value eq' );
ok( !scalar @{ $matrix->get_by_value( -value => 'get_char', -lt => 4 ) },
    '12 get by value lt' );
ok( !scalar @{ $matrix->get_by_value( -value => 'get_char', -le => 4 ) },
    '13 get by value le' );
ok( !scalar @{ $matrix->get_by_value( -value => 'get_char', -gt => 6 ) },
    '14 get by value gt' );
ok( !scalar @{ $matrix->get_by_value( -value => 'get_char', -ge => 6 ) },
    '15 get by value ge' );
ok( !scalar @{ $matrix->get_by_value( -value => 'get_char', -eq => 6 ) },
    '16 get by value eq' );
eval { $matrix->get_by_value( -value => 'frobnicate', -lt => 4 ) };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::UnknownMethod' ),
    '17 get by value lt' );
eval { $matrix->get_by_value( -value => 'frobnicate', -le => 4 ) };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::UnknownMethod' ),
    '18 get by value le' );
eval { $matrix->get_by_value( -value => 'frobnicate', -gt => 6 ) };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::UnknownMethod' ),
    '19 get by value gt' );
eval { $matrix->get_by_value( -value => 'frobnicate', -ge => 6 ) };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::UnknownMethod' ),
    '20 get by value ge' );
eval { $matrix->get_by_value( -value => 'frobnicate', -eq => 6 ) };
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::UnknownMethod' ),
    '21 get by value eq' );
ok(
    $matrix->get_by_regular_expression(
        -value => 'get_type',
        -match => qr/^STANDARD$/
    ),
    '22 get by re'
);
eval {
    $matrix->get_by_regular_expression(
        -value => 'frobnicate',
        -match => qr/^STANDARD$/
    );
};
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::UnknownMethod' ),
    '23 get by re' );
ok(
    !scalar @{
        $matrix->get_by_regular_expression(
            -value => 'get_type',
            -match => qr/^DNA$/
        )
      },
    '24 get by re'
);
eval {
    $matrix->get_by_regular_expression(
        -value      => 'get_type',
        -frobnicate => qr/^DNA$/
    );
};
ok( looks_like_instance( $@, 'Bio::Phylo::Util::Exceptions::BadArgs' ),
    '25 get by re' );
ok( $matrix->DESTROY, '26 destroy' );
ok(
    Bio::Phylo::Matrices::Matrix->new(
        -type   => 'standard',
        -lookup => {
            '-' => [],
            '1' => ['1'],
            '2' => ['2'],
            '3' => ['3'],
            '?' => [ '1', '2', '3' ],
        },
        -matrix =>
          [ [ 'a' => 1, 1, 1 ], [ 'b' => 2, 2, 2 ], [ 'c' => 3, 3, 3 ], ],
      )->to_nexus,
    '27 expanded constructor'
);
my $prune_candidate = Bio::Phylo::Matrices::Matrix->new(
    -type   => 'standard',
    -lookup => {
        '-' => [],
        '1' => ['1'],
        '2' => ['2'],
        '3' => ['3'],
        '?' => [ '1', '2', '3' ],
    },
    -matrix => [ [ 'a' => 1, 1, 1 ], [ 'b' => 2, 2, 2 ], [ 'c' => 3, 3, 3 ], ],
);
my $pruned = $prune_candidate->prune_chars( [ 0, 1 ] );
ok( $pruned->get_nchar == 1, '28 pruning keeps one char' );
my $kept = $prune_candidate->keep_chars( [2] );
ok( $pruned->get_nchar == 1, '29 keeping on char' );
{
    my $dna = Bio::Phylo::Matrices::Matrix->new(
        -type   => 'dna',
        -matrix => [
            [ 'a' => qw(A C G T) ],
            [ 'b' => qw(A G C T) ],
            [ 'c' => qw(A C G T) ],
        ],
    );
    like( $dna->get_type, qr/dna/i, '30 created dna matrix' );
    is( $dna->get_nchar, 4, '31 dna matrix has 4 columns' );
    is( $dna->get_ntax,  3, '32 dna matrix has 3 rows' );
    my $freq = $dna->calc_state_frequencies;
    is( $freq->{$_}, 0.25, "33 state frequency for $_" ) for qw(A C G T);
    my $abs = $dna->calc_state_counts;
    is( $abs->{$_}, 3, "34 state count for $_" ) for qw(A C G T);
    is( $dna->calc_prop_invar, 0.5, "35 half of the sites invariant" );
}
{
    my $matrix = Bio::Phylo::Matrices::Matrix->new(
        '-type'   => 'dna',
        '-matrix' => [
            [qw'taxon1 G T G T G T G T G T G T G T G T G T G T G T G'],
            [qw'taxon2 A G A G A G A G A G A G A G A G A G A G A G A'],
            [qw'taxon3 T C T C T C T C T C T C T C T C T C T C T C T'],
            [qw'taxon4 T C T C T C T C T C T C T C T C T C T C T C T'],
            [qw'taxon5 A A A A A A A A A A A A A A A A A A A A A A A'],
            [qw'taxon6 C G C G C G C G C G C G C G C G C G C G C G C'],
            [qw'taxon7 A A A A A A A A A A A A A A A A A A A A A A A'],
        ]
    );
    my $expected = [
        [ 12, [ 'G', 'A', 'T', 'T', 'A', 'C', 'A' ] ],
        [ 11, [ 'T', 'G', 'C', 'C', 'A', 'G', 'A' ] ],
    ];
    my $observed = [ sort { $b->[0] <=> $a->[0] } @{ $matrix->calc_distinct_site_patterns } ];
    is_deeply( $observed, $expected, "36 site patterns" );
}
{
    my $matrix = Bio::Phylo::Matrices::Matrix->new(
        '-type'   => 'dna',
        '-matrix' => [ [qw'taxon1 A C G T C G'], [qw'taxon2 A C G T C G'], ]
    );
    is( $matrix->calc_gc_content, 2 / 3, '37 calc G+C content' );
}
{
    my $matrix = Bio::Phylo::Matrices::Matrix->new(
        '-type'   => 'dna',
        '-matrix' => [ [qw'taxon1 A C G T C G'], [qw'taxon2 A C G T C G'], ],
        '-charlabels' => [qw'c1 c2 c3 c4 c5 c6']
    );
    my $char  = $matrix->get_characters;
    my @chars = @{ $char->get_entities };
    is( scalar @chars, 6, '38 characters created' );
    for my $c (@chars) {
        isa_ok(
            $c,
            'Bio::Phylo::Matrices::Character',
            '39 characters right type'
        );
    }
}
{
    my $matrix = Bio::Phylo::Matrices::Matrix->new(
        '-type'   => 'standard',
        '-matrix' => [
            [qw'taxon_1 ? 1 1 1 1'],
            [qw'taxon_2 ? ? 2 1 1'],
            [qw'taxon_3 ? ? 2 2 2'],
            [qw'taxon_4 ? ? 2 2 2'],
            [qw'taxon_5 ? ? ? 2 ?'],
        ],
        '-charlabels' => [
            qw'allmissing autapomorphy autapomorphy2 informative informative2'
        ],
    );
    {
        my $informative = $matrix->prune_uninformative;    
        my @expected_informative_labels = qw'informative informative2';
        my @observed_informative_labels = @{ $informative->get_charlabels };
        is( $informative->get_nchar, 2, '40 pruned uninformative');
        is_deeply( \@expected_informative_labels, \@observed_informative_labels, '41 pruned character labels match');
    }
    {
        my $variant = $matrix->prune_invariant;
        my @expected_variant_labels = qw'autapomorphy2 informative informative2';
        my @observed_variant_labels = @{ $variant->get_charlabels };
        is( $variant->get_nchar, 3, '42 pruned invariant');
        is_deeply( \@expected_variant_labels, \@observed_variant_labels, '43 pruned character labels match');
    }
}