lib/SGN/Controller/solGS/pca.pm

   1 package SGN::Controller::solGS::pca;
   2
   3 use Moose;
   4 use namespace::autoclean;
   5
   6 use Carp qw/ carp confess croak /;
   7 use File::Spec::Functions qw / catfile catdir/;
   8 use File::Path qw / mkpath  /;
   9 use File::Temp qw / tempfile tempdir /;
  10 use File::Slurp qw /write_file read_file :edit prepend_file/;
  11 use JSON;
  12 use Scalar::Util qw /weaken reftype/;
  13 use Storable qw/ nstore retrieve /;
  14
  15 use CXGN::List;
  16
  17 BEGIN { extends 'Catalyst::Controller' }
  18
  19 sub pca_analysis : Path('/pca/analysis/') Args() {
  20     my ( $self, $c, $id ) = @_;
  21
  22     if ( $id && !$c->user ) {
  23         $c->controller('solGS::Utils')->require_login($c);
  24     }
  25
  26     $c->stash->{template} = '/solgs/tools/pca/analysis.mas';
  27
  28 }
  29
  30 sub run_pca_analysis : Path('/run/pca/analysis') Args() {
  31     my ( $self, $c ) = @_;
  32
  33     my $args = $c->req->param('arguments');
  34     $c->controller('solGS::Utils')->stash_json_args( $c, $args );
  35
  36     $c->stash->{data_type} = 'genotype' if !$c->stash->{data_type};
  37
  38     my $file_id = $c->controller('solGS::Files')->create_file_id($c);
  39     $c->stash->{file_id} = $file_id;
  40
  41     my $list_id = $c->stash->{list_id};
  42     if ($list_id) {
  43         $c->controller('solGS::List')
  44           ->create_list_population_metadata_file( $c, $file_id );
  45         $c->controller('solGS::List')->stash_list_metadata( $c, $list_id );
  46     }
  47
  48     my $combo_pops_id = $c->stash->{combo_pops_id};
  49     if ($combo_pops_id) {
  50         $c->controller('solGS::combinedTrials')
  51           ->get_combined_pops_list( $c, $combo_pops_id );
  52         $c->stash->{pops_ids_list} = $c->stash->{combined_pops_list};
  53     }
  54
  55     my $cached =
  56       $c->controller('solGS::CachedResult')->check_pca_output( $c, $file_id );
  57     if ( !$cached->{scores_file} ) {
  58         $self->run_pca($c);
  59     }
  60
  61     $self->prepare_pca_output_response($c);
  62     my $ret = $c->stash->{pca_output_response};
  63
  64     $ret = to_json($ret);
  65     $c->res->content_type('application/json');
  66     $c->res->body($ret);
  67
  68 }
  69
  70 sub download_pca_scores : Path('/download/pca/scores/population') Args(1) {
  71     my ( $self, $c, $file_id ) = @_;
  72
  73     $c->stash->{file_id} = $file_id;
  74     $self->pca_scores_file($c);
  75     my $file     = $c->stash->{pca_scores_file};
  76     my $pca_data = $c->controller('solGS::Utils')
  77       ->structure_downloadable_data( $file, 'Individuals' );
  78
  79     $c->res->content_type("text/plain");
  80     $c->res->body( join "", map { $_->[0] } @$pca_data );
  81 }
  82
  83 sub download_pca_loadings : Path('/download/pca/loadings/population') Args(1) {
  84     my ( $self, $c, $file_id ) = @_;
  85
  86     $c->stash->{file_id} = $file_id;
  87     $self->pca_loadings_file($c);
  88     my $file     = $c->stash->{pca_loadings_file};
  89     my $pca_data = $c->controller('solGS::Utils')
  90       ->structure_downloadable_data( $file, 'Variables' );
  91
  92     $c->res->content_type("text/plain");
  93     $c->res->body( join "", map { $_->[0] } @$pca_data );
  94
  95 }
  96
  97 sub download_pca_variances : Path('/download/pca/variances/population') Args(1)
  98 {
  99     my ( $self, $c, $file_id ) = @_;
 100
 101     $c->stash->{file_id} = $file_id;
 102     $self->pca_variances_file($c);
 103     my $file = $c->stash->{pca_variances_file};
 104
 105     my $pca_data = $c->controller('solGS::Utils')
 106       ->structure_downloadable_data( $file, 'PCs' );
 107
 108     $c->res->content_type("text/plain");
 109     $c->res->body( join "", map { $_->[0] } @$pca_data );
 110
 111 }
 112
 113 sub prepare_pca_output_response {
 114     my ( $self, $c ) = @_;
 115
 116     my $file_id = $c->stash->{file_id};
 117     my $ret->{status} = undef;
 118
 119     if ($file_id) {
 120         $self->pca_scores_file($c);
 121         my $scores_file = $c->stash->{pca_scores_file};
 122
 123         $self->pca_variances_file($c);
 124         my $variances_file = $c->stash->{pca_variances_file};
 125
 126         if ( -s $scores_file ) {
 127             my $scores =
 128               $c->controller('solGS::Utils')->read_file_data($scores_file);
 129             my $variances =
 130               $c->controller('solGS::Utils')->read_file_data($variances_file);
 131
 132             $self->prep_pca_download_files($c);
 133             my $scree_plot_file = $c->stash->{download_scree_plot};
 134             my $scree_data_file = $c->stash->{download_scree_data};
 135             my $loadings_file   = $c->stash->{download_loadings};
 136             my $variances_file  = $c->stash->{download_variances};
 137             my $scores_file     = $c->stash->{download_scores};
 138
 139             my $output_link = '/pca/analysis/' . $file_id;
 140             my $trials_names;
 141
 142             my $tr_pop_id  = $c->stash->{training_pop_id};
 143             my $sel_pop_id = $c->stash->{selection_pop_id};
 144             if ( $tr_pop_id && $sel_pop_id ) {
 145                 $trials_names = {
 146                     $tr_pop_id  => 'Training population',
 147                     $sel_pop_id => 'Selection population'
 148                 };
 149             }
 150             else {
 151                 $c->controller('solGS::combinedTrials')
 152                   ->process_trials_list_details($c);
 153                 $trials_names = $c->stash->{trials_names};
 154             }
 155
 156             if ($scores) {
 157                 $ret->{scores}          = $scores;
 158                 $ret->{variances}       = $variances;
 159                 $ret->{scores_file}     = $scores_file;
 160                 $ret->{variances_file}  = $variances_file;
 161                 $ret->{loadings_file}   = $loadings_file;
 162                 $ret->{scree_data_file} = $scree_data_file;
 163                 $ret->{scree_plot_file} = $scree_plot_file;
 164                 $ret->{status}          = 'success';
 165                 $ret->{cached}          = 1;
 166                 $ret->{pca_pop_id}   = $c->stash->{pca_pop_id};
 167                 $ret->{file_id}      = $file_id;
 168                 $ret->{list_id}      = $c->stash->{list_id};
 169                 $ret->{trials_names} = $trials_names;
 170                 $ret->{output_link}  = $output_link;
 171                 $ret->{data_type}    = $c->stash->{data_type};
 172             }
 173
 174             $c->stash->{pca_output_response} = $ret;
 175         }
 176         else {
 177             $ret->{status} = $self->error_message($c);
 178             $c->stash->{formatted_pca_output} = $ret;
 179         }
 180     }
 181     else {
 182         die "Required file id argument missing.";
 183     }
 184
 185 }
 186
 187 sub error_message {
 188     my ( $self, $c ) = @_;
 189
 190     $self->pca_scores_file($c);
 191     my $pca_scores_file = $c->stash->{pca_scores_file};
 192
 193     $self->pca_input_files($c);
 194     my $files = $c->stash->{pca_input_files};
 195
 196     my $error_message;
 197
 198     my @data_exists;
 199     my @data_files = split( /\s/, read_file( $files, { binmode => ':utf8' } ) );
 200
 201     foreach my $file (@data_files) {
 202         push @data_exists, 1 if -s $file;
 203     }
 204
 205     if ( !@data_exists ) {
 206         my $data_type = $c->stash->{data_type};
 207         $error_message = "There is no $data_type for this dataset.";
 208     }
 209     elsif ( @data_exists && !-s $pca_scores_file ) {
 210         $error_message = 'The PCA R Script failed.';
 211     }
 212
 213     return $error_message;
 214 }
 215
 216 sub format_pca_scores {
 217     my ( $self, $c ) = @_;
 218
 219     my $file = $c->stash->{pca_scores_file};
 220     my $data = $c->controller('solGS::Utils')->read_file_data($file);
 221
 222     $c->stash->{pca_scores} = $data;
 223
 224 }
 225
 226 sub pca_query_jobs {
 227     my ( $self, $c ) = @_;
 228
 229     my $data_type   = $c->stash->{data_type};
 230     my $pca_pop_id  = $c->stash->{pca_pop_id};
 231     my $protocol_id = $c->stash->{genotyping_protocol_id};
 232
 233     my $jobs = [];
 234
 235     if ( $data_type =~ /phenotype/i ) {
 236         $jobs = $c->controller('solGS::AsyncJob')
 237           ->create_phenotype_data_query_jobs( $c, $pca_pop_id );
 238     }
 239     elsif ( $data_type =~ /genotype/i ) {
 240         $jobs = $c->controller('solGS::AsyncJob')
 241           ->create_genotype_data_query_jobs( $c, $pca_pop_id, $protocol_id );
 242     }
 243
 244     if ( reftype $jobs ne 'ARRAY' ) {
 245         $jobs = [$jobs];
 246     }
 247
 248     $c->stash->{pca_query_jobs} = $jobs;
 249 }
 250
 251 sub pca_scores_file {
 252     my ( $self, $c ) = @_;
 253
 254     my $file_id = $c->stash->{file_id};
 255     $c->stash->{cache_dir} = $c->stash->{pca_cache_dir};
 256
 257     my $cache_data = {
 258         key       => "pca_scores_${file_id}",
 259         file      => "pca_scores_${file_id}",
 260         stash_key => 'pca_scores_file'
 261     };
 262
 263     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 264
 265 }
 266
 267 sub pca_scree_data_file {
 268     my ( $self, $c ) = @_;
 269
 270     my $file_id = $c->stash->{file_id};
 271     $c->stash->{cache_dir} = $c->stash->{pca_cache_dir};
 272
 273     my $cache_data = {
 274         key       => "pca_scree_data_${file_id}",
 275         file      => "pca_scree_data_${file_id}",
 276         stash_key => 'pca_scree_data_file'
 277     };
 278
 279     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 280
 281 }
 282
 283 sub pca_scree_plot_file {
 284     my ( $self, $c ) = @_;
 285
 286     my $file_id = $c->stash->{file_id};
 287     $c->stash->{cache_dir} = $c->stash->{pca_cache_dir};
 288
 289     my $cache_data = {
 290         key       => "pca_scree_plot_${file_id}",
 291         file      => "pca_scree_plot_${file_id}",
 292         ext       => 'png',
 293         stash_key => 'pca_scree_plot_file'
 294     };
 295
 296     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 297
 298 }
 299
 300 sub pca_variances_file {
 301     my ( $self, $c ) = @_;
 302
 303     my $file_id = $c->stash->{file_id};
 304     $c->stash->{cache_dir} = $c->stash->{pca_cache_dir};
 305
 306     my $cache_data = {
 307         key       => "pca_variances_${file_id}",
 308         file      => "pca_variances_${file_id}",
 309         stash_key => 'pca_variances_file'
 310     };
 311
 312     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 313
 314 }
 315
 316 sub pca_loadings_file {
 317     my ( $self, $c ) = @_;
 318
 319     my $file_id = $c->stash->{file_id};
 320     $c->stash->{cache_dir} = $c->stash->{pca_cache_dir};
 321
 322     my $cache_data = {
 323         key       => "pca_loadings_${file_id}",
 324         file      => "pca_loadings_${file_id}",
 325         stash_key => 'pca_loadings_file'
 326     };
 327
 328     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 329
 330 }
 331
 332 sub pca_output_files {
 333     my ( $self, $c ) = @_;
 334
 335     my $file_id = $c->stash->{file_id};
 336
 337     $self->pca_scores_file($c);
 338     $self->pca_loadings_file($c);
 339     $self->pca_variances_file($c);
 340     $self->pca_scree_data_file($c);
 341     $self->pca_scree_plot_file($c);
 342     $self->combined_pca_trials_data_file($c);
 343
 344     my $file_list = join( "\t",
 345         $c->stash->{pca_scores_file},     $c->stash->{pca_loadings_file},
 346         $c->stash->{pca_scree_data_file}, $c->stash->{pca_scree_plot_file},
 347         $c->stash->{pca_variances_file},  $c->stash->{combined_pca_data_file},
 348     );
 349
 350     my $tmp_dir = $c->stash->{pca_temp_dir};
 351     my $name    = "pca_output_files_${file_id}";
 352     my $tempfile =
 353       $c->controller('solGS::Files')->create_tempfile( $tmp_dir, $name );
 354     write_file( $tempfile, { binmode => ':utf8' }, $file_list );
 355
 356     $c->stash->{pca_output_files} = $tempfile;
 357
 358 }
 359
 360 sub combined_pca_trials_data_file {
 361     my ( $self, $c ) = @_;
 362
 363     my $file_id = $c->stash->{file_id};
 364     my $tmp_dir = $c->stash->{pca_temp_dir};
 365     my $name    = "combined_pca_data_file_${file_id}";
 366     my $tempfile =
 367       $c->controller('solGS::Files')->create_tempfile( $tmp_dir, $name );
 368
 369     $c->stash->{combined_pca_data_file} = $tempfile;
 370
 371 }
 372
 373 sub pca_data_input_files {
 374     my ( $self, $c ) = @_;
 375
 376     my $pop_id      = $c->stash->{pca_pop_id};
 377     my $data_type   = $c->stash->{data_type};
 378     my $protocol_id = $c->stash->{genotyping_protocol_id};
 379
 380     my $input_file;
 381     if ( $data_type =~ /genotype/i ) {
 382         $c->controller('solGS::Files')
 383           ->genotype_file_name( $c, $pop_id, $protocol_id );
 384         $input_file = $c->stash->{genotype_file_name};
 385     }
 386     elsif ( $data_type =~ /phenotype/i ) {
 387         $c->controller('solGS::Files')->phenotype_file_name( $c, $pop_id );
 388         $input_file = $c->stash->{phenotype_file_name};
 389     }
 390
 391     return $input_file;
 392 }
 393
 394 sub pca_input_files {
 395     my ( $self, $c ) = @_;
 396
 397     my $file_id = $c->stash->{file_id};
 398     my $tmp_dir = $c->stash->{pca_temp_dir};
 399
 400     my $name = "pca_input_files_${file_id}";
 401     my $tempfile =
 402       $c->controller('solGS::Files')->create_tempfile( $tmp_dir, $name );
 403
 404     my $files;
 405     my $data_type = $c->stash->{data_type};
 406     if ( $data_type =~ /genotype/i ) {
 407         $self->pca_geno_input_files($c);
 408         $files = $c->stash->{pca_geno_input_files};
 409     }
 410     elsif ( $data_type =~ /phenotype/i ) {
 411         $self->pca_pheno_input_files($c);
 412         $files = $c->stash->{pca_pheno_input_files};
 413     }
 414
 415     write_file( $tempfile, { binmode => ':utf8' }, $files );
 416     $c->stash->{pca_input_files} = $tempfile;
 417
 418 }
 419
 420 sub pca_geno_input_files {
 421     my ( $self, $c ) = @_;
 422
 423     my $data_type = $c->stash->{data_type};
 424     my $files;
 425
 426     if ( $data_type =~ /genotype/i ) {
 427         if ( $c->req->referer =~
 428             /solgs\/selection\/|solgs\/combined\/model\/\d+\/selection\// )
 429         {
 430             $self->training_selection_geno_files($c);
 431         }
 432
 433         $files =
 434           $c->stash->{genotype_files_list} || $c->stash->{genotype_file_name};
 435     }
 436
 437     $files = join( "\t", @$files ) if reftype($files) eq 'ARRAY';
 438     $c->stash->{pca_geno_input_files} = $files;
 439 }
 440
 441 sub training_selection_geno_files {
 442     my ( $self, $c ) = @_;
 443
 444     my $tr_pop  = $c->stash->{training_pop_id};
 445     my $sel_pop = $c->stash->{selection_pop_id};
 446
 447     my @files;
 448     foreach my $id ( ( $tr_pop, $sel_pop ) ) {
 449         $c->controller('solGS::Files')->genotype_file_name( $c, $id );
 450         push @files, $c->stash->{genotype_file_name};
 451     }
 452
 453     my $files = join( "\t", @files );
 454     $c->stash->{genotype_files_list} = $files;
 455 }
 456
 457 sub pca_pheno_input_files {
 458     my ( $self, $c ) = @_;
 459
 460     my $data_type = $c->stash->{data_type};
 461     my $files;
 462
 463     if ( $data_type =~ /phenotype/i ) {
 464         $files = $c->stash->{phenotype_files_list}
 465           || $c->stash->{phenotype_file_name};
 466
 467         $files = join( "\t", @$files ) if reftype($files) eq 'ARRAY';
 468
 469         $c->controller('solGS::Files')->phenotype_metadata_file($c);
 470         my $metadata_file = $c->stash->{phenotype_metadata_file};
 471
 472         $files .= "\t" . $metadata_file;
 473     }
 474
 475     $c->stash->{pca_pheno_input_files} = $files;
 476
 477 }
 478
 479 sub run_pca {
 480     my ( $self, $c ) = @_;
 481
 482     $self->pca_query_jobs_file($c);
 483     $c->stash->{prerequisite_jobs} = $c->stash->{pca_query_jobs_file};
 484
 485     $self->pca_r_jobs_file($c);
 486     $c->stash->{dependent_jobs} = $c->stash->{pca_r_jobs_file};
 487
 488     $c->controller('solGS::AsyncJob')->run_async($c);
 489
 490 }
 491
 492 sub run_pca_single_core {
 493     my ( $self, $c ) = @_;
 494
 495     $self->pca_query_jobs($c);
 496     my $queries = $c->stash->{pca_query_jobs};
 497
 498     $self->pca_r_jobs($c);
 499     my $r_jobs = $c->stash->{pca_r_jobs};
 500
 501     foreach my $job (@$queries) {
 502         $c->controller('solGS::AsyncJob')->submit_job_cluster( $c, $job );
 503     }
 504
 505     foreach my $job (@$r_jobs) {
 506         $c->controller('solGS::AsyncJob')->submit_job_cluster( $c, $job );
 507     }
 508
 509 }
 510
 511 sub run_pca_multi_cores {
 512     my ( $self, $c ) = @_;
 513
 514     $self->pca_query_jobs_file($c);
 515     $c->stash->{prerequisite_jobs} = $c->stash->{pca_query_jobs_file};
 516
 517     $self->pca_r_jobs_file($c);
 518     $c->stash->{dependent_jobs} = $c->stash->{pca_r_jobs_file};
 519
 520     $c->controller('solGS::AsyncJob')->run_async($c);
 521
 522 }
 523
 524 sub pca_r_jobs {
 525     my ( $self, $c ) = @_;
 526
 527     my $file_id = $c->stash->{file_id};
 528
 529     $self->pca_output_files($c);
 530     my $output_file = $c->stash->{pca_output_files};
 531
 532     $self->pca_input_files($c);
 533     my $input_file = $c->stash->{pca_input_files};
 534
 535     $c->stash->{analysis_tempfiles_dir} = $c->stash->{pca_temp_dir};
 536
 537     $c->stash->{input_files}  = $input_file;
 538     $c->stash->{output_files} = $output_file;
 539     $c->stash->{r_temp_file}  = "pca-${file_id}";
 540     $c->stash->{r_script}     = 'R/solGS/pca.r';
 541
 542     $c->controller('solGS::AsyncJob')->get_cluster_r_job_args($c);
 543     my $jobs = $c->stash->{cluster_r_job_args};
 544
 545     if ( reftype $jobs ne 'ARRAY' ) {
 546         $jobs = [$jobs];
 547     }
 548
 549     $c->stash->{pca_r_jobs} = $jobs;
 550
 551 }
 552
 553 sub pca_r_jobs_file {
 554     my ( $self, $c ) = @_;
 555
 556     $self->pca_r_jobs($c);
 557     my $jobs = $c->stash->{pca_r_jobs};
 558
 559     my $temp_dir  = $c->stash->{pca_temp_dir};
 560     my $jobs_file = $c->controller('solGS::Files')
 561       ->create_tempfile( $temp_dir, 'pca-r-jobs-file' );
 562
 563     nstore $jobs, $jobs_file
 564       or croak "pca r jobs : $! serializing pca r jobs to $jobs_file";
 565
 566     $c->stash->{pca_r_jobs_file} = $jobs_file;
 567
 568 }
 569
 570 sub pca_query_jobs_file {
 571     my ( $self, $c ) = @_;
 572
 573     $self->pca_query_jobs($c);
 574     my $jobs = $c->stash->{pca_query_jobs};
 575
 576     my $temp_dir  = $c->stash->{pca_temp_dir};
 577     my $jobs_file = $c->controller('solGS::Files')
 578       ->create_tempfile( $temp_dir, 'pca-query-jobs-file' );
 579
 580     nstore $jobs, $jobs_file
 581       or croak "pca query jobs : $! serializing pca query jobs to $jobs_file";
 582
 583     $c->stash->{pca_query_jobs_file} = $jobs_file;
 584
 585 }
 586
 587 sub prep_pca_download_files {
 588     my ( $self, $c ) = @_;
 589
 590     my $analysis_type = $c->stash->{analysis_type};
 591     $self->pca_scores_file($c);
 592     $self->pca_loadings_file($c);
 593     $self->pca_variances_file($c);
 594     $self->pca_scree_data_file($c);
 595     $self->pca_scree_plot_file($c);
 596
 597     my $scores_file     = $c->stash->{pca_scores_file};
 598     my $loadings_file   = $c->stash->{pca_loadings_file};
 599     my $scree_data_file = $c->stash->{pca_scree_data_file};
 600     my $scree_plot_file = $c->stash->{pca_scree_plot_file};
 601     my $variances_file  = $c->stash->{pca_variances_file};
 602
 603     $scores_file = $c->controller('solGS::Files')
 604       ->copy_to_tempfiles_subdir( $c, $scores_file, 'pca' );
 605     $loadings_file = $c->controller('solGS::Files')
 606       ->copy_to_tempfiles_subdir( $c, $loadings_file, 'pca' );
 607     $scree_data_file = $c->controller('solGS::Files')
 608       ->copy_to_tempfiles_subdir( $c, $scree_data_file, 'pca' );
 609     $scree_plot_file = $c->controller('solGS::Files')
 610       ->copy_to_tempfiles_subdir( $c, $scree_plot_file, 'pca' );
 611     $variances_file = $c->controller('solGS::Files')
 612       ->copy_to_tempfiles_subdir( $c, $variances_file, 'pca' );
 613
 614     $c->stash->{download_scores}     = $scores_file;
 615     $c->stash->{download_loadings}   = $loadings_file;
 616     $c->stash->{download_scree_data} = $scree_data_file;
 617     $c->stash->{download_scree_plot} = $scree_plot_file;
 618     $c->stash->{download_variances}  = $variances_file;
 619
 620 }
 621
 622 sub begin : Private {
 623     my ( $self, $c ) = @_;
 624
 625     $c->controller('solGS::Files')->get_solgs_dirs($c);
 626
 627 }
 628
 629 __PACKAGE__->meta->make_immutable;
 630
 631 ####
 632 1;
 633 ####