lib/CXGN/Genotype/ComputeHybridGenotype.pm

   1 package CXGN::Genotype::ComputeHybridGenotype;
   2
   3 =head1 NAME
   4
   5 CXGN::Genotype::GRM - an object to handle fetching a GRM for stocks
   6
   7 =head1 USAGE
   8
   9 my $geno = CXGN::Genotype::ComputeHybridGenotype->new({
  10     parental_genotypes=>\@parental_genotypes,
  11     marker_objects=>\@marker_objects
  12 });
  13 my $hybrid_genotype = $geno->get_hybrid_genotype();
  14
  15 =head1 DESCRIPTION
  16
  17
  18 =head1 AUTHORS
  19
  20  Nicolas Morales <nm529@cornell.edu>
  21
  22 =cut
  23
  24 use strict;
  25 use warnings;
  26 use Moose;
  27 use Data::Dumper;
  28 use SGN::Model::Cvterm;
  29 use JSON;
  30 use POSIX;
  31 use List::Util qw(sum);
  32
  33 has 'parental_genotypes' => (
  34     isa => 'ArrayRef[HashRef]',
  35     is => 'rw',
  36     required => 1
  37 );
  38
  39 has 'marker_objects' => (
  40     isa => 'ArrayRef[HashRef]',
  41     is => 'rw',
  42     required => 1
  43 );
  44
  45 sub get_hybrid_genotype {
  46     my $self = shift;
  47     my $parental_genotypes = $self->parental_genotypes();
  48     my $marker_objects = $self->marker_objects();
  49
  50     # print STDERR Dumper $parental_genotypes;
  51
  52     # If there are more than one genotype for the parents given, will average them
  53     if (scalar(@$parental_genotypes)>2) {
  54         my %parental_genotypes;
  55         my @parental_genotypes_averaged;
  56         foreach my $g (@$parental_genotypes) {
  57             my $geno = $g->{selected_genotype_hash};
  58             my $parent = $g->{germplasmName};
  59             push @{$parental_genotypes{$parent}}, $geno;
  60         }
  61         while (my ($parent, $genos) = each %parental_genotypes) {
  62             my %averaged_parent_geno;
  63             foreach my $m (@$marker_objects) {
  64                 my $marker_name = $m->{name};
  65                 my @avg_ds;
  66                 foreach my $g (@$genos) {
  67                     my $ds = $g->{$marker_name}->{DS} ne 'NA' ? $g->{$marker_name}->{DS} : undef;
  68                     if (defined($ds)) {
  69                         push @avg_ds, $ds;
  70                     }
  71                 }
  72                 my $avg_ds_val;
  73                 if (scalar(@avg_ds) > 0) {
  74                     $avg_ds_val = sum(@avg_ds)/scalar(@avg_ds);
  75                 }
  76                 else {
  77                     $avg_ds_val = 'NA';
  78                 }
  79                 $averaged_parent_geno{$marker_name} = {DS => $avg_ds_val};
  80             }
  81             push @parental_genotypes_averaged, {
  82                 selected_genotype_hash => \%averaged_parent_geno
  83             }
  84         }
  85         $parental_genotypes = \@parental_genotypes_averaged;
  86     }
  87
  88     my @progeny_genotype;
  89     # If both parents are genotyped, calculate progeny genotype as a average of parent dosage
  90     if ($parental_genotypes->[0] && $parental_genotypes->[1]) {
  91         my $parent1_genotype = $parental_genotypes->[0]->{selected_genotype_hash};
  92         my $parent2_genotype = $parental_genotypes->[1]->{selected_genotype_hash};
  93         foreach my $m (@$marker_objects) {
  94             if ($parent1_genotype->{$m->{name}}->{DS} ne 'NA' || $parent2_genotype->{$m->{name}}->{DS} ne 'NA') {
  95                 my $p1 = $parent1_genotype->{$m->{name}}->{DS} ne 'NA' ? $parent1_genotype->{$m->{name}}->{DS} : 0;
  96                 my $p2 = $parent2_genotype->{$m->{name}}->{DS} ne 'NA' ? $parent2_genotype->{$m->{name}}->{DS} : 0;
  97                 push @progeny_genotype, ($p1 + $p2) / 2;
  98             }
  99             else {
 100                 push @progeny_genotype, 'NA';
 101             }
 102         }
 103     }
 104     elsif ($parental_genotypes->[0]) {
 105         my $parent1_genotype = $parental_genotypes->[0]->{selected_genotype_hash};
 106         foreach my $m (@$marker_objects) {
 107             if ($parent1_genotype->{$m->{name}}->{DS} ne 'NA') {
 108                 my $val = $parent1_genotype->{$m->{name}}->{DS};
 109                 push @progeny_genotype, $val/2;
 110             }
 111             else {
 112                 push @progeny_genotype, 'NA';
 113             }
 114         }
 115     }
 116     return \@progeny_genotype;
 117 }
 118
 119 1;