lib/SGN/Controller/solGS/Heritability.pm

   1 package SGN::Controller::solGS::Heritability;
   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('/heritability/check/data/') Args(0) {
  16     my ($self, $c) = @_;
  17
  18     my $pop_id   = $c->req->param('population_id');
  19     $c->stash->{pop_id} = $pop_id;
  20
  21     my $solgs_controller = $c->controller('solGS::solGS');
  22
  23     my $trait_id = $c->req->param('trait_id');
  24     $solgs_controller->get_trait_details($c, $trait_id);
  25
  26     $self->get_regression_data_files($c);
  27
  28     my $ret->{exists} = undef;
  29
  30     my $gebv_file  = $c->stash->{regression_gebv_file};
  31     my $pheno_file = $c->stash->{regression_pheno_file};
  32
  33     if(-s $gebv_file  && -s $pheno_file)
  34     {
  35         $ret->{exists} = 'yes';
  36     }
  37
  38     $ret = to_json($ret);
  39
  40     $c->res->content_type('application/json');
  41     $c->res->body($ret);
  42
  43 }
  44
  45
  46 sub get_regression_data_files {
  47     my ($self, $c) = @_;
  48
  49     my $pop_id     = $c->stash->{pop_id};
  50     my $trait_abbr = $c->stash->{trait_abbr};
  51     my $cache_dir  = $c->stash->{solgs_cache_dir};
  52
  53     my $solgs_controller = $c->controller('solGS::solGS');
  54
  55     my $phenotype_file = "phenotype_trait_${trait_abbr}_${pop_id}";
  56     $phenotype_file    = $solgs_controller->grep_file($cache_dir, $phenotype_file);
  57
  58     my $gebv_file = "gebv_kinship_${trait_abbr}_${pop_id}";
  59     $gebv_file    = $solgs_controller->grep_file($cache_dir,  $gebv_file);
  60
  61     $c->stash->{regression_gebv_file} = $gebv_file;
  62     $c->stash->{regression_pheno_file} = $phenotype_file;
  63
  64 }
  65
  66
  67 sub get_heritability {
  68     my ($self, $c) = @_;
  69
  70     my $trait_abbr = $c->stash->{trait_abbr};
  71     my $pop_id     = $c->stash->{pop_id};
  72
  73     my $solgs_controller = $c->controller('solGS::solGS');
  74     my $cache_dir = $c->stash->{solgs_cache_dir};
  75
  76     $solgs_controller->variance_components_file($c);
  77     my $var_comp_file = $c->stash->{variance_components_file};
  78
  79     my ($txt, $value) = map { split(/\t/)  }
  80                         grep {/Heritability/}
  81                         read_file($var_comp_file);
  82
  83     $c->stash->{heritability} = $value;
  84 }
  85
  86
  87 sub heritability_regeression_data :Path('/heritability/regression/data/') Args(0) {
  88     my ($self, $c) = @_;
  89
  90     my $pop_id   = $c->req->param('population_id');
  91     $c->stash->{pop_id} = $pop_id;
  92
  93     my $trait_id = $c->req->param('trait_id');
  94     my $solgs_controller = $c->controller('solGS::solGS');
  95     $solgs_controller->get_trait_details($c, $trait_id);
  96
  97     $self->get_regression_data_files($c);
  98
  99     my $gebv_file  = $c->stash->{regression_gebv_file};
 100     my $pheno_file = $c->stash->{regression_pheno_file};
 101
 102     my @gebv_data  = map { $_ =~ s/\n//; $_ }  read_file($gebv_file);
 103     my @pheno_data = map { $_ =~ s/\n//; $_ }  read_file($pheno_file);
 104
 105     @gebv_data  = map { [ split(/\t/) ] } @gebv_data;
 106     @pheno_data = map { [ split(/\t/) ] } @pheno_data;
 107
 108     my @pheno_values   = map { $_->[1] } @pheno_data;
 109     shift(@pheno_values);
 110     shift(@gebv_data);
 111     shift(@pheno_data);
 112
 113     my $stat = Statistics::Descriptive::Full->new();
 114     $stat->add_data(@pheno_values);
 115     my $pheno_mean = $stat->mean();
 116
 117     my $round = Math::Round::Var->new(0.01);
 118
 119     my @pheno_deviations = map { [$_->[0], $round->round(( $_->[1] - $pheno_mean ))] } @pheno_data;
 120
 121     $self->get_heritability($c);
 122     my $heritability = $c->stash->{heritability};
 123
 124     my $ret->{status} = 'failed';
 125
 126     if (@gebv_data && @pheno_data)
 127     {
 128         $ret->{status}           = 'success';
 129         $ret->{gebv_data}        = \@gebv_data;
 130         $ret->{pheno_deviations} = \@pheno_deviations;
 131         $ret->{pheno_data}       = \@pheno_data;
 132         $ret->{heritability}     = $heritability;
 133
 134     }
 135
 136     $ret = to_json($ret);
 137
 138     $c->res->content_type('application/json');
 139     $c->res->body($ret);
 140
 141 }
 142
 143
 144 sub begin : Private {
 145     my ($self, $c) = @_;
 146
 147     $c->controller("solGS::solGS")->get_solgs_dirs($c);
 148
 149 }
 150
 151
 152
 153 ####
 154 1;
 155 ####