lib/SGN/Controller/solGS/Anova.pm

   1
   2 =head1 AUTHOR
   3
   4 Isaak Y Tecle <iyt2@cornell.edu>
   5
   6 =head1 Name
   7
   8 SGN::Controller::solGS::Anova - a controller for ANOVA. For now, this implements a one-way
   9 single trial ANOVA with a possibility for simultanously running anova for multiple traits.
  10
  11 =cut
  12
  13 package SGN::Controller::solGS::Anova;
  14
  15 use Moose;
  16 use namespace::autoclean;
  17
  18 use Carp qw/ carp confess croak /;
  19
  20 use CXGN::Trial;
  21 use Data::Dumper;
  22 use File::Basename;
  23 use File::Copy;
  24 use File::Slurp qw /write_file read_file/;
  25 use File::Spec::Functions;
  26 use File::Path qw /mkpath/;
  27 use JSON;
  28 use List::Util qw/any uniq all/;
  29 use List::MoreUtils qw/firstidx/;
  30 use Scalar::Util qw /weaken reftype looks_like_number/;
  31 use Storable qw/nstore retrieve/;
  32 use URI::FromHash 'uri';
  33
  34 BEGIN { extends 'Catalyst::Controller::REST' }
  35
  36 __PACKAGE__->config(
  37     default   => 'application/json',
  38     stash_key => 'rest',
  39     map       => { 'application/json' => 'JSON' },
  40 );
  41
  42 sub anova_check_design : Path('/anova/check/design/') Args(0) {
  43     my ( $self, $c ) = @_;
  44
  45     my $args = $c->req->param('arguments');
  46     $c->controller('solGS::Utils')->stash_json_args( $c, $args );
  47
  48     my $design    = $self->get_trial_design($c);
  49     my $supported = $self->check_design_support($design) if $design;
  50
  51     if ( !$design ) {
  52         $c->stash->{rest}{'Error'} = 'This trial has no design to apply ANOVA.';
  53     }
  54     elsif ( $design && !$supported ) {
  55         $c->stash->{rest}{'Error'} = $design
  56           . ' design is not supported yet. Please report this to the database team. ';
  57     }
  58     else {
  59         $c->stash->{rest}{'Design'} = $design;
  60     }
  61
  62 }
  63
  64 sub anova_traits_list : Path('/anova/traits/list/') Args(0) {
  65     my ( $self, $c ) = @_;
  66
  67     my $args = $c->req->param('arguments');
  68     $c->controller('solGS::Utils')->stash_json_args( $c, $args );
  69
  70     my $traits = $self->anova_traits($c);
  71     $c->stash->{rest}{anova_traits} = $traits;
  72
  73 }
  74
  75 sub anova_phenotype_data : Path('/anova/phenotype/data/') Args(0) {
  76     my ( $self, $c ) = @_;
  77
  78     my $args = $c->req->param('arguments');
  79     $c->controller('solGS::Utils')->stash_json_args( $c, $args );
  80
  81     my $trial_id = $c->stash->{trial_id};
  82     my $trait_id = $c->stash->{trait_id};
  83
  84     $c->controller('solGS::Trait')->get_trait_details( $c, $trait_id );
  85
  86     my $pheno_file = $self->trial_phenotype_file($c);
  87
  88     if ( !-s $pheno_file ) {
  89
  90         $pheno_file = $self->create_anova_phenodata_file($c);
  91
  92         if ( !-s $pheno_file ) {
  93             $c->stash->{rest}{'Error'} =
  94               'There is no phenotype data for this  trial.';
  95         }
  96
  97         if ( @{ $c->error } ) {
  98             $c->stash->{rest}{'Error'} =
  99               'There was error querying for the phenotype data.';
 100         }
 101     }
 102     else {
 103         my $categorical = $self->check_categorical_dependent_variable($c);
 104         if ($categorical) {
 105             $c->stash->{rest}{'Error'} =
 106 "The trait data is not all numeric. Some or all of the trait values are text. ";
 107         }
 108         else {
 109             $c->stash->{rest}{'success'} = 'Success.';
 110         }
 111     }
 112
 113     my $traits_abbrs = $self->get_traits_abbrs($c);
 114     $c->stash->{rest}{trial_id}     = $trial_id;
 115     $c->stash->{rest}{traits_abbrs} = $traits_abbrs;
 116
 117 }
 118
 119 sub anova_analyis : Path('/anova/analysis/') Args(0) {
 120     my ( $self, $c ) = @_;
 121
 122     my $args = $c->req->param('arguments');
 123     $c->controller('solGS::Utils')->stash_json_args( $c, $args );
 124
 125     my $anova_result = $self->check_anova_output($c);
 126
 127     $c->controller('solGS::Trait')
 128       ->get_trait_details( $c, $c->stash->{trait_id} );
 129
 130     if ( !$anova_result ) {
 131         $self->run_anova($c);
 132     }
 133
 134     $self->prepare_response($c);
 135
 136 }
 137
 138 sub anova_traits {
 139     my ( $self, $c ) = @_;
 140
 141     my $trial_id = $c->stash->{trial_id};
 142
 143     my $traits =
 144       $c->controller('solGS::Search')->model($c)->trial_traits($trial_id);
 145     my $clean_traits = $c->controller('solGS::Utils')->remove_ontology($traits);
 146
 147     return $clean_traits;
 148
 149 }
 150
 151 sub create_anova_phenodata_file {
 152     my ( $self, $c ) = @_;
 153
 154     my $cached = $c->controller('solGS::CachedResult')
 155       ->check_cached_phenotype_data( $c, $c->stash->{trial_id} );
 156
 157     if ( !$cached ) {
 158         $self->anova_query_jobs_file($c);
 159         my $queries = $c->stash->{anova_query_jobs_file};
 160
 161         $c->stash->{dependent_jobs} = $queries;
 162         $c->controller('solGS::AsyncJob')->run_async($c);
 163     }
 164
 165     my $pheno_file = $self->trial_phenotype_file($c);
 166
 167     return $pheno_file;
 168
 169 }
 170
 171 sub trial_phenotype_file {
 172     my ( $self, $c ) = @_;
 173
 174     $c->controller('solGS::Files')
 175       ->phenotype_file_name( $c, $c->stash->{trial_id} );
 176     return $c->stash->{phenotype_file_name};
 177
 178 }
 179
 180 sub get_trial_design {
 181     my ( $self, $c ) = @_;
 182
 183     my $trial_id = $c->stash->{trial_id};
 184
 185     my $trial = CXGN::Trial->new(
 186         {
 187             bcs_schema => $self->schema($c),
 188             trial_id   => $trial_id
 189         }
 190     );
 191
 192     my $design = $trial->get_design_type();
 193
 194     return $design;
 195
 196 }
 197
 198 sub check_design_support {
 199     my ( $self, $design ) = @_;
 200
 201     my $supported_designs = $self->supported_designs();
 202
 203     my ($match) = grep( /$design/, @$supported_designs );
 204
 205     return $match;
 206
 207 }
 208
 209 sub supported_designs {
 210     my $self = shift;
 211
 212     my $supported_designs = [qw(Alpha, Augmented, RCBD, CRD)];
 213
 214     return $supported_designs;
 215
 216 }
 217
 218 sub get_traits_abbrs {
 219     my ( $self, $c ) = @_;
 220
 221     my $trial_id = $c->stash->{trial_id};
 222     my $trait_id = $c->stash->{trait_id};
 223
 224     $c->stash->{pop_id} = $trial_id;
 225     $c->controller('solGS::Trait')->get_all_traits( $c, $trial_id );
 226     $c->controller('solGS::Files')->all_traits_file( $c, $trial_id );
 227
 228     $c->controller('solGs::Trait')->get_trait_details( $c, $trait_id );
 229     my $trait_abbr = $c->stash->{trait_abbr};
 230
 231     my $id_abbr      = { 'trait_id' => $trait_id, 'trait_abbr' => $trait_abbr };
 232     my $json         = JSON->new();
 233     my $traits_abbrs = $json->encode($id_abbr);
 234
 235     return $traits_abbrs;
 236 }
 237
 238 sub check_categorical_dependent_variable {
 239     my ( $self, $c ) = @_;
 240
 241     my $pheno_file = $self->trial_phenotype_file($c);
 242     my $header     = ( read_file( $pheno_file, { binmode => ':utf8' } ) )[0];
 243     my @headers    = split( /\t/, $header );
 244
 245     $c->controller('solGS::Trait')
 246       ->get_trait_details( $c, $c->stash->{trait_id} );
 247     my $trait_abbr = $c->stash->{trait_abbr};
 248
 249     my $trait_idx = firstidx { $_ eq $trait_abbr } @headers;
 250     my $trait_col = $trait_idx + 1;
 251
 252     my $trait_values = `cut -f $trait_col $pheno_file 2>&1`;
 253     $trait_values =~ s/$trait_abbr|\n//g;
 254     my @trait_values = split( /\t/, $trait_values );
 255
 256     my $categorical = all { $_ =~ /[A-Za-z]/ } @trait_values;
 257
 258     return $categorical;
 259
 260 }
 261
 262 sub check_anova_output {
 263     my ( $self, $c ) = @_;
 264
 265     $self->anova_table_file($c);
 266     my $html_file = $c->stash->{anova_table_html_file};
 267
 268     my $exists = -s $html_file ? 1 : 0;
 269
 270     return $exists;
 271
 272 }
 273
 274 sub prepare_response {
 275     my ( $self, $c ) = @_;
 276
 277     $self->anova_table_file($c);
 278     my $anova_txt_file  = $c->stash->{anova_table_txt_file};
 279     my $anova_html_file = $c->stash->{anova_table_html_file};
 280
 281     if ( -s $anova_html_file ) {
 282         $self->anova_model_file($c);
 283         my $model_file = $c->stash->{anova_model_file};
 284
 285         $self->adj_means_file($c);
 286         my $means_file = $c->stash->{adj_means_file};
 287
 288         $self->anova_diagnostics_file($c);
 289         my $diagnostics_file = $c->stash->{anova_diagnostics_file};
 290
 291         my $dir = 'anova';
 292         $anova_txt_file = $c->controller('solGS::Files')
 293           ->copy_to_tempfiles_subdir( $c, $anova_txt_file, $dir );
 294         $model_file = $c->controller('solGS::Files')
 295           ->copy_to_tempfiles_subdir( $c, $model_file, $dir );
 296         $means_file = $c->controller('solGS::Files')
 297           ->copy_to_tempfiles_subdir( $c, $means_file, $dir );
 298         $diagnostics_file = $c->controller('solGS::Files')
 299           ->copy_to_tempfiles_subdir( $c, $diagnostics_file, $dir );
 300
 301         $c->stash->{rest}{anova_table_html_file} =
 302           read_file( $anova_html_file, { binmode => ':utf8' } );
 303         $c->stash->{rest}{anova_table_txt_file}       = $anova_txt_file;
 304         $c->stash->{rest}{anova_model_file}       = $model_file;
 305         $c->stash->{rest}{adj_means_file}         = $means_file;
 306         $c->stash->{rest}{anova_diagnostics_file} = $diagnostics_file;
 307     }
 308     else {
 309         $self->anova_error_file($c);
 310         my $error_file = $c->stash->{anova_error_file};
 311
 312         my $error = read_file( $error_file, { binmode => ':utf8' } );
 313         $c->stash->{rest}{Error} = $error;
 314     }
 315
 316 }
 317
 318 sub run_anova {
 319     my ( $self, $c ) = @_;
 320
 321     $self->anova_query_jobs_file($c);
 322     $c->stash->{prerequisite_jobs} = $c->stash->{anova_query_jobs_file};
 323
 324     $self->anova_r_jobs_file($c);
 325     $c->stash->{dependent_jobs} = $c->stash->{anova_r_jobs_file};
 326
 327     $c->controller('solGS::AsyncJob')->run_async($c);
 328
 329 }
 330
 331 sub run_anova_single_core {
 332     my ( $self, $c ) = @_;
 333
 334     $self->anova_query_jobs($c);
 335     my $queries = $c->stash->{anova_query_jobs};
 336
 337     $self->anova_r_jobs($c);
 338     my $r_jobs = $c->stash->{anova_r_jobs};
 339
 340     foreach my $job (@$queries) {
 341         $c->controller('solGS::AsyncJob')->submit_job_cluster( $c, $job );
 342     }
 343
 344     foreach my $job (@$r_jobs) {
 345         $c->controller('solGS::AsyncJob')->submit_job_cluster( $c, $job );
 346     }
 347
 348 }
 349
 350 sub run_anova_multi_cores {
 351     my ( $self, $c ) = @_;
 352
 353     $self->anova_query_jobs_file($c);
 354     $c->stash->{prerequisite_jobs} = $c->stash->{anova_query_jobs_file};
 355
 356     $self->anova_r_jobs_file($c);
 357     $c->stash->{dependent_jobs} = $c->stash->{anova_r_jobs_file};
 358
 359     $c->controller('solGS::AsyncJob')->run_async($c);
 360
 361 }
 362
 363 sub anova_r_jobs {
 364     my ( $self, $c ) = @_;
 365
 366     my $trial_id = $c->stash->{trial_id};
 367     my $trait_id = $c->stash->{trait_id};
 368
 369     $self->anova_input_files($c);
 370     my $input_file = $c->stash->{anova_input_files};
 371
 372     $self->anova_output_files($c);
 373     my $output_file = $c->stash->{anova_output_files};
 374
 375     $c->stash->{analysis_tempfiles_dir} = $c->stash->{anova_temp_dir};
 376
 377     $c->stash->{input_files}  = $input_file;
 378     $c->stash->{output_files} = $output_file;
 379     $c->stash->{r_temp_file}  = "anova-${trial_id}-${trait_id}";
 380     $c->stash->{r_script}     = 'R/solGS/anova.r';
 381
 382     $c->controller('solGS::AsyncJob')->get_cluster_r_job_args($c);
 383     my $jobs = $c->stash->{cluster_r_job_args};
 384
 385     if ( reftype $jobs ne 'ARRAY' ) {
 386         $jobs = [$jobs];
 387     }
 388
 389     $c->stash->{anova_r_jobs} = $jobs;
 390
 391 }
 392
 393 sub anova_r_jobs_file {
 394     my ( $self, $c ) = @_;
 395
 396     $self->anova_r_jobs($c);
 397     my $jobs = $c->stash->{anova_r_jobs};
 398
 399     my $temp_dir  = $c->stash->{anova_temp_dir};
 400     my $jobs_file = $c->controller('solGS::Files')
 401       ->create_tempfile( $temp_dir, 'anova-r-jobs-file' );
 402
 403     nstore $jobs, $jobs_file
 404       or croak "anova r jobs : $! serializing anova r jobs to $jobs_file";
 405
 406     $c->stash->{anova_r_jobs_file} = $jobs_file;
 407
 408 }
 409
 410 sub anova_query_jobs {
 411     my ( $self, $c ) = @_;
 412
 413     $self->create_anova_phenotype_data_query_jobs($c);
 414     my $jobs = $c->stash->{anova_pheno_query_jobs};
 415
 416     if ( reftype $jobs ne 'ARRAY' ) {
 417         $jobs = [$jobs];
 418     }
 419
 420     $c->stash->{anova_query_jobs} = $jobs;
 421 }
 422
 423 sub anova_query_jobs_file {
 424     my ( $self, $c ) = @_;
 425
 426     $self->anova_query_jobs($c);
 427     my $jobs = $c->stash->{anova_query_jobs};
 428
 429     if ( $jobs->[0] ) {
 430         my $temp_dir  = $c->stash->{anova_temp_dir};
 431         my $jobs_file = $c->controller('solGS::Files')
 432           ->create_tempfile( $temp_dir, 'anova-query-jobs-file' );
 433
 434         nstore $jobs, $jobs_file
 435           or croak
 436           "anova query jobs : $! serializing anova query jobs to $jobs_file";
 437
 438         $c->stash->{anova_query_jobs_file} = $jobs_file;
 439     }
 440
 441 }
 442
 443 sub create_anova_phenotype_data_query_jobs {
 444     my ( $self, $c ) = @_;
 445
 446     my $trial_id = $c->stash->{pop_id} || $c->stash->{trial_id};
 447     $c->controller('solGS::AsyncJob')
 448       ->get_trials_phenotype_query_jobs_args( $c, [$trial_id] );
 449     my $jobs = $c->stash->{trials_phenotype_query_jobs_args};
 450
 451     if ( reftype $jobs ne 'ARRAY' ) {
 452         $jobs = [$jobs];
 453     }
 454
 455     $c->stash->{anova_pheno_query_jobs} = $jobs;
 456
 457 }
 458
 459 sub copy_pheno_file_to_anova_dir {
 460     my ( $self, $c ) = @_;
 461
 462     my $pheno_file  = $self->trial_phenotype_file($c);
 463     my $anova_cache = $c->stash->{anova_cache_dir};
 464
 465     $c->stash->{phenotype_file} =
 466       $c->controller('solGS::Files')->copy_file( $pheno_file, $anova_cache );
 467
 468 }
 469
 470 sub anova_input_files {
 471     my ( $self, $c ) = @_;
 472
 473     my $trial_id = $c->stash->{trial_id};
 474     my $trait_id = $c->stash->{trait_id};
 475
 476     my $pheno_file = $self->trial_phenotype_file($c);
 477
 478     $self->anova_traits_file($c);
 479     my $traits_file = $c->stash->{anova_traits_file};
 480
 481     $c->controller("solGS::Files")->phenotype_metadata_file($c);
 482     my $metadata_file = $c->stash->{phenotype_metadata_file};
 483
 484     my $file_list = join( "\t", $pheno_file, $traits_file, $metadata_file );
 485
 486     my $tmp_dir = $c->stash->{anova_temp_dir};
 487     my $name    = "anova_input_files_${trial_id}_${trait_id}";
 488     my $tempfile =
 489       $c->controller('solGS::Files')->create_tempfile( $tmp_dir, $name );
 490     write_file( $tempfile, { binmode => ':utf8' }, $file_list );
 491
 492     $c->stash->{anova_input_files} = $tempfile;
 493
 494 }
 495
 496 sub anova_traits_file {
 497     my ( $self, $c ) = @_;
 498
 499     my $trial_id = $c->stash->{trial_id};
 500     my $traits   = $c->stash->{trait_abbr};
 501
 502     my $tmp_dir = $c->stash->{anova_temp_dir};
 503     my $name    = "anova_traits_file_${trial_id}";
 504     my $traits_file =
 505       $c->controller('solGS::Files')->create_tempfile( $tmp_dir, $name );
 506     write_file( $traits_file, { binmode => ':utf8' }, $traits );
 507
 508     $c->stash->{anova_traits_file} = $traits_file;
 509
 510 }
 511
 512 sub anova_output_files {
 513     my ( $self, $c ) = @_;
 514
 515     my $trial_id = $c->stash->{trial_id};
 516     my $trait_id = $c->stash->{trait_id};
 517
 518     $self->anova_table_file($c);
 519     $self->anova_model_file($c);
 520     $self->adj_means_file($c);
 521     $self->anova_diagnostics_file($c);
 522     $self->anova_error_file($c);
 523
 524     my @files = $c->stash->{anova_table_file};
 525
 526     my $file_list = join( "\t",
 527         $c->stash->{anova_model_file},
 528         $c->stash->{anova_table_html_file},
 529         $c->stash->{anova_table_txt_file},
 530         $c->stash->{adj_means_file},
 531         $c->stash->{anova_diagnostics_file},
 532         $c->stash->{anova_error_file},
 533     );
 534
 535     my $tmp_dir = $c->stash->{anova_temp_dir};
 536     my $name    = "anova_output_files_${trial_id}_${trait_id}";
 537     my $tempfile =
 538       $c->controller('solGS::Files')->create_tempfile( $tmp_dir, $name );
 539     write_file( $tempfile, { binmode => ':utf8' }, $file_list );
 540
 541     $c->stash->{anova_output_files} = $tempfile;
 542
 543 }
 544
 545 sub anova_table_file {
 546     my ( $self, $c ) = @_;
 547
 548     my $trial_id = $c->stash->{trial_id};
 549     my $trait_id = $c->stash->{trait_id};
 550
 551     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};
 552
 553     my $cache_data = {
 554         key       => "anova_table_html_${trial_id}_${trait_id}",
 555         file      => "anova_table_html_${trial_id}_${trait_id}",
 556         ext       => 'html',
 557         stash_key => "anova_table_html_file"
 558     };
 559
 560     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 561
 562     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};
 563
 564     $cache_data = {
 565         key       => "anova_table_txt_${trial_id}_${trait_id}",
 566         file      => "anova_table_txt_${trial_id}_${trait_id}",
 567          ext      => 'txt',
 568         stash_key => "anova_table_txt_file"
 569     };
 570
 571     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 572
 573 }
 574
 575 sub anova_diagnostics_file {
 576     my ( $self, $c ) = @_;
 577
 578     my $trial_id = $c->stash->{trial_id};
 579     my $trait_id = $c->stash->{trait_id};
 580
 581     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};
 582
 583     my $cache_data = {
 584         key       => "anova_diagnosics_${trial_id}_${trait_id}",
 585         file      => "anova_diagnostics_${trial_id}_${trait_id}",
 586         ext       => '.png',
 587         stash_key => "anova_diagnostics_file"
 588     };
 589
 590     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 591
 592 }
 593
 594 sub anova_model_file {
 595     my ( $self, $c ) = @_;
 596
 597     my $trial_id = $c->stash->{trial_id};
 598     my $trait_id = $c->stash->{trait_id};
 599
 600     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};
 601
 602     my $cache_data = {
 603         key       => "anova_model_${trial_id}_${trait_id}",
 604         file      => "anova_model_${trial_id}_${trait_id}",
 605         stash_key => "anova_model_file"
 606     };
 607
 608     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 609
 610 }
 611
 612 sub anova_error_file {
 613     my ( $self, $c ) = @_;
 614
 615     $c->stash->{file_id} = $c->stash->{trial_id} . '_' . $c->stash->{trait_id};
 616     $c->stash->{cache_dir}     = $c->stash->{anova_cache_dir};
 617     $c->stash->{analysis_type} = 'anova';
 618
 619     $c->controller('solGS::Files')->analysis_error_file($c);
 620
 621 }
 622
 623 sub adj_means_file {
 624     my ( $self, $c ) = @_;
 625
 626     my $trial_id = $c->stash->{trial_id};
 627     my $trait_id = $c->stash->{trait_id};
 628
 629     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};
 630
 631     my $cache_data = {
 632         key       => "adj_means_${trial_id}_${trait_id}",
 633         file      => "adj_means_${trial_id}_${trait_id}",
 634         stash_key => "adj_means_file"
 635     };
 636
 637     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 638
 639 }
 640
 641 sub schema {
 642     my ( $self, $c ) = @_;
 643
 644     return $c->dbic_schema("Bio::Chado::Schema");
 645
 646 }
 647
 648 sub begin : Private {
 649     my ( $self, $c ) = @_;
 650
 651     $c->controller('solGS::Files')->get_solgs_dirs($c);
 652
 653 }
 654
 655 __PACKAGE__->meta->make_immutable;
 656
 657 1;