The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests=> 15;

BEGIN{ use_ok('Bio::SNP::Inherit'); }

can_ok('Bio::SNP::Inherit', '_calculate_abh_from_F1');

my %explanation = (
    'A' => 'parentA genotype',
    'B' => 'parentB genotype',
    'H' => 'heterozygous genotype',
    '-' => 'missing data',
    '--' => 'missing parental data',
    '!' => 'nonparental',
    '!!' => 'nonparental F1',
    '~' => 'nonpolymorphic',
    '#' => 'nonpolymorphic conflict',
    '%' => 'polymorphic parent',
);

test_remove_matching_char('C', ['A', 'C', 'G'], ['A', 'G']); 
test_remove_matching_char('A', ['A', 'C', 'G'], ['C', 'G']); 

sub test_remove_matching_char{
    my $char = shift;
    my $starting_aref = shift;
    my $expected_aref = shift;

    my @starting_array = @{ $starting_aref };
    my @result_array = Bio::SNP::Inherit::_remove_matching_char($char, @starting_array);
is_deeply(\@result_array, $expected_aref, '_remove_matching_char');
    
}



test_abh_from_F1('CG',['CC','CC'], ['CG'],'H');
test_abh_from_F1('CC',['CC','CC'], ['CG'],'A');
test_abh_from_F1('GG',['CC','CC'], ['CG'],'B');
test_abh_from_F1('GG',['GG','GG'], ['GG'],'~');
test_abh_from_F1('CC',['GG','GG'], ['GG'],'#');
test_abh_from_F1('CC',['GC','GG'], ['GG'],'%');
test_abh_from_F1('CC',['GG','GG'], ['GG', 'CC', 'AA'],'!!');
test_abh_from_F1('CC',['GG','GG'], ['GG', 'CC'],'!!');
test_abh_from_F1('CC',['GG','GG'], ['--', '--'],'--');
test_abh_from_F1('CC',['GC','GG'], ['GG'],'%');
test_abh_from_F1('AA',['GC','GG'], ['GG'],'!');

sub test_abh_from_F1 {
    my $sample_gt    = shift;
    my $parentA_aref = shift;
    my $F1_aref      = shift;
    my $expected     = shift;

    my $result = Bio::SNP::Inherit::_calculate_abh_from_F1( $sample_gt, $parentA_aref, $F1_aref );

    my $parentA_values = "'" . join( "'\t'", @{$parentA_aref} ) . "'";
    my $F1_values      = "'" . join( "'\t'", @{$F1_aref} ) . "'";
    my $why            = $explanation{$expected};

    is( $result, $expected,
              "\nSample genotype: '$sample_gt'     \n"
            . "ParentA values:   $parentA_values \n"
            . "ParentF1 values:  $F1_values \n"
            . "Expected result:  $expected ($why)\n"
            . "Actual result:    $result         \n" );

}