lib/SGN/Controller/AJAX/Analyze/Anova.pm

   1 =head1 AUTHOR
   2
   3 Isaak Y Tecle <iyt2@cornell.edu>
   4
   5 =head1 Name
   6
   7 SGN::Controller::AJAX::Analyze::Anova - a controller for ANOVA. For now, this implements a one-way
   8 single trial ANOVA with a possibility for simultanously running anova for multiple traits.
   9
  10 =cut
  11
  12
  13 package SGN::Controller::AJAX::Analyze::Anova;
  14
  15 use Moose;
  16 use namespace::autoclean;
  17
  18 use File::Slurp qw /write_file read_file/;
  19 use JSON;
  20 use CXGN::Trial;
  21 use File::Copy;
  22 use File::Basename;
  23 use File::Spec::Functions;
  24 use File::Path qw / mkpath  /;
  25 use URI::FromHash 'uri';
  26
  27 BEGIN { extends 'Catalyst::Controller::REST' }
  28
  29
  30
  31 __PACKAGE__->config(
  32     default   => 'application/json',
  33     stash_key => 'rest',
  34     map       => { 'application/json' => 'JSON',
  35                    'text/html' => 'JSON' },
  36     );
  37
  38
  39 sub anova_check_design :Path('/anova/check/design/') Args(0) {
  40     my ($self, $c) = @_;
  41
  42     $c->stash->{trial_id} = $c->req->param('trial_id');
  43
  44     $self->check_trial_design($c);
  45
  46 }
  47
  48
  49 sub anova_traits_list :Path('/anova/traits/list/') Args(0) {
  50     my ($self, $c) = @_;
  51
  52     my $trial_id = $c->req->param('trial_id');
  53
  54     $c->stash->{trial_id} = $trial_id;
  55
  56     $self->anova_traits($c);
  57
  58 }
  59
  60
  61 sub anova_phenotype_data :Path('/anova/phenotype/data/') Args(0) {
  62     my ($self, $c) = @_;
  63
  64     my $trial_id = $c->req->param('trial_id');
  65     my @traits_ids   = $c->req->param('traits_ids[]');
  66
  67     $c->stash->{rest}{trial_id} = $trial_id;
  68
  69     $c->stash->{trial_id} = $trial_id;
  70     $c->stash->{traits_ids} = \@traits_ids;
  71
  72     $self->create_anova_phenodata_file($c);
  73     $self->get_traits_abbrs($c);
  74
  75 }
  76
  77
  78 sub anova_traits {
  79      my ($self, $c) = @_;
  80
  81      my $trial_id = $c->stash->{trial_id};
  82
  83      my $trial = CXGN::Trial->new(bcs_schema => $self->schema($c),
  84                                   trial_id => $trial_id);
  85
  86      my $traits = $trial->get_traits_assayed();
  87      my $clean_traits = $self->remove_ontology($traits);
  88
  89      $c->stash->{rest}{anova_traits} = $clean_traits;
  90
  91 }
  92
  93
  94 sub remove_ontology {
  95     my ($self, $traits) = @_;
  96
  97     my @clean_traits;
  98
  99     foreach my $tr (@$traits) {
 100         my $name = $tr->[1];
 101         $name =~ s/\|CO_\d+:\d+//;
 102
 103         my $id_nm = {'trait_id' => $tr->[0], 'trait_name' => $name};
 104         push @clean_traits, $id_nm;
 105     }
 106
 107     return \@clean_traits;
 108
 109 }
 110
 111
 112 sub create_anova_phenodata_file {
 113     my ($self, $c)  = @_;
 114
 115     $self->anova_pheno_file($c);
 116     my $pheno_file =  $c->stash->{phenotype_file};
 117
 118     $self->copy_pheno_file_to_anova_dir($c);
 119
 120     if (!-s $pheno_file) {
 121         $c->stash->{rest}{'Error'} = 'There is no phenotype data for this  trial.';
 122     } else {
 123         $c->stash->{rest}{'success'} = 'Success.';
 124     }
 125
 126     if (@{$c->error}) {
 127         $c->stash->{rest}{'Error'} = 'There was error querying for the phenotype data.';
 128     }
 129
 130 }
 131
 132
 133 sub check_trial_design {
 134     my ($self, $c) = @_;
 135
 136     my $trial_id = $c->stash->{trial_id};
 137
 138     my $trial = CXGN::Trial->new(bcs_schema => $self->schema($c),
 139                                  trial_id => $trial_id);
 140
 141     my $design    = $trial->get_design_type();
 142
 143     my $supported;
 144     $supported = $self->check_support($design) if $design;
 145
 146     if (!$design)
 147     {
 148         $c->stash->{rest}{'Error'} = 'This trial has no design to apply ANOVA.';
 149     }
 150     elsif ($design && !$supported)
 151     {
 152         $c->stash->{rest}{'Error'} = $design . ' design is not supported yet. Please report this to the database team. ';
 153     }
 154     else
 155     {
 156         $c->stash->{rest}{'Design'} = $design;
 157     }
 158
 159 }
 160
 161
 162 sub check_support {
 163     my ($self, $design) = @_;
 164
 165     my $supported_designs = $self->supported_designs;
 166
 167     my ($match) = grep(/$design/, @$supported_designs);
 168
 169     return $match;
 170
 171 }
 172
 173
 174 sub supported_designs {
 175     my $self= shift;
 176
 177     my $supported_designs = [qw(Alpha, Augmented, RCBD, CRD)];
 178
 179     return $supported_designs;
 180
 181 }
 182
 183 sub get_traits_abbrs {
 184     my ($self, $c) = @_;
 185
 186     my $trial_id = $c->stash->{trial_id};
 187     my $traits_ids = $c->stash->{traits_ids};
 188
 189     $c->stash->{pop_id} = $trial_id;
 190     $c->controller("solGS::solGS")->all_traits_file($c);
 191     my $traits_file = $c->stash->{all_traits_file};
 192     my @traits = read_file($traits_file);
 193
 194     my @traits_abbrs;
 195
 196     foreach my $id (@$traits_ids) {
 197         my ($tr) = grep(/$id/, @traits);
 198         chomp($tr);
 199         my $abbr = (split('\t', $tr))[2] if $tr;
 200         my $id_abbr = {'trait_id' => $id, 'trait_abbr' => $abbr};
 201         push @traits_abbrs, $id_abbr;
 202     }
 203
 204    $c->stash->{rest}{traits_abbrs} = \@traits_abbrs;
 205
 206 }
 207
 208
 209 sub anova_analyis :Path('/anova/analysis/') Args(0) {
 210     my ($self, $c) = @_;
 211
 212     my $trial_id = $c->req->param('trial_id');
 213     my $traits   = $c->req->param('traits[]');
 214
 215     $c->stash->{trial_id} = $trial_id;
 216
 217     my $json = JSON->new();
 218     $traits  = $json->decode($traits);
 219
 220     foreach my $tr (@$traits)
 221     {
 222         foreach my $k (keys $tr)
 223         {
 224             $c->stash->{$k} = $tr->{$k};
 225         }
 226
 227         unless ($self->check_anova_output($c))
 228         {
 229             $self->run_anova($c);
 230             $self->check_anova_output($c);
 231
 232         }
 233     }
 234 }
 235
 236
 237 sub check_anova_output {
 238     my ($self, $c) = @_;
 239
 240     $self->anova_table_file($c);
 241     my $html_file = $c->stash->{anova_table_html_file};
 242
 243     if (-s $html_file) {
 244
 245         my $html_table = read_file($html_file);
 246
 247         $self->prep_download_files($c);
 248         my $anova_table_file = $c->stash->{download_anova};
 249         my $model_file       = $c->stash->{download_model};
 250         my $means_file       = $c->stash->{download_means};
 251         my $diagnostics_file = $c->stash->{download_diagnostics};
 252
 253         $c->stash->{rest}{anova_html_table}         = $html_table;
 254         $c->stash->{rest}{anova_table_file}         = $anova_table_file;
 255         $c->stash->{rest}{anova_model_file}         = $model_file;
 256         $c->stash->{rest}{adj_means_file}           = $means_file;
 257         $c->stash->{rest}{anova_diagnostics_file}   = $diagnostics_file;
 258
 259         return 1;
 260
 261     } else {
 262         return 0;
 263     }
 264
 265 }
 266
 267
 268 sub prep_download_files {
 269   my ($self, $c) = @_;
 270
 271   my $tmp_dir      = catfile($c->config->{tempfiles_subdir}, 'anova');
 272   my $base_tmp_dir = catfile($c->config->{basepath}, $tmp_dir);
 273
 274   mkpath ([$base_tmp_dir], 0, 0755);
 275
 276   $self->anova_table_file($c);
 277   my $anova_txt_file  = $c->stash->{anova_table_txt_file};
 278   my $anova_html_file = $c->stash->{anova_table_html_file};
 279
 280   $self->anova_model_file($c);
 281   my $model_file = $c->stash->{anova_model_file};
 282
 283   $self->adj_means_file($c);
 284   my $means_file = $c->stash->{adj_means_file};
 285
 286   $self->anova_diagnostics_file($c);
 287   my $diagnostics_file = $c->stash->{anova_diagnostics_file};
 288
 289   copy($anova_txt_file, $base_tmp_dir)
 290       or die "could not copy $anova_txt_file to $base_tmp_dir";
 291
 292   copy($model_file, $base_tmp_dir)
 293       or die "could not copy $model_file to $base_tmp_dir";
 294
 295   copy($means_file, $base_tmp_dir)
 296       or die "could not copy $means_file to $base_tmp_dir";
 297
 298   copy($diagnostics_file, $base_tmp_dir)
 299       or die "could not copy $diagnostics_file to $base_tmp_dir";
 300
 301   $anova_txt_file = fileparse($anova_txt_file);
 302   $anova_txt_file = catfile($tmp_dir, $anova_txt_file);
 303
 304   $model_file = fileparse($model_file);
 305   $model_file = catfile($tmp_dir, $model_file);
 306
 307   $means_file = fileparse($means_file);
 308   $means_file = catfile($tmp_dir, $means_file);
 309
 310   $diagnostics_file = fileparse($diagnostics_file);
 311   $diagnostics_file = catfile($tmp_dir, $diagnostics_file);
 312
 313   $c->stash->{download_anova}       = $anova_txt_file;
 314   $c->stash->{download_model}       = $model_file;
 315   $c->stash->{download_means}       = $means_file;
 316   $c->stash->{download_diagnostics} = $diagnostics_file;
 317
 318 }
 319
 320
 321 sub run_anova {
 322     my ($self, $c) = @_;
 323
 324     my $trial_id = $c->stash->{trial_id};
 325     my $trait_id = $c->stash->{trait_id};
 326
 327     $self->anova_input_files($c);
 328     my $input_file = $c->stash->{anova_input_files};
 329
 330     $self->anova_output_files($c);
 331     my $output_file = $c->stash->{anova_output_files};
 332
 333     $c->stash->{analysis_tempfiles_dir} = $c->stash->{anova_temp_dir};
 334
 335     $c->stash->{input_files}  = $input_file;
 336     $c->stash->{output_files} = $output_file;
 337     $c->stash->{r_temp_file}  = "anova-${trial_id}-${trait_id}";
 338     $c->stash->{r_script}     = 'R/anova.r';
 339
 340     $c->controller("solGS::solGS")->run_r_script($c);
 341
 342 }
 343
 344
 345 sub copy_pheno_file_to_anova_dir {
 346     my ($self, $c) = @_;
 347
 348     my $trial_id = $c->stash->{trial_id};
 349
 350     $c->controller('solGS::solGS')->phenotype_file_name($c, $trial_id);
 351     my $pheno_file = $c->stash->{phenotype_file_name};
 352
 353     my $anova_cache = $c->stash->{anova_cache_dir};
 354
 355     copy($pheno_file, $anova_cache) or
 356         die "could not copy $pheno_file to $anova_cache";
 357
 358 }
 359
 360
 361 sub anova_input_files {
 362     my ($self, $c) = @_;
 363
 364     my $trial_id = $c->stash->{trial_id};
 365     my $trait_id = $c->stash->{trait_id};
 366
 367     $self->anova_pheno_file($c);
 368     my $pheno_file = $c->stash->{phenotype_file};
 369
 370     $self->anova_traits_file($c);
 371     my $traits_file = $c->stash->{anova_traits_file};
 372
 373     my $file_list = join ("\t",
 374                           $pheno_file,
 375                           $traits_file,
 376         );
 377
 378     my $tmp_dir = $c->stash->{anova_temp_dir};
 379     my $name = "anova_input_files_${trial_id}_${trait_id}";
 380     my $tempfile =  $c->controller("solGS::solGS")->create_tempfile($tmp_dir, $name);
 381     write_file($tempfile, $file_list);
 382
 383     $c->stash->{anova_input_files} = $tempfile;
 384
 385 }
 386
 387
 388 sub anova_pheno_file {
 389     my ($self, $c) = @_;
 390
 391     $c->stash->{pop_id} = $c->stash->{trial_id};
 392
 393     $c->controller('solGS::solGS')->phenotype_file($c);
 394
 395 }
 396
 397
 398 sub anova_traits_file {
 399     my ($self, $c) = @_;
 400
 401     my $trial_id = $c->stash->{trial_id};
 402     my $traits   = $c->stash->{trait_abbr};
 403
 404     my $tmp_dir = $c->stash->{anova_temp_dir};
 405     my $name    = "anova_traits_file_${trial_id}";
 406     my $traits_file =  $c->controller("solGS::solGS")->create_tempfile($tmp_dir, $name);
 407     write_file($traits_file, $traits);
 408
 409     $c->stash->{anova_traits_file} = $traits_file;
 410
 411 }
 412
 413
 414 sub anova_output_files {
 415     my ($self, $c) = @_;
 416
 417     my $trial_id = $c->stash->{trial_id};
 418     my $trait_id = $c->stash->{trait_id};
 419
 420     $self->anova_table_file($c);
 421     $self->anova_model_file($c);
 422     $self->adj_means_file($c);
 423     $self->anova_diagnostics_file($c);
 424
 425     my @files = $c->stash->{anova_table_file};
 426
 427     my $file_list = join ("\t",
 428                           $c->stash->{anova_model_file},
 429                           $c->stash->{anova_table_html_file},
 430                           $c->stash->{anova_table_txt_file},
 431                           $c->stash->{adj_means_file},
 432                           $c->stash->{anova_diagnostics_file},
 433         );
 434
 435     my $tmp_dir = $c->stash->{anova_temp_dir};
 436     my $name = "anova_output_files_${trial_id}_${trait_id}";
 437     my $tempfile =  $c->controller("solGS::solGS")->create_tempfile($tmp_dir, $name);
 438     write_file($tempfile, $file_list);
 439
 440     $c->stash->{anova_output_files} = $tempfile;
 441
 442 }
 443
 444
 445 sub anova_table_file {
 446     my ($self, $c) = @_;
 447
 448     my $trial_id = $c->stash->{trial_id};
 449     my $trait_id = $c->stash->{trait_id};
 450
 451     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};
 452
 453     my $cache_data = {key       => "anova_table_${trial_id}_${trait_id}_html",
 454                       file      => "anova_table_${trial_id}_${trait_id}.html",
 455                       stash_key => "anova_table_html_file"
 456     };
 457
 458     $c->controller("solGS::solGS")->cache_file($c, $cache_data);
 459
 460     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};
 461
 462     $cache_data = {key       => "anova_table_${trial_id}_${trait_id}_txt",
 463                    file      => "anova_table_${trial_id}_${trait_id}.txt",
 464                    stash_key => "anova_table_txt_file"
 465     };
 466
 467     $c->controller("solGS::solGS")->cache_file($c, $cache_data);
 468
 469 }
 470
 471
 472 sub anova_diagnostics_file {
 473     my ($self, $c) = @_;
 474
 475     my $trial_id = $c->stash->{trial_id};
 476     my $trait_id = $c->stash->{trait_id};
 477
 478     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};
 479
 480     my $cache_data = {key       => "anova_diagnosics_${trial_id}_${trait_id}",
 481                       file      => "anova_diagnostics_${trial_id}_${trait_id}.png",
 482                       stash_key => "anova_diagnostics_file"
 483     };
 484
 485     $c->controller("solGS::solGS")->cache_file($c, $cache_data);
 486
 487 }
 488
 489
 490 sub anova_model_file {
 491     my ($self, $c) = @_;
 492
 493     my $trial_id = $c->stash->{trial_id};
 494     my $trait_id = $c->stash->{trait_id};
 495
 496     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};;
 497
 498     my $cache_data = {key       => "anova_model_${trial_id}_${trait_id}",
 499                       file      => "anova_model_${trial_id}_${trait_id}.txt",
 500                       stash_key => "anova_model_file"
 501     };
 502
 503     $c->controller("solGS::solGS")->cache_file($c, $cache_data);
 504
 505 }
 506
 507
 508 sub adj_means_file {
 509     my ($self, $c) = @_;
 510
 511     my $trial_id = $c->stash->{trial_id};
 512     my $trait_id = $c->stash->{trait_id};
 513
 514     $c->stash->{cache_dir} = $c->stash->{anova_cache_dir};;
 515
 516     my $cache_data = {key       => "adj_means_${trial_id}_${trait_id}",
 517                       file      => "adj_means_${trial_id}_${trait_id}.txt",
 518                       stash_key => "adj_means_file"
 519     };
 520
 521     $c->controller("solGS::solGS")->cache_file($c, $cache_data);
 522
 523 }
 524
 525
 526 sub schema {
 527     my ($self, $c) = @_;
 528
 529     return $c->dbic_schema("Bio::Chado::Schema");
 530
 531 }
 532
 533
 534 sub begin : Private {
 535     my ($self, $c) = @_;
 536
 537     $c->controller("solGS::solGS")->get_solgs_dirs($c);
 538
 539 }
 540
 541
 542
 543 __PACKAGE__->meta->make_immutable;
 544
 545 1;
 546