lib/SGN/Controller/solGS/gebvsComparison.pm

   1 =head1 AUTHOR
   2
   3 Isaak Y Tecle <iyt2@cornell.edu>
   4
   5 =head1 LICENSE
   6
   7 This library is free software. You can redistribute it and/or modify
   8 it under the same terms as Perl itself.
   9
  10 =head1 DESCRIPTION
  11
  12 SGN::Controller::solGS::gebvsComparison - Controller for comparing GEBVs of training and selection populations
  13
  14 =cut
  15
  16
  17 package SGN::Controller::solGS::gebvsComparison;
  18
  19 use Moose;
  20 use namespace::autoclean;
  21
  22 use JSON;
  23
  24
  25 BEGIN { extends 'Catalyst::Controller' }
  26
  27
  28
  29 sub get_training_pop_gebvs :Path('/solgs/get/gebvs/training/population/') Args(0) {
  30     my ($self, $c) = @_;
  31
  32     $c->stash->{training_pop_id} = $c->req->param('training_pop_id');
  33     $c->stash->{trait_id}        = $c->req->param('trait_id');
  34     $c->stash->{population_type} = 'training_population';
  35
  36     my $ret->{gebv_exists} = undef;
  37
  38     $self->get_training_pop_gebv_file($c);
  39     my $gebv_file = $c->stash->{training_gebv_file};
  40
  41     if (-s $gebv_file)
  42     {
  43         $c->stash->{gebv_file} = $gebv_file;
  44         $self->get_gebv_arrayref($c);
  45         my $gebv_arrayref = $c->stash->{gebv_arrayref};
  46
  47         $ret->{gebv_exists} = 1;
  48         $ret->{gebv_arrayref} = $gebv_arrayref;
  49     }
  50
  51     $ret = to_json($ret);
  52
  53     $c->res->content_type('application/json');
  54     $c->res->body($ret);
  55
  56 }
  57
  58
  59 sub get_selection_pop_gebvs :Path('/solgs/get/gebvs/selection/population/') Args(0) {
  60     my ($self, $c) = @_;
  61
  62     $c->stash->{selection_pop_id} = $c->req->param('selection_pop_id');
  63     $c->stash->{training_pop_id}  = $c->req->param('training_pop_id');
  64     $c->stash->{trait_id}         = $c->req->param('trait_id');
  65     $c->stash->{population_type}  = 'selection_population';
  66
  67     my $ret->{gebv_exists} = undef;
  68
  69     $self->get_selection_pop_gebv_file($c);
  70     my $gebv_file = $c->stash->{selection_gebv_file};
  71
  72     if (-s $gebv_file)
  73     {
  74         $c->stash->{gebv_file} = $gebv_file;
  75         $self->get_gebv_arrayref($c);
  76         my $gebv_arrayref = $c->stash->{gebv_arrayref};
  77
  78         $ret->{gebv_exists} = 1;
  79         $ret->{gebv_arrayref} = $gebv_arrayref;
  80     }
  81
  82     $ret = to_json($ret);
  83
  84     $c->res->content_type('application/json');
  85     $c->res->body($ret);
  86
  87 }
  88
  89
  90 sub get_training_pop_gebv_file {
  91     my ($self, $c) = @_;
  92
  93     my $pop_id   = $c->stash->{training_pop_id};
  94     my $trait_id = $c->stash->{trait_id};
  95
  96     $c->controller('solGS::solGS')->get_trait_details($c, $trait_id);
  97     my $trait_abbr = $c->stash->{trait_abbr};
  98
  99     my $gebv_file;
 100
 101     if ($pop_id && $trait_id)
 102     {
 103         my $dir  = $c->stash->{solgs_cache_dir};
 104         my $file = "gebv_kinship_${trait_abbr}_${pop_id}";
 105
 106         $gebv_file = $c->controller('solGS::solGS')->grep_file($dir, $file);
 107
 108     }
 109
 110     $c->stash->{training_gebv_file} = $gebv_file;
 111
 112 }
 113
 114
 115 sub get_selection_pop_gebv_file {
 116     my ($self, $c) = @_;
 117
 118     my $selection_pop_id   = $c->stash->{selection_pop_id};
 119     my $training_pop_id    = $c->stash->{training_pop_id};
 120     my $trait_id           = $c->stash->{trait_id};
 121
 122     my $gebv_file;
 123
 124     if ($selection_pop_id && $trait_id && $training_pop_id)
 125     {
 126         my $dir  = $c->stash->{solgs_cache_dir};
 127         my $identifier = $training_pop_id . "_" . $selection_pop_id;
 128         my $file = "prediction_pop_gebvs_${identifier}_${trait_id}";
 129         $gebv_file = $c->controller('solGS::solGS')->grep_file($dir, $file);
 130     }
 131
 132     $c->stash->{selection_gebv_file} = $gebv_file;
 133
 134 }
 135
 136
 137 sub get_gebv_arrayref {
 138     my ($self, $c) = @_;
 139
 140     my $file = $c->stash->{gebv_file};
 141     my $gebv_arrayref = $c->controller('solGS::solGS')->convert_to_arrayref_of_arrays($c, $file);
 142
 143     $c->stash->{gebv_arrayref} = $gebv_arrayref;
 144 }
 145
 146
 147 sub check_population_type {
 148     my ($self, $c, $pop_id) = @_;
 149
 150     my $type = $c->model('solGS::solGS')->get_population_type($pop_id);
 151
 152     $c->stash->{population_type} = $type;
 153 }
 154
 155
 156 sub begin : Private {
 157     my ($self, $c) = @_;
 158
 159     $c->controller("solGS::solGS")->get_solgs_dirs($c);
 160
 161 }
 162
 163
 164 ####
 165 1;
 166 ####