lib/SGN/Controller/solGS/geneticGain.pm

   1
   2 =head1 AUTHOR
   3
   4 Isaak Y Tecle <iyt2@cornell.edu>
   5
   6 =head1 LICENSE
   7
   8 This library is free software. You can redistribute it and/or modify
   9 it under the same terms as Perl itself.
  10
  11 =head1 DESCRIPTION
  12
  13 SGN::Controller::solGS::geneticGain- Controller for comparing GEBVs of training and selection populations
  14
  15 =cut
  16
  17 package SGN::Controller::solGS::geneticGain;
  18
  19 use Moose;
  20 use namespace::autoclean;
  21
  22 use File::Copy;
  23 use File::Basename;
  24 use File::Path qw / mkpath  /;
  25 use File::Spec::Functions;
  26 use File::Slurp qw /write_file read_file/;
  27 use JSON;
  28 use List::MoreUtils qw /uniq/;
  29 use String::CRC;
  30 use URI::FromHash 'uri';
  31
  32 BEGIN { extends 'Catalyst::Controller::REST' }
  33
  34 __PACKAGE__->config(
  35     default   => 'application/json',
  36     stash_key => 'rest',
  37     map       => { 'application/json' => 'JSON' },
  38 );
  39
  40 sub get_training_pop_gebvs : Path('/solgs/get/gebvs/training/population/')
  41   Args(0) {
  42     my ( $self, $c ) = @_;
  43
  44     $c->stash->{training_pop_id} = $c->req->param('training_pop_id');
  45     $c->stash->{trait_id}        = $c->req->param('trait_id');
  46     $c->stash->{population_type} = 'training_population';
  47
  48     my $protocol_id = $c->req->param('genotyping_protocol_id');
  49     $c->controller('solGS::genotypingProtocol')
  50       ->stash_protocol_id( $c, $protocol_id );
  51
  52     $c->stash->{rest}{gebv_exists} = undef;
  53
  54     $self->get_training_pop_gebv_file($c);
  55     my $gebv_file = $c->stash->{training_gebv_file};
  56
  57     if ( -s $gebv_file ) {
  58         $c->stash->{gebv_file} = $gebv_file;
  59         $self->get_gebv_arrayref($c);
  60         my $gebv_arrayref = $c->stash->{gebv_arrayref};
  61
  62         $c->stash->{rest}{gebv_exists}   = 1;
  63         $c->stash->{rest}{gebv_arrayref} = $gebv_arrayref;
  64     }
  65
  66 }
  67
  68 sub get_selection_pop_gebvs : Path('/solgs/get/gebvs/selection/population/')
  69   Args(0) {
  70     my ( $self, $c ) = @_;
  71
  72     $c->stash->{selection_pop_id} = $c->req->param('selection_pop_id');
  73     $c->stash->{training_pop_id}  = $c->req->param('training_pop_id');
  74     $c->stash->{trait_id}         = $c->req->param('trait_id');
  75     $c->stash->{population_type}  = 'selection_prediction';
  76
  77     my $protocol_id = $c->req->param('genotyping_protocol_id');
  78     $c->controller('solGS::genotypingProtocol')
  79       ->stash_protocol_id( $c, $protocol_id );
  80
  81     $c->stash->{rest}{gebv_exists} = undef;
  82
  83     $self->get_selection_pop_gebv_file($c);
  84     my $gebv_file = $c->stash->{selection_gebv_file};
  85
  86     if ( -s $gebv_file ) {
  87         $c->stash->{gebv_file} = $gebv_file;
  88         $self->get_gebv_arrayref($c);
  89         my $gebv_arrayref = $c->stash->{gebv_arrayref};
  90
  91         $c->stash->{rest}{gebv_exists}   = 1;
  92         $c->stash->{rest}{gebv_arrayref} = $gebv_arrayref;
  93     }
  94
  95 }
  96
  97 sub genetic_gain_boxplot : Path('/solgs/genetic/gain/boxplot/') 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     $c->stash->{rest}{boxplot} = undef;
 104
 105     my $result = $self->check_genetic_gain_output($c);
 106
 107     if ( !$result ) {
 108         $self->run_boxplot($c);
 109     }
 110
 111     $result = $self->check_genetic_gain_output($c);
 112     if ($result) {
 113         $self->boxplot_download_files($c);
 114
 115         $c->stash->{rest}{boxplot}      = $c->stash->{download_boxplot};
 116         $c->stash->{rest}{boxplot_data} = $c->stash->{download_data};
 117         $c->stash->{rest}{Error}        = undef;
 118     }
 119     else {
 120         $c->stash->{rest}{Error} = 'Error occured plotting the boxplot(s).';
 121     }
 122
 123 }
 124
 125 sub check_genetic_gain_output {
 126     my ( $self, $c ) = @_;
 127
 128     $self->boxplot_file($c);
 129     my $boxplot = $c->stash->{boxplot_file};
 130
 131     $self->boxplot_download_files($c);
 132     my $dld_plot = $c->stash->{download_boxplot};
 133
 134     if ( -s $boxplot && $dld_plot ) {
 135         return 1;
 136     }
 137     else {
 138         return 0;
 139     }
 140
 141 }
 142
 143 sub get_training_pop_gebv_file {
 144     my ( $self, $c ) = @_;
 145
 146     my $pop_id   = $c->stash->{training_pop_id};
 147     my $trait_id = $c->stash->{trait_id};
 148     my $protocol_id = $c->stash->{genotyping_protocol_id};
 149
 150     $c->controller('solGS::Trait')->get_trait_details( $c, $trait_id );
 151     my $trait_abbr = $c->stash->{trait_abbr};
 152
 153     my $gebv_file;
 154
 155     if ( $pop_id && $trait_id ) {
 156         $c->controller('solGS::Files')->rrblup_training_gebvs_file($c);
 157         $gebv_file = $c->stash->{rrblup_training_gebvs_file};
 158     }
 159
 160     $c->stash->{training_gebv_file} = $gebv_file;
 161
 162 }
 163
 164 sub get_selection_pop_gebv_file {
 165     my ( $self, $c ) = @_;
 166
 167     my $selection_pop_id = $c->stash->{selection_pop_id};
 168     my $training_pop_id  = $c->stash->{training_pop_id};
 169     my $trait_id         = $c->stash->{trait_id};
 170     my $protocol_id = $c->stash->{genotyping_protocol_id};
 171     my $gebv_file;
 172
 173     if ( $selection_pop_id && $trait_id && $training_pop_id ) {
 174
 175         # my $identifier = "${training_pop_id}_${selection_pop_id}";
 176         $c->controller('solGS::Files')
 177           ->rrblup_selection_gebvs_file( $c, $training_pop_id,
 178             $selection_pop_id, $trait_id, $protocol_id);
 179         $gebv_file = $c->stash->{rrblup_selection_gebvs_file};
 180     }
 181
 182     $c->stash->{selection_gebv_file} = $gebv_file;
 183
 184 }
 185
 186 sub boxplot_id {
 187     my ( $self, $c ) = @_;
 188
 189     my $selection_pop_id = $c->stash->{selection_pop_id};
 190     my $training_pop_id  = $c->stash->{training_pop_id};
 191     my $trait_id         = $c->stash->{trait_id};
 192     my $protocol_id      = $c->stash->{genotyping_protocol_id};
 193
 194     my $multi_traits = $c->stash->{training_traits_ids};
 195     if ($multi_traits && scalar(@$multi_traits) > 1 ) {
 196         $trait_id = crc( join( '', @$multi_traits ) );
 197     }
 198
 199     $c->stash->{boxplot_id} =
 200       "${training_pop_id}_${selection_pop_id}_${trait_id}-${protocol_id}";
 201
 202 }
 203
 204 sub get_gebv_arrayref {
 205     my ( $self, $c ) = @_;
 206
 207     my $file = $c->stash->{gebv_file};
 208     $c->stash->{gebv_arrayref} =
 209       $c->controller('solGS::Utils')->read_file_data($file);
 210 }
 211
 212 sub check_population_type {
 213     my ( $self, $c, $pop_id ) = @_;
 214
 215     $c->stash->{population_type} =
 216       $c->controller('solGS::Search')->model($c)->get_population_type($pop_id);
 217 }
 218
 219 sub boxplot_file {
 220     my ( $self, $c ) = @_;
 221
 222     $self->boxplot_id($c);
 223     my $boxplot_id = $c->stash->{boxplot_id};
 224
 225     my $cache_data = {
 226         key       => "boxplot_${boxplot_id}",
 227         file      => "genetic_gain_plot_${boxplot_id}.png",
 228         stash_key => "boxplot_file",
 229         cache_dir => $c->stash->{solgs_cache_dir},
 230     };
 231
 232     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 233
 234 }
 235
 236 sub boxplot_data_file {
 237     my ( $self, $c ) = @_;
 238
 239     $self->boxplot_id($c);
 240     my $boxplot_id = $c->stash->{boxplot_id};
 241
 242     my $cache_data = {
 243         key       => "boxplot_data_${boxplot_id}",
 244         file      => "genetic_gain_data_${boxplot_id}.txt",
 245         stash_key => "boxplot_data_file",
 246         cache_dir => $c->stash->{solgs_cache_dir},
 247     };
 248
 249     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 250
 251 }
 252
 253 sub boxplot_input_files {
 254     my ( $self, $c ) = @_;
 255
 256     my @files_list;
 257    if (!$c->stash->{training_traits_ids}) {
 258     $c->stash->{training_traits_ids} = [$c->stash->{trait_id}];
 259    }
 260     foreach my $trait_id ( uniq( @{ $c->stash->{training_traits_ids} } ) ) {
 261         $c->stash->{trait_id} = $trait_id;
 262         $self->get_training_pop_gebv_file($c);
 263         my $training_gebv = $c->stash->{training_gebv_file};
 264
 265         $self->get_selection_pop_gebv_file($c);
 266         my $sel_gebv = $c->stash->{selection_gebv_file};
 267
 268         push @files_list, $training_gebv, $sel_gebv;
 269     }
 270
 271     my $files = join( "\t", @files_list );
 272
 273     my $tmp_dir = $c->stash->{solgs_tempfiles_dir};
 274
 275     $self->boxplot_id($c);
 276     my $boxplot_id = $c->stash->{boxplot_id};
 277     my $name       = "boxplot_input_files_${boxplot_id}";
 278     my $tempfile =
 279       $c->controller('solGS::Files')->create_tempfile( $tmp_dir, $name );
 280     write_file( $tempfile, { binmode => ':utf8' }, $files, );
 281
 282     $c->stash->{boxplot_input_files} = $tempfile;
 283
 284 }
 285
 286 sub boxplot_output_files {
 287     my ( $self, $c ) = @_;
 288
 289     $self->boxplot_file($c);
 290     my $boxplot_file = $c->stash->{boxplot_file};
 291
 292     $self->boxplot_error_file($c);
 293     my $error_file = $c->stash->{boxplot_error_file};
 294
 295     $self->boxplot_data_file($c);
 296     my $data_file = $c->stash->{boxplot_data_file};
 297
 298     my $file_list = join( "\t", $boxplot_file, $error_file, $data_file, );
 299
 300     my $tmp_dir = $c->stash->{solgs_tempfiles_dir};
 301
 302     $self->boxplot_id($c);
 303     my $boxplot_id = $c->stash->{boxplot_id};
 304
 305     my $name = "boxplot_output_files_${boxplot_id}";
 306     my $tempfile =
 307       $c->controller('solGS::Files')->create_tempfile( $tmp_dir, $name );
 308     write_file( $tempfile, { binmode => ':utf8' }, $file_list );
 309
 310     $c->stash->{boxplot_output_files} = $tempfile;
 311
 312 }
 313
 314 sub boxplot_error_file {
 315     my ( $self, $c ) = @_;
 316
 317     $self->boxplot_id($c);
 318     my $boxplot_id = $c->stash->{boxplot_id};
 319
 320     $c->stash->{file_id}       = $boxplot_id;
 321     $c->stash->{cache_dir}     = $c->stash->{solgs_cache_dir};
 322     $c->stash->{analysis_type} = 'boxplot';
 323
 324     $c->controller('solGS::Files')->analysis_error_file($c);
 325
 326 }
 327
 328 sub run_boxplot {
 329     my ( $self, $c ) = @_;
 330
 331     $self->boxplot_input_files($c);
 332     my $input_file = $c->stash->{boxplot_input_files};
 333
 334     $self->boxplot_output_files($c);
 335     my $output_file = $c->stash->{boxplot_output_files};
 336
 337     $self->boxplot_id($c);
 338     my $boxplot_id = $c->stash->{boxplot_id};
 339
 340     $c->stash->{analysis_tempfiles_dir} = $c->stash->{solgs_tempfiles_dir};
 341
 342     $c->stash->{input_files}  = $input_file;
 343     $c->stash->{output_files} = $output_file;
 344     $c->stash->{r_temp_file}  = "boxplot-${boxplot_id}";
 345     $c->stash->{r_script}     = 'R/solGS/genetic_gain.r';
 346
 347     $c->controller("solGS::AsyncJob")->run_r_script($c);
 348
 349 }
 350
 351 sub boxplot_download_files {
 352     my ( $self, $c ) = @_;
 353
 354     my $tmp_dir = catfile( $c->config->{tempfiles_subdir}, 'genetic_gain' );
 355     my $base_tmp_dir = catfile( $c->config->{basepath}, $tmp_dir );
 356
 357     mkpath( [$base_tmp_dir], 0, 0755 );
 358
 359     $self->boxplot_file($c);
 360     my $boxplot_file = $c->stash->{boxplot_file};
 361
 362     $self->boxplot_error_file($c);
 363     my $error_file = $c->stash->{boxplot_error_file};
 364
 365     $self->boxplot_data_file($c);
 366     my $data_file = $c->stash->{boxplot_data_file};
 367
 368     $c->controller('solGS::Files')->copy_file( $boxplot_file, $base_tmp_dir );
 369     $c->controller('solGS::Files')->copy_file( $error_file,   $base_tmp_dir );
 370     $c->controller('solGS::Files')->copy_file( $data_file,    $base_tmp_dir );
 371
 372     $boxplot_file = fileparse($boxplot_file);
 373     $boxplot_file = catfile( $tmp_dir, $boxplot_file );
 374
 375     $error_file = fileparse($error_file);
 376     $error_file = catfile( $tmp_dir, $error_file );
 377
 378     $data_file = fileparse($data_file);
 379     $data_file = catfile( $tmp_dir, $data_file );
 380
 381     $c->stash->{download_boxplot} = $boxplot_file;
 382     $c->stash->{download_error}   = $error_file;
 383     $c->stash->{download_data}    = $data_file;
 384
 385 }
 386
 387 sub begin : Private {
 388     my ( $self, $c ) = @_;
 389
 390     $c->controller('solGS::Files')->get_solgs_dirs($c);
 391
 392 }
 393
 394 ####
 395 1;
 396 ####