lib/SGN/Controller/solGS/gebvPhenoRegression.pm

   1 package SGN::Controller::solGS::gebvPhenoRegression;
   2
   3 use Moose;
   4 use namespace::autoclean;
   5
   6 use File::Slurp qw /write_file read_file/;
   7 use JSON;
   8 use Math::Round::Var;
   9 use Statistics::Descriptive;
  10
  11
  12 BEGIN { extends 'Catalyst::Controller' }
  13
  14
  15 sub check_regression_data :Path('/solgs/check/regression/data/') Args(0) {
  16     my ($self, $c) = @_;
  17
  18     my $args = $c->req->param('arguments');
  19     $c->controller('solGS::Utils')->stash_json_args($c, $args);
  20
  21     my $trait_id = $c->stash->{'trait_id'};
  22     $c->controller('solGS::Trait')->get_trait_details($c, $trait_id);
  23
  24     $self->get_regression_data_files($c);
  25
  26     my $ret->{exists} = undef;
  27
  28     my $gebv_file  = $c->stash->{regression_gebv_file};
  29     my $pheno_file = $c->stash->{regression_pheno_file};
  30
  31     if(-s $gebv_file  && -s $pheno_file)
  32     {
  33         $ret->{exists} = 1;
  34     }
  35
  36     $ret = to_json($ret);
  37
  38     $c->res->content_type('application/json');
  39     $c->res->body($ret);
  40
  41 }
  42
  43
  44 sub get_regression_data_files {
  45     my ($self, $c) = @_;
  46
  47     my $pop_id     = $c->stash->{training_pop_id};
  48     my $trait_abbr = $c->stash->{trait_abbr};
  49     my $cache_dir  = $c->stash->{solgs_cache_dir};
  50
  51     $c->controller('solGS::Files')->model_phenodata_file($c);
  52     my $phenotype_file = $c->stash->{model_phenodata_file};
  53
  54     $c->controller('solGS::Files')->rrblup_training_gebvs_file($c);
  55     my $gebv_file = $c->stash->{rrblup_training_gebvs_file};
  56
  57     $c->stash->{regression_gebv_file} = $gebv_file;
  58     $c->stash->{regression_pheno_file} = $phenotype_file;
  59
  60 }
  61
  62
  63 sub get_heritability {
  64     my ($self, $c, $pop_id, $trait_id) = @_;
  65
  66     $c->controller('solGS::Trait')->get_trait_details($c, $trait_id);
  67
  68     $c->controller('solGS::Files')->variance_components_file($c);
  69     my $var_comp_file = $c->stash->{variance_components_file};
  70
  71     my ($txt, $value) = map { split(/\t/)  }
  72                         grep {/SNP heritability/}
  73                         read_file($var_comp_file, {binmode => ':utf8'});
  74
  75     return $value;
  76
  77 }
  78
  79
  80 sub get_additive_variance {
  81     my ($self, $c, $pop_id, $trait_id) = @_;
  82
  83     $c->controller('solGS::Trait')->get_trait_details($c, $trait_id);
  84
  85     $c->controller('solGS::Files')->variance_components_file($c);
  86     my $var_comp_file = $c->stash->{variance_components_file};
  87
  88     my ($txt, $value) = map { split(/\t/)  }
  89                         grep {/Additive genetic/}
  90                         read_file($var_comp_file, {binmode => ':utf8'});
  91
  92     return $value;
  93
  94 }
  95
  96
  97 sub get_regeression_data :Path('/solgs/get/regression/data/') Args(0) {
  98     my ($self, $c) = @_;
  99
 100     my $args = $c->req->param('arguments');
 101     $c->controller('solGS::Utils')->stash_json_args($c, $args);
 102
 103     my $trait_id = $c->stash->{'trait_id'};
 104     $c->controller('solGS::Trait')->get_trait_details($c, $trait_id);
 105
 106     $self->get_regression_data_files($c);
 107
 108     my $gebv_file  = $c->stash->{regression_gebv_file};
 109     my $pheno_file = $c->stash->{regression_pheno_file};
 110
 111     my @gebv_data  = map { $_ =~ s/\n//; $_ }  read_file($gebv_file, {binmode => ':utf8'});
 112     my @pheno_data = map { $_ =~ s/\n//; $_ }  read_file($pheno_file, {binmode => ':utf8'});
 113
 114     @gebv_data  = map { [ split(/\t/) ] } @gebv_data;
 115     @pheno_data = map { [ split(/\t/) ] } @pheno_data;
 116
 117     my @pheno_values   = map { $_->[1] } @pheno_data;
 118     shift(@pheno_values);
 119     shift(@gebv_data);
 120     shift(@pheno_data);
 121
 122     my $stat = Statistics::Descriptive::Full->new();
 123     $stat->add_data(@pheno_values);
 124     my $pheno_mean = $stat->mean();
 125
 126     my $round = Math::Round::Var->new(0.01);
 127
 128     my @pheno_deviations = map { [$_->[0], $round->round(( $_->[1] - $pheno_mean ))] } @pheno_data;
 129
 130     my $pop_id = $c->stash->{'training_pop_id'};
 131     my $heritability =  $self->get_heritability($c, $pop_id, $trait_id);
 132
 133     my $ret->{status} = undef;
 134
 135     if (@gebv_data && @pheno_data)
 136     {
 137         $ret->{status} = 1;
 138         $ret->{gebv_data}        = \@gebv_data;
 139         $ret->{pheno_deviations} = \@pheno_deviations;
 140         $ret->{pheno_data}       = \@pheno_data;
 141         $ret->{heritability}     = $heritability;
 142
 143     }
 144
 145     $ret = to_json($ret);
 146
 147     $c->res->content_type('application/json');
 148     $c->res->body($ret);
 149
 150 }
 151
 152
 153 sub begin : Private {
 154     my ($self, $c) = @_;
 155
 156     $c->controller('solGS::Files')->get_solgs_dirs($c);
 157
 158 }
 159
 160
 161
 162 ####
 163 1;
 164 ####