https://github.com/AlexanderDilthey/MHC-PRG
Tip revision: e59943adb8855532573a6c276651efad1e18a6b1 authored by Alexander Dilthey on 18 December 2018, 10:20:48 UTC
Update HLA-PRG.md
Update HLA-PRG.md
Tip revision: e59943a
HLAtypeinference_validation.pl
#!/usr/bin/perl
BEGIN {
push(@INC, 'Toolbox');
}
# Comments denoted by ALL-HLA refer to changes which would become necessary if we wanted
# to create a graph for all HLA loci at the same time.
use strict;
use 5.010;
use List::MoreUtils qw/all mesh any /;
use Data::Dumper;
use Getopt::Long;
use Sys::Hostname;
use Commons;
use simpleHLA;
my $debug = 0;
my $all_2_dig = 0;
my $only_4_dig = 0;
my $T = 0.0;
my $reference_file;
my $panel_name;
my $training_snp_file;
GetOptions (
'panel_name:s' => \$panel_name,
'reference:s' => \$reference_file,
'all_2_dig:s' => \$all_2_dig,
'only_4_dig:s' => \$only_4_dig,
'T:s' => \$T,
'training_snp_file:s' => \$training_snp_file,
);
# read reference dataset
my %reference_data;
open(REFERENCE, "<", $reference_file) or die "Cannot open $reference_file";
my $headerLine = <REFERENCE>;
chomp($headerLine);
$headerLine =~ s/\n//g;
$headerLine =~ s/\r//g;
my @header_fields = split(/\s/, $headerLine);
while(<REFERENCE>)
{
my $line = $_;
chomp($line);
$line =~ s/\n//g;
$line =~ s/\r//g;
my @fields = split(/ /, $line);
my %line = (mesh @header_fields, @fields);
my $primary_key = $line{'IndividualID'};
$reference_data{$primary_key} = \%line;
}
close(REFERENCE);
# read imputations
my %imputed_HLA;
my %imputed_HLA_Calls;
print qq(
Validation
Panel name: $panel_name
T = $T
all_2_dig: $all_2_dig
only_4_dig: $only_4_dig
Reference: $reference_file
);
my $output_folder = '../tmp2/'.$panel_name;
unless(-e $output_folder)
{
die "Cannot find expected panel output folder: $output_folder";
}
my $pattern = $output_folder.'/*';
my @files = glob($pattern);
@files = grep {$_ =~ /(^|\/|\\)PP_(.+)_bestguess.txt/} @files;
my %loci_present;
my @loci;
my %quality_measures;
foreach my $file (@files)
{
die unless ($file =~ /PP_(\w+)_bestguess.txt/);
my $locus = $1;
#next unless (($locus eq 'A') || ($locus eq 'DQB') || ($locus eq 'DRB') || ($locus eq 'B'));
if($loci_present{$locus})
{
die "More than one file for locus $locus?";
}
push(@loci, $locus);
$loci_present{$locus} = 1;
print "Read file $file\n";
open(IMPUTATIONS, "<", $file) or die "Cannot open $file";
my $header = <IMPUTATIONS>;
chomp($header);
my @header_fields = split(/\s+/, $header);
while(<IMPUTATIONS>)
{
my $line = $_;
chomp($line);
my @fields = split(/\s+/, $line);
my %linehash = (mesh @header_fields, @fields);
my $indivID = $linehash{'IndividualID'};
my $chromo = $linehash{'Chromosome'};
my $hla_val = $linehash{'HLA'.$locus};
unless($hla_val)
{
$hla_val = $linehash{'KIR'.$locus};
}
($linehash{'HLA'.$locus} xor $linehash{'KIR'.$locus}) or die;
$hla_val or die "Value for $locus not present in $file, line $line -- expected field name $locus";
die "No quality field?" unless ((exists $linehash{'Q2'} ) or (exists $linehash{'Q'} )) ;
my $Q;
if(exists $linehash{'Q2'})
{
$Q = $linehash{'Q2'};
}
else
{
$Q = $linehash{'Q'};
}
if(exists $linehash{'P'})
{
$quality_measures{$indivID}{P} = $linehash{'P'}+0.0;
}
# $imputed_HLA_Calls{$locus}{sum}++;
if($Q < $T)
{
$imputed_HLA{$locus}{$indivID}{$chromo} = '0000';
}
else
{
$imputed_HLA{$locus}{$indivID}{$chromo} = $hla_val;
# $imputed_HLA_Calls{$locus}{called}++;
}
}
close(IMPUTATIONS);
}
my %training_allele_frequencies;
if($training_snp_file)
{
open(TRAINING, "<", $training_snp_file) or die "Cannot open $training_snp_file";
my $headerLine = <TRAINING>;
chomp($headerLine);
$headerLine =~ s/\n//g;
$headerLine =~ s/\r//g;
my @header_fields = split(/\s/, $headerLine);
my %complete_locus_names;
foreach my $locus (keys %loci_present)
{
my $f = 0;
if('KIR'.$locus ~~ \@header_fields)
{
$complete_locus_names{$locus} = 'KIR'.$locus;
$f++;
}
if('HLA'.$locus ~~ \@header_fields)
{
$complete_locus_names{$locus} = 'HLA'.$locus;
$f++;
}
die unless($f == 1);
}
while(<TRAINING>)
{
my $line = $_;
chomp($line);
$line =~ s/\n//g;
$line =~ s/\r//g;
my @fields = split(/ /, $line);
my %line = (mesh @header_fields, @fields);
foreach my $locus (keys %loci_present)
{
my @alleles = split(/\//, $line{$complete_locus_names{$locus}});
foreach my $allele (@alleles)
{
next if ($allele =~ /\?/);
if($all_2_dig)
{
$a = &simpleHLA::HLA_2digit($a);
}
$training_allele_frequencies{$locus}{$allele}++;
}
}
}
close(TRAINING);
}
foreach my $locus (keys %training_allele_frequencies)
{
my $a_sum = 0;
foreach my $allele (keys %{$training_allele_frequencies{$locus}})
{
$a_sum += $training_allele_frequencies{$locus}{$allele};
}
foreach my $allele (keys %{$training_allele_frequencies{$locus}})
{
$training_allele_frequencies{$locus}{$allele} = $training_allele_frequencies{$locus}{$allele}/$a_sum;
}
}
my %lls_correct_individuals;
my %lls_incorrect_individuals;
my $process_quality_measures = sub {
my $locus = shift;
my $individual_q_measures = shift;
my $num_correct = shift;
my $num_total = shift;
if(exists $individual_q_measures->{P})
{
my $P = $individual_q_measures->{P};
if($num_correct == $num_total)
{
push(@{$lls_correct_individuals{$locus}}, $P);
}
else
{
push(@{$lls_incorrect_individuals{$locus}}, $P);
}
}
};
# compare predictions
my %problem_haplo_counter;
my %problem_haplo_detail;
my %problem_locus_detail;
my %problem_locus_examined;
my %reference_predictions;
my %imputations_predictions;
my %locus_expected_OK;
my $comparisons;
my $compare_problems;
foreach my $locus (@loci)
{
my $arbitraty_indiv = (keys %reference_data)[0];
next unless((defined $reference_data{$arbitraty_indiv}{'HLA'.$locus}) or (defined $reference_data{$arbitraty_indiv}{'KIR'.$locus}));
$problem_locus_detail{$locus} = 0;
my @indivIDs = keys %{$imputed_HLA{$locus}};
INDIV: foreach my $indivID (@indivIDs)
{
$debug = 0;
my @imputed_hla_values = map { $imputed_HLA{$locus}{$indivID}{$_} } keys %{$imputed_HLA{$locus}{$indivID}};
my @reference_hla_values;
next INDIV unless($#imputed_hla_values == 1);
next INDIV unless(exists $reference_data{$indivID});
($reference_data{$indivID}{'HLA'.$locus} xor $reference_data{$indivID}{'KIR'.$locus}) or die;
if($reference_data{$indivID}{'HLA'.$locus})
{
@reference_hla_values = split(/\//, $reference_data{$indivID}{'HLA'.$locus});
}
else
{
@reference_hla_values = split(/\//, $reference_data{$indivID}{'KIR'.$locus});
}
die Dumper($reference_data{$indivID}, \@reference_hla_values) unless($#reference_hla_values == 1);
@reference_hla_values = grep {! &simpleHLA::is_missing($_)} @reference_hla_values;
if($only_4_dig)
{
next unless (&simpleHLA::HLA_is4digit($reference_hla_values[0]) and (($#reference_hla_values == 0) || (&simpleHLA::HLA_is4digit($reference_hla_values[1]))));
}
$imputed_HLA_Calls{$locus}{sum} += scalar(@imputed_hla_values);
@imputed_hla_values = grep {! &simpleHLA::is_missing($_)} @imputed_hla_values;
$imputed_HLA_Calls{$locus}{called} += scalar(@imputed_hla_values);
if($all_2_dig)
{
@reference_hla_values = map {&simpleHLA::HLA_2digit($_)} @reference_hla_values;
@imputed_hla_values = map {&simpleHLA::HLA_2digit($_)} @imputed_hla_values;
}
if($#imputed_hla_values == 1)
{
if($#reference_hla_values > -1)
{
if($#reference_hla_values == 0)
{
if(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[0]) or &compatible($locus, $reference_hla_values[0], $imputed_hla_values[1]))
{
$comparisons++;
$problem_locus_examined{$locus}++;
if(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[0]))
{
$reference_predictions{$locus}{$reference_hla_values[0]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{correct}++;
}
elsif(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[1]))
{
$reference_predictions{$locus}{$reference_hla_values[0]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{correct}++;
}
$process_quality_measures->($locus, $quality_measures{$indivID}, 1, 1);
}
else
{
$comparisons++;
$compare_problems++;
$problem_haplo_counter{$indivID}++;
$problem_haplo_detail{$indivID}{$locus} = 'Reference: '.join('/', @reference_hla_values).' VS Imputed: '.join('/', @imputed_hla_values).' (1 problem of 1)';
$problem_locus_detail{$locus}++;
$problem_locus_examined{$locus}++;
$reference_predictions{$locus}{$reference_hla_values[0]}{incorrect}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{incorrect} += 0.5;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{incorrect} += 0.5;
$process_quality_measures->($locus, $quality_measures{$indivID}, 0, 1);
}
if($training_snp_file)
{
my $f_a1 = $training_allele_frequencies{$locus}{$reference_hla_values[0]} ? $training_allele_frequencies{$locus}{$reference_hla_values[0]} : 0;
my $expected_OK = 2*$f_a1*(1-$f_a1)+($f_a1**2);
die unless($expected_OK <= 1);
$locus_expected_OK{$locus} += $expected_OK;
}
}
elsif($#reference_hla_values == 1)
{
if(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[0]) and &compatible($locus, $reference_hla_values[1], $imputed_hla_values[1]))
{
$comparisons += 2;
$problem_locus_examined{$locus} += 2;
$reference_predictions{$locus}{$reference_hla_values[0]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{correct}++;
$reference_predictions{$locus}{$reference_hla_values[1]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{correct}++;
$process_quality_measures->($locus, $quality_measures{$indivID}, 2, 2);
}
elsif(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[1]) and &compatible($locus, $reference_hla_values[1], $imputed_hla_values[0]))
{
$comparisons += 2;
$problem_locus_examined{$locus} += 2;
$reference_predictions{$locus}{$reference_hla_values[0]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{correct}++;
$reference_predictions{$locus}{$reference_hla_values[1]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{correct}++;
$process_quality_measures->($locus, $quality_measures{$indivID}, 2, 2);
}
else
{
if(
&compatible($locus, $reference_hla_values[0], $imputed_hla_values[0]) or &compatible($locus, $reference_hla_values[1], $imputed_hla_values[1]) or
&compatible($locus, $reference_hla_values[1], $imputed_hla_values[0]) or &compatible($locus, $reference_hla_values[0], $imputed_hla_values[1])
)
{
$comparisons += 2;
$compare_problems++;
$problem_haplo_counter{$indivID}++;
$problem_haplo_detail{$indivID}{$locus} = 'Reference: '.join('/', @reference_hla_values).' VS Imputed: '.join('/', @imputed_hla_values).' (1 problem of 2)';
$problem_locus_detail{$locus}++;
$problem_locus_examined{$locus} += 2;
if(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[0]))
{
$reference_predictions{$locus}{$reference_hla_values[0]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{correct}++;
$reference_predictions{$locus}{$reference_hla_values[1]}{incorrect}++;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{incorrect}++;
}
elsif(&compatible($locus, $reference_hla_values[1], $imputed_hla_values[1]))
{
$reference_predictions{$locus}{$reference_hla_values[1]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{correct}++;
$reference_predictions{$locus}{$reference_hla_values[0]}{incorrect}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{incorrect}++;
}
elsif(&compatible($locus, $reference_hla_values[1], $imputed_hla_values[0]))
{
$reference_predictions{$locus}{$reference_hla_values[1]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{correct}++;
$reference_predictions{$locus}{$reference_hla_values[0]}{incorrect}++;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{incorrect}++;
}
elsif(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[1]))
{
$reference_predictions{$locus}{$reference_hla_values[0]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{correct}++;
$reference_predictions{$locus}{$reference_hla_values[1]}{incorrect}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{incorrect}++;
}
$process_quality_measures->($locus, $quality_measures{$indivID}, 1, 2);
}
else
{
$comparisons += 2;
$compare_problems += 2;
$problem_haplo_counter{$indivID} += 2;
$problem_haplo_detail{$indivID}{$locus} = 'Reference: '.join('/', @reference_hla_values).' VS Imputed: '.join('/', @imputed_hla_values).' (2 problems of 2)';
$problem_locus_detail{$locus} += 2;
$problem_locus_examined{$locus} += 2;
$reference_predictions{$locus}{$reference_hla_values[0]}{incorrect}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{incorrect}++;
$reference_predictions{$locus}{$reference_hla_values[1]}{incorrect}++;
$imputations_predictions{$locus}{$imputed_hla_values[1]}{incorrect}++;
$process_quality_measures->($locus, $quality_measures{$indivID}, 0, 2);
}
}
if($training_snp_file)
{
my $expected_accuracy = 0;
my $f_a1 = $training_allele_frequencies{$locus}{$reference_hla_values[0]} ? $training_allele_frequencies{$locus}{$reference_hla_values[0]} : 0;
my $f_a2 = $training_allele_frequencies{$locus}{$reference_hla_values[1]} ? $training_allele_frequencies{$locus}{$reference_hla_values[1]} : 0;
if($reference_hla_values[0] ne $reference_hla_values[1])
{
$expected_accuracy += 2 * ($f_a1) * ($f_a2);
}
else
{
$expected_accuracy += ($f_a1) * ($f_a2);
}
$expected_accuracy *= 2;
die unless($expected_accuracy <= 2);
$locus_expected_OK{$locus} += $expected_accuracy;
}
}
else
{
die;
}
}
}
elsif($#imputed_hla_values == 0)
{
if($#reference_hla_values > -1)
{
if($#reference_hla_values == 0)
{
if(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[0]))
{
$comparisons++;
$problem_locus_examined{$locus}++;
$reference_predictions{$locus}{$reference_hla_values[0]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{correct}++;
$process_quality_measures->($locus, $quality_measures{$indivID}, 1, 1);
}
else
{
$comparisons++;
$compare_problems++;
$problem_haplo_counter{$indivID}++;
$problem_haplo_detail{$indivID}{$locus} = 'Reference: '.join('/', @reference_hla_values).' VS Imputed: '.join('/', @imputed_hla_values).' (1 problem of 1)';
$problem_locus_detail{$locus}++;
$problem_locus_examined{$locus}++;
$reference_predictions{$locus}{$reference_hla_values[0]}{incorrect}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{incorrect}++;
$process_quality_measures->($locus, $quality_measures{$indivID}, 0, 1);
}
if($training_snp_file)
{
my $f_a1 = $training_allele_frequencies{$locus}{$reference_hla_values[0]} ? $training_allele_frequencies{$locus}{$reference_hla_values[0]} : 0;
my $expected_OK = $f_a1;
die unless($expected_OK <= 1);
$locus_expected_OK{$locus} += $expected_OK;
}
}
elsif($#reference_hla_values == 1)
{
if(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[0]) or &compatible($locus, $reference_hla_values[1], $imputed_hla_values[0]))
{
$comparisons += 1;
$problem_locus_examined{$locus} += 1;
if(&compatible($locus, $reference_hla_values[0], $imputed_hla_values[0]))
{
$reference_predictions{$locus}{$reference_hla_values[0]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{correct}++;
}
elsif(&compatible($locus, $reference_hla_values[1], $imputed_hla_values[0]))
{
$reference_predictions{$locus}{$reference_hla_values[1]}{correct}++;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{correct}++;
}
$process_quality_measures->($locus, $quality_measures{$indivID}, 1, 1);
}
else
{
$comparisons++;
$compare_problems++;
$problem_haplo_counter{$indivID}++;
$problem_haplo_detail{$indivID}{$locus} = 'Reference: '.join('/', @reference_hla_values).' VS Imputed: '.join('/', @imputed_hla_values).' (1 problem of 1)';
$problem_locus_detail{$locus}++;
$problem_locus_examined{$locus}++;
$reference_predictions{$locus}{$reference_hla_values[0]}{incorrect} += 0.5;
$reference_predictions{$locus}{$reference_hla_values[1]}{incorrect} += 0.5;
$imputations_predictions{$locus}{$imputed_hla_values[0]}{incorrect}++;
$process_quality_measures->($locus, $quality_measures{$indivID}, 0, 1);
}
if($training_snp_file)
{
my $f_a1 = $training_allele_frequencies{$locus}{$reference_hla_values[0]} ? $training_allele_frequencies{$locus}{$reference_hla_values[0]} : 0;
my $f_a2 = $training_allele_frequencies{$locus}{$reference_hla_values[1]} ? $training_allele_frequencies{$locus}{$reference_hla_values[1]} : 0;
my $expected_OK = $f_a1+$f_a2;
die unless($expected_OK <= 1);
$locus_expected_OK{$locus} += $expected_OK;
}
}
else
{
die;
}
}
}
}
}
print "\n\n EXAMINED: $comparisons -- PROBLEMS: $compare_problems\n\n\n";
open(TMP_OUTPUT, '>', 'temp_validation_output.txt') or die;
print TMP_OUTPUT join("\t", qw/Locus N CallRate Accuracy ExpectationFromGuessing/), "\n";
print "PER-LOCUS SUMMARY:\n";
foreach my $key (sort keys %problem_locus_detail)
{
my $accuracy = sprintf("%.2f", 1 - (($problem_locus_examined{$key} != 0) ? $problem_locus_detail{$key}/$problem_locus_examined{$key} : 0));
my $CR = sprintf("%.2f", $imputed_HLA_Calls{$key}{sum} ? ($imputed_HLA_Calls{$key}{called}/$imputed_HLA_Calls{$key}{sum}) : 0);
my $expectedAcc = -1;
print "\t", $key, ": ", $problem_locus_detail{$key}, " of ", $problem_locus_examined{$key}, ", accuracy ", $accuracy, "\n";
print "\t\t Call rate: ", $CR, "\n";
if($training_snp_file)
{
$expectedAcc = sprintf("%.2f", $problem_locus_examined{$key} ? ($locus_expected_OK{$key}/$problem_locus_examined{$key}) : 0);
print "\t\t Expected accuracy from guessing:: ", $expectedAcc, "\n";
}
my @fields = ($key, $problem_locus_examined{$key}, $CR, $accuracy, $expectedAcc);
print TMP_OUTPUT join("\t", @fields), "\n";
}
close(TMP_OUTPUT);
#print Dumper($imputations_predictions{A});
print "\n\nPER-HAPLOTYPE SUMMARY:\n";
foreach my $key (keys %problem_haplo_counter)
{
#print "\t", $key, ": ", $problem_haplo_counter{$key}, "\n";
}
# print "\n\nCHECKED FIELDS:\n\n".Dumper(\%field_to_check)."\n\n";
# print "\n\n";
# print "HLA in REFERENCE en detail:\n";
# print Dumper($reference_predictions{DRB}), "\n\n";
# print "HLA in PREDICTIONS in detail\n";
# print Dumper($imputations_predictions{DRB});
foreach my $key (keys %problem_haplo_detail)
{
foreach my $fieldName (keys %{$problem_haplo_detail{$key}})
{
#next unless(($fieldName eq 'A') or ($fieldName eq 'B'));
#next unless($fieldName eq 'DQB');
#print $key, "\t", $fieldName, ": ", $problem_haplo_detail{$key}{$fieldName}, "\n";
}
}
if(1 == 0)
{
print "\n\nLikelihood analysis:\n";
foreach my $locus (sort keys %problem_locus_detail)
{
my $mean_correct;
my $mean_incorrect;
my $variance_correct;
my $variance_incorrect;
foreach my $v (@{$lls_correct_individuals{$locus}})
{
$mean_correct += $v;
}
$mean_correct = $mean_correct / scalar(@{$lls_correct_individuals{$locus}});
foreach my $v (@{$lls_incorrect_individuals{$locus}})
{
$mean_incorrect += $v;
}
$mean_incorrect = $mean_incorrect / scalar(@{$lls_incorrect_individuals{$locus}});
foreach my $v (@{$lls_correct_individuals{$locus}})
{
$variance_correct += ($v - $mean_correct)**2;
}
$variance_correct = $variance_correct / scalar(@{$lls_correct_individuals{$locus}});
foreach my $v (@{$lls_incorrect_individuals{$locus}})
{
$variance_incorrect += ($v - $mean_incorrect)**2
}
$variance_incorrect = $variance_incorrect / scalar(@{$lls_incorrect_individuals{$locus}});
$lls_correct_individuals{$locus} = [sort {$a <=> $b} @{$lls_correct_individuals{$locus}}];
$lls_incorrect_individuals{$locus} = [sort {$a <=> $b} @{$lls_incorrect_individuals{$locus}}];
my $lower_correct = int((scalar(@{$lls_correct_individuals{$locus}})-1)*0.1);
my $upper_correct = int((scalar(@{$lls_correct_individuals{$locus}})-1)*0.9);
my $lower_incorrect = int((scalar(@{$lls_incorrect_individuals{$locus}})-1)*0.1);
my $upper_incorrect = int((scalar(@{$lls_incorrect_individuals{$locus}})-1)*0.9);
my $correct_lower_value = $lls_correct_individuals{$locus}[$lower_correct];
my $correct_upper_value = $lls_correct_individuals{$locus}[$upper_correct];
my $incorrect_lower_value = $lls_incorrect_individuals{$locus}[$lower_incorrect];
my $incorrect_upper_value = $lls_incorrect_individuals{$locus}[$upper_incorrect];
print "\t$locus\n";
print "\t\t ", scalar(@{$lls_correct_individuals{$locus}}), " correct, mean likelihood $mean_correct\n";
print "\t\t\t sd ", sqrt($variance_correct), "\n";
print "\t\t\t from $correct_lower_value to $correct_upper_value \n";
print "\t\t ", scalar(@{$lls_incorrect_individuals{$locus}}), " false, mean likelihood $mean_incorrect\n";
print "\t\t\t sd ", sqrt($variance_incorrect), "\n";
print "\t\t\t from $incorrect_lower_value to $incorrect_upper_value \n\n";
}
}
sub compatible
{
my $locus = shift;
my $four_or_two_dig = shift;
my $four_dig = shift;
if($all_2_dig)
{
my $four_dig_reduced = &simpleHLA::HLA_2digit($four_dig);
# print &simpleHLA::HLA_2digit($four_or_two_dig), "\t", $four_dig_reduced, "\t", (&simpleHLA::HLA_2digit($four_or_two_dig) eq $four_dig_reduced) ? 1 : 0, "\n" if ($locus eq 'DRB');
return (&simpleHLA::HLA_2digit($four_or_two_dig) eq $four_dig_reduced) ? 1 : 0;
}
else
{
if(&simpleHLA::HLA_is4digit($four_or_two_dig))
{
return (&simpleHLA::HLA_4digit($four_or_two_dig) eq &simpleHLA::HLA_4digit($four_dig)) ? 1 : 0;
}
else
{
my $four_dig_reduced = &simpleHLA::HLA_2digit($four_dig);
return (&simpleHLA::HLA_2digit($four_or_two_dig) eq $four_dig_reduced) ? 1 : 0;
}
}
}