lib/SGN/Controller/solGS/SelectionIndex.pm

   1 package SGN::Controller::solGS::SelectionIndex;
   2
   3 use Moose;
   4 use namespace::autoclean;
   5
   6 use File::Basename;
   7 use File::Path qw / mkpath  /;
   8 use File::Slurp qw /write_file read_file/;
   9 use File::Spec::Functions qw / catfile catdir/;
  10 use List::MoreUtils qw /uniq/;
  11
  12 use JSON;
  13
  14
  15 BEGIN { extends 'Catalyst::Controller::REST' }
  16
  17
  18
  19 __PACKAGE__->config(
  20     default   => 'application/json',
  21     stash_key => 'rest',
  22     map       => { 'application/json' => 'JSON'},
  23     );
  24
  25
  26 sub selection_index_form :Path('/solgs/selection/index/form') Args(0) {
  27     my ($self, $c) = @_;
  28
  29
  30     my $args = $c->req->param('arguments');
  31     $c->controller('solGS::Utils')->stash_json_args($c, $args);
  32     my $selection_pop_id = $c->stash->{'selection_pop_id'};
  33     my $training_pop_id  = $c->stash->{'training_pop_id'};
  34
  35     my $traits;
  36     if ($selection_pop_id)
  37     {
  38             $c->controller('solGS::Gebvs')->selection_pop_analyzed_traits($c, $training_pop_id, $selection_pop_id);
  39         $traits = $c->stash->{selection_pop_analyzed_traits};
  40     }
  41     else
  42     {
  43             $c->controller('solGS::Gebvs')->training_pop_analyzed_traits($c);
  44         $traits = $c->stash->{selection_index_traits};
  45     }
  46
  47     my $ret->{status} = 'success';
  48     $ret->{traits} = $traits;
  49
  50     $c->stash->{rest} = $ret;
  51
  52 }
  53
  54
  55 sub calculate_selection_index :Path('/solgs/calculate/selection/index') Args() {
  56     my ($self, $c) = @_;
  57
  58     my $args = $c->req->param('arguments');
  59     $c->controller('solGS::Utils')->stash_json_args($c, $args);
  60
  61     my $values = $self->check_si_form_wts($c);
  62
  63     my $ret->{status} = 'Selection index failed.';
  64     if ($values->[0])
  65     {
  66         $self->save_rel_weights($c);
  67         $self->calc_selection_index($c);
  68
  69         $self->prep_download_si_files($c);
  70         my $sindex_file = $c->stash->{download_sindex};
  71         my $gebvs_sindex_file = $c->stash->{download_gebvs_sindex};
  72
  73         my $index_file = $c->stash->{selection_index_only_file};
  74         my $si_data = $c->controller("solGS::Utils")->read_file_data($index_file);
  75
  76         my $sindex_name  = $c->controller('solGS::Files')->create_file_id($c);
  77
  78         $ret->{status} = 'No GEBV values to rank.';
  79
  80         if (@$si_data)
  81         {
  82             $ret->{status} = 'success';
  83             $ret->{indices} = $si_data;
  84             $ret->{index_file} = $index_file;
  85                 $ret->{sindex_name} = $sindex_name;
  86             $ret->{sindex_file}  =  $sindex_file;
  87             $ret->{gebvs_sindex_file}  =  $gebvs_sindex_file;
  88         }
  89     }
  90     else
  91     {
  92             $ret->{status} = 'No relative weights submitted';
  93     }
  94
  95     $c->stash->{rest} = $ret;
  96 }
  97
  98
  99 sub download_selection_index :Path('/solgs/download/selection/index') Args(1) {
 100     my ($self, $c, $sindex_name) = @_;
 101
 102     $c->stash->{sindex_name} = $sindex_name;
 103
 104     $self->prep_download_si_files($c);
 105         my $sindex_file = $c->stash->{download_sindex};
 106     my $gebvs_sindex_file = $c->stash->{download_gebvs_sindex};
 107
 108         $c->stash->{rest}{sindex_file}  =  $sindex_file;
 109     $c->stash->{rest}{sindex_file}  =  $gebvs_sindex_file;
 110
 111 }
 112
 113 sub prep_download_si_files {
 114     my ($self, $c) = @_;
 115
 116     my $tmp_dir = catfile($c->config->{tempfiles_subdir}, 'selectionindex');
 117     my $base_tmp_dir = catfile($c->config->{basepath}, $tmp_dir);
 118
 119     mkpath ([$base_tmp_dir], 0, 0755);
 120
 121     $self->selection_index_file($c);
 122     my $sindex_file = $c->stash->{selection_index_only_file};
 123
 124     $self->gebvs_selection_index_file($c);
 125     my $gebvs_sindex_file = $c->stash->{gebvs_selection_index_file};
 126
 127     $c->controller('solGS::Files')->copy_file($sindex_file, $base_tmp_dir);
 128     $c->controller('solGS::Files')->copy_file($gebvs_sindex_file, $base_tmp_dir);
 129
 130     $sindex_file = fileparse($sindex_file);
 131     $sindex_file = catfile($tmp_dir, $sindex_file);
 132
 133     $gebvs_sindex_file = fileparse($gebvs_sindex_file);
 134     $gebvs_sindex_file = catfile($tmp_dir, $gebvs_sindex_file);
 135
 136     $c->stash->{download_sindex} = $sindex_file;
 137     $c->stash->{download_gebvs_sindex} = $gebvs_sindex_file;
 138
 139 }
 140
 141 sub check_si_form_wts {
 142     my ($self, $c) = @_;
 143
 144     my $rel_wts = $self->get_rel_wts_hash($c);
 145     my @traits = keys (%$rel_wts);
 146     @traits    = grep {$_ ne 'rank'} @traits;
 147
 148     my @values;
 149     foreach my $tr (@traits)
 150     {
 151         push @values, $rel_wts->{$tr};
 152     }
 153
 154     return \@values;
 155
 156 }
 157
 158
 159 sub si_input_files {
 160     my ($self, $c) = @_;
 161
 162     $c->controller('solGS::Gebvs')->get_gebv_files_of_traits($c);
 163     $self->rel_weights_file($c);
 164
 165     my $input_files = join("\t",
 166                            $c->stash->{rel_weights_file},
 167                            $c->stash->{gebv_files_of_traits}
 168         );
 169
 170     my $file_id = $c->controller('solGS::Files')->create_file_id($c);
 171     my $temp_dir = $c->stash->{selection_index_temp_dir};
 172
 173     my $in_name = "input_files_selection_index_${file_id}";
 174     my $input_file = $c->controller('solGS::Files')->create_tempfile($temp_dir, $in_name);
 175     write_file($input_file, {binmode => ':utf8'}, $input_files);
 176
 177     return $input_file;
 178
 179 }
 180
 181
 182 sub si_output_files {
 183     my ($self, $c) = @_;
 184
 185     $self->gebvs_selection_index_file($c);
 186     $self->selection_index_file($c);
 187
 188     my $output_files = join("\t",
 189                             $c->stash->{gebvs_selection_index_file},
 190                             $c->stash->{selection_index_only_file}
 191         );
 192
 193     my $file_id = $c->controller('solGS::Files')->create_file_id($c);
 194     my $out_name = "output_files_selection_index_${file_id}";
 195     my $temp_dir = $c->stash->{selection_index_temp_dir};
 196     my $output_file = $c->controller('solGS::Files')->create_tempfile($temp_dir, $out_name);
 197     write_file($output_file, {binmode => ':utf8'}, $output_files);
 198
 199     return $output_file;
 200
 201 }
 202
 203
 204 sub calc_selection_index {
 205     my ($self, $c) = @_;
 206
 207     my $file_id = $c->controller('solGS::Files')->create_file_id($c);
 208     $c->stash->{analysis_tempfiles_dir} = $c->stash->{selection_index_temp_dir};
 209     $c->stash->{output_files} = $self->si_output_files($c);
 210     $c->stash->{input_files}  = $self->si_input_files($c);
 211     $c->stash->{r_temp_file}  = "selection_index_${file_id}";
 212     $c->stash->{r_script}     = 'R/solGS/selection_index.r';
 213
 214     $c->controller('solGS::AsyncJob')->run_r_script($c);
 215
 216 }
 217
 218
 219 sub get_top_10_selection_indices {
 220     my ($self, $c) = @_;
 221
 222     my $si_file = $c->stash->{selection_index_only_file};
 223     my $top_10 = $c->controller('solGS::Utils')->top_10($si_file);
 224
 225     $c->stash->{top_10_selection_indices} = $top_10;
 226 }
 227
 228
 229 sub download_sindex_url {
 230     my ($self, $c) = @_;
 231
 232
 233     my $sindex_name = $c->controller('solGS::Files')->create_file_id($c);
 234     my $url = qq | <a href="/solgs/download/selection/index/$sindex_name">Download selection indices</a> |;
 235
 236     $c->stash->{selection_index_download_url} = $url;
 237
 238 }
 239
 240
 241 sub get_rel_wts_hash {
 242     my ($self, $c) = @_;
 243
 244     my $traits_wts = $c->stash->{rel_wts};
 245     my $json = JSON->new();
 246     my $rel_wts = $json->decode($traits_wts);
 247
 248     return $rel_wts;
 249
 250 }
 251
 252 sub save_rel_weights {
 253     my ($self, $c) = @_;
 254
 255     my $rel_wts = $self->get_rel_wts_hash($c);
 256
 257     my @si_wts;
 258     my $rel_wts_txt = "trait" . "\t" . 'relative_weight' . "\n";
 259
 260     foreach my $tr (sort keys %$rel_wts)
 261     {
 262         my $wt = $rel_wts->{$tr};
 263         unless ($tr eq 'rank')
 264         {
 265             $rel_wts_txt .= $tr . "\t" . $wt;
 266             $rel_wts_txt .= "\n";
 267                 push @si_wts, $tr, $wt;
 268         }
 269     }
 270
 271     my $si_wts = join('-', @si_wts);
 272     $c->stash->{sindex_weigths} = $si_wts;
 273
 274     $self->rel_weights_file($c);
 275     my $file = $c->stash->{rel_weights_file};
 276     write_file($file, {binmode => ':utf8'}, $rel_wts_txt);
 277
 278 }
 279
 280
 281 sub gebvs_selection_index_file {
 282     my ($self, $c) = @_;
 283
 284    my $file_id = $c->stash->{sindex_name};
 285    if (!$file_id)
 286    {
 287        $file_id = $c->controller('solGS::Files')->create_file_id($c);
 288    }
 289
 290     my $name = "gebvs_selection_index_${file_id}";
 291     my $dir = $c->stash->{selection_index_cache_dir};
 292
 293     my $cache_data = { key       => $name,
 294                        file      => $name,
 295                        stash_key => 'gebvs_selection_index_file',
 296                        cache_dir => $dir
 297     };
 298
 299     $c->controller('solGS::Files')->cache_file($c, $cache_data);
 300
 301 }
 302
 303
 304 sub selection_index_file {
 305     my ($self, $c) = @_;
 306
 307     my $file_id = $c->stash->{sindex_name};
 308     if (!$file_id)
 309     {
 310             $file_id = $c->controller('solGS::Files')->create_file_id($c);
 311     }
 312
 313     my $name = "selection_index_only_${file_id}";
 314     my $dir = $c->stash->{selection_index_cache_dir};
 315
 316     my $cache_data = { key       => $name,
 317                        file      => $name,
 318                        stash_key => 'selection_index_only_file',
 319                        cache_dir => $dir
 320     };
 321
 322     $c->controller('solGS::Files')->cache_file($c, $cache_data);
 323
 324 }
 325
 326
 327 sub rel_weights_file {
 328     my ($self, $c) = @_;
 329
 330     my $file_id = $c->controller('solGS::Files')->create_file_id($c);
 331
 332     my $dir = $c->stash->{selection_index_cache_dir};
 333     my $name =  "rel_weights_${file_id}";
 334
 335     my $cache_data = { key       => $name,
 336                        file      => $name,
 337                        stash_key => 'rel_weights_file',
 338                        cache_dir => $dir
 339     };
 340
 341     $c->controller('solGS::Files')->cache_file($c, $cache_data);
 342 }
 343
 344
 345 sub begin : Private {
 346     my ($self, $c) = @_;
 347
 348     $c->controller('solGS::Files')->get_solgs_dirs($c);
 349
 350 }
 351
 352
 353
 354 ####
 355 1;
 356 #