lib/SGN/Controller/AJAX/MixedModels.pm

   1
   2 package SGN::Controller::AJAX::MixedModels;
   3
   4 use Moose;
   5
   6 use Data::Dumper;
   7 use File::Slurp;
   8 use File::Spec qw | catfile |;
   9 use JSON::Any;
  10 use File::Basename qw | basename |;
  11 use DateTime;
  12 use CXGN::Dataset::File;
  13 use CXGN::Phenotypes::File;
  14 use CXGN::MixedModels;
  15
  16 BEGIN { extends 'Catalyst::Controller::REST' };
  17
  18 __PACKAGE__->config(
  19     default => 'application/json',
  20     stash_key => 'rest',
  21     map => { 'application/json' => 'JSON' },
  22    );
  23
  24
  25 select(STDERR);
  26 $| = 1;
  27
  28 sub model_string: Path('/ajax/mixedmodels/modelstring') Args(0) {
  29     my $self = shift;
  30     my $c = shift;
  31
  32     my $params = $c->req->body_data();
  33
  34     my $engine = $params->{engine};
  35     print STDERR "ENGINE: $engine\n";
  36     my $fixed_factors = $params->{fixed_factors};
  37     print STDERR "FIXED FACTORS IN MODEL STRING: ".Dumper($fixed_factors)."\n";
  38
  39     my $fixed_factors_interaction = $params->{fixed_factors_interaction};
  40
  41     my $variable_slope_intersects = $params->{variable_slope_intersects};
  42
  43     my $random_factors = $params->{random_factors};
  44     my $dependent_variables = $params->{dependent_variables};
  45
  46     my $mm = CXGN::MixedModels->new();
  47     if ($dependent_variables) {
  48         $mm->dependent_variables($dependent_variables);
  49     }
  50     if ($fixed_factors) {
  51         $mm->fixed_factors( $fixed_factors );
  52     }
  53     if ($fixed_factors_interaction) {
  54         $mm->fixed_factors_interaction( $fixed_factors_interaction );
  55     }
  56     if ($variable_slope_intersects) {
  57         $mm->variable_slope_intersects( $variable_slope_intersects);
  58     }
  59     if ($random_factors) {
  60         $mm->random_factors( $random_factors );
  61     }
  62
  63     my ($model, $error);
  64     if ($engine eq "sommer") {
  65         print STDERR "Generating sommer model...\n";
  66         ($model, $error) = $mm->generate_model_sommer();
  67     }
  68     elsif ($engine eq "lme4") {
  69         print STDERR "Generating lme4 model...\n";
  70         ($model, $error) =  $mm->generate_model();
  71     }
  72     else {
  73         die "Do not know what engine $engine is!\n";
  74     }
  75
  76     print STDERR "MODEL: ".Dumper($model)." ERROR: $error\n";
  77
  78     $c->stash->{rest} = {
  79         error => $error,
  80         model => $model,
  81         dependent_variables => $dependent_variables,
  82         engine => $engine,
  83     };
  84 }
  85
  86 sub prepare: Path('/ajax/mixedmodels/prepare') Args(0) {
  87     my $self = shift;
  88     my $c = shift;
  89     my $dataset_id = $c->req->param('dataset_id');
  90
  91     if (! $c->user()) {
  92         $c->stash->{rest} = {error=>'You must be logged in first!'};
  93         $c->detach;
  94     }
  95
  96     $c->tempfiles_subdir("mixedmodels");
  97
  98     my ($fh, $tempfile) = $c->tempfile(TEMPLATE=>"mixedmodels/mm_XXXXX");
  99
 100     my $people_schema = $c->dbic_schema("CXGN::People::Schema");
 101     my $schema = $c->dbic_schema("Bio::Chado::Schema", "sgn_chado");
 102     my $temppath = $c->config->{basepath}."/".$tempfile;
 103
 104     my $ds = CXGN::Dataset::File->new(people_schema => $people_schema, schema => $schema, sp_dataset_id => $dataset_id, file_name => $temppath, quotes => 0);
 105     $ds->retrieve_phenotypes();
 106
 107     # Note: file is cleaned by run_model function in CXGN::MixedModel
 108
 109     my $pf = CXGN::Phenotypes::File->new( { file => $temppath."_phenotype.txt" });
 110
 111     my @factor_select;
 112
 113     # only use if factor has multiple levels, start from appropriate hardcoded list
 114     #
 115     my @factors = qw | studyYear programName studyName studyDesign plantingDate locationName replicate rowNumber colNumber germplasmName|;
 116     foreach my $factor (@factors) {
 117         if ($pf->distinct_levels_for_factor($factor) > 1) {
 118             push @factor_select, $factor;
 119         }
 120     }
 121
 122     my @traits_select = ();
 123     my $traits = $pf->traits();
 124
 125     #my $trait_select_checkbox = "trait_select_checkbox";
 126     my $dependent_variable_select = "dependent_variable_select";
 127
 128   my $trait_html ="";
 129
 130      foreach my $trait (@$traits) {
 131        if ($trait =~ m/.+\d{7}/){
 132         $trait_html .= '<input type="checkbox" class= "trait_box" name="'.$dependent_variable_select.'" value="'.$trait.'">'.$trait.'</input> </br>';
 133       }
 134        }
 135         #$html .= "</tbody></table>";
 136
 137        #$html .= "<script>jQuery(document).ready(function() { jQuery('#html-dependent_variable_select').DataTable({ 'lengthMenu': [[2, 4, 6, 8, 10, 25, 50, -1], [2, 4, 6, 8, 10, 25, 50, 'All']] }); } );</script>";
 138
 139         #$c->stash->{rest} = { select => $html };
 140
 141     $c->stash->{rest} = {
 142
 143         dependent_variable => $trait_html,
 144
 145         factors => \@factor_select,
 146         tempfile => $tempfile."_phenotype.txt",
 147      };
 148
 149     if (!@factor_select) {
 150         $c->stash->{rest}->{error} = "There are no factors with multiple levels in this dataset.";
 151     }
 152 }
 153
 154 sub run: Path('/ajax/mixedmodels/run') Args(0) {
 155     my $self = shift;
 156     my $c = shift;
 157
 158     my $params = $c->req()->params();
 159
 160     my $tempfile = $params->{tempfile};
 161     my $dependent_variables = $params->{'dependent_variables[]'};
 162     if (!ref($dependent_variables)) {
 163         $dependent_variables = [ $dependent_variables ];
 164     }
 165     my $model  = $params->{model};
 166     my $random_factors = $params->{'random_factors[]'}; #
 167     if (!ref($random_factors)) {
 168         $random_factors = [ $random_factors ];
 169     }
 170     my $fixed_factors = $params->{'fixed_factors[]'}; #   "
 171     if (!ref($fixed_factors)) {
 172         $fixed_factors = [ $fixed_factors ];
 173     }
 174
 175     print STDERR "sub run: FIXED FACTORS: ".Dumper($fixed_factors)." RANDOM FACTORS: ".Dumper($random_factors)."\n";
 176     my $engine = $params->{engine};
 177
 178     print STDERR "ENGINE = $engine\n";
 179
 180     my $mm = CXGN::MixedModels->new( { tempfile => $c->config->{basepath}."/".$tempfile });
 181
 182     $mm->dependent_variables($dependent_variables);
 183     $mm->random_factors($random_factors);
 184     $mm->fixed_factors($fixed_factors);
 185     $mm->engine($engine);
 186     my $error = $mm->run_model($c->config->{backend}, $c->config->{cluster_host}, $c->config->{cluster_shared_tempdir} . "/mixed_models" );
 187
 188     my $temppath = $c->config->{basepath}."/".$tempfile;
 189
 190     my $adjusted_blups_file = $temppath.".adjustedBLUPs";
 191     #print STDERR "ADJUSTED BLUP FILES: ".Dumper($adjusted_blups_file);
 192     my $blupfile = $temppath.".BLUPs";
 193     my $bluefile = $temppath.".BLUEs";
 194     my $adjusted_blues_file = $temppath.".adjustedBLUEs";
 195     my $anovafile = $temppath.".anova";
 196     my $varcompfile = $temppath.".varcomp";
 197     my $lines;
 198
 199     my $accession_names;
 200
 201     my $adjusted_blups_html;
 202     my $adjusted_blups_data;
 203
 204     my $adjusted_blues_html;
 205     my $adjusted_blues_data;
 206
 207     my $traits;
 208
 209     my $method;
 210
 211     # we need either a blup or blue result file. Check for these and otherwise return an error!
 212     #
 213
 214
 215     if ( -e $adjusted_blups_file) {
 216         $method = "random";
 217         ($adjusted_blups_data, $adjusted_blups_html, $accession_names, $traits) = $self->result_file_to_hash($c, $adjusted_blups_file);
 218     }
 219     elsif (-e $adjusted_blues_file) {
 220         $method = "fixed";
 221         ($adjusted_blues_data, $adjusted_blues_html, $accession_names, $traits) = $self->result_file_to_hash($c, $adjusted_blues_file);
 222     }
 223     else {
 224         if (! $error) {
 225             $error = "The analysis could not be completed. The factors may not have sufficient numbers of levels to complete the analysis. Please choose other parameters.";
 226         }
 227         $c->stash->{rest} = { error => $error };
 228         return;
 229     }
 230
 231     # read other result files, if they exist and parse into data structures
 232     #
 233     my $blups_html;
 234     my $blups_data;
 235     my $blues_html;
 236     my $blues_data;
 237     if (-e $blupfile) {
 238         $method = "random";
 239         ($blups_data, $blups_html, $accession_names, $traits) = $self->result_file_to_hash($c, $blupfile);
 240     }
 241
 242     elsif (-e $bluefile) {
 243         $method= "fixed";
 244         ($blues_data, $blues_html, $accession_names, $traits) = $self->result_file_to_hash($c, $bluefile);
 245     }
 246
 247     else {
 248         $error = "The analysis could not be completed. The factors may not have sufficient numbers of levels to complete the analysis. Please choose other parameters.";
 249         $c->stash->{rest} = { error => $error };
 250         return;
 251     }
 252
 253     my $response = {
 254         error => $error,
 255         accession_names => $accession_names,
 256         adjusted_blups_data => $adjusted_blups_data,
 257         adjusted_blups_html => $adjusted_blups_html,
 258         adjusted_blues_data => $adjusted_blues_data,
 259         adjusted_blues_html => $adjusted_blues_html,
 260         blups_data => $blups_data,
 261         blups_html => $blups_html,
 262         blues_data => $blues_data,
 263         blues_html => $blues_html,
 264         method => $method,
 265         input_file => $temppath,
 266         traits => $traits
 267     };
 268
 269     $c->stash->{rest} = $response;
 270 }
 271
 272 sub result_file_to_hash {
 273     my $self = shift;
 274     my $c = shift;
 275     my $file = shift;
 276
 277     print STDERR "result_file_to_hash(): Processing file $file...\n";
 278     my @lines = read_file($file);
 279     chomp(@lines);
 280
 281     my $header_line = shift(@lines);
 282     my ($accession_header, @value_cols) = split /\t/, $header_line;
 283
 284     my $now = DateTime->now();
 285     my $timestamp = $now->ymd()."T".$now->hms();
 286
 287     my $operator = $c->user()->get_object()->get_first_name()." ".$c->user()->get_object()->get_last_name();
 288
 289     my @fields;
 290     my @accession_names;
 291     my %analysis_data;
 292
 293     my $html = qq | <style> th, td {padding: 10px;} </style> \n <table cellpadding="20" cellspacing="20"> |;
 294
 295     $html .= "<br><tr><th>accession name</th>";
 296     for (my $m=0; $m<@value_cols; $m++) {
 297       $html .= "<th scope=\"col\">".($value_cols[$m])."</th>";
 298     }
 299     $html .= "</tr><tr>";
 300     foreach my $line (@lines) {
 301         my ($accession_name, @values) = split /\t/, $line;
 302         push @accession_names, $accession_name;
 303         $html .= "<tr><td>$accession_name</td>";
 304
 305         for (my $k=0; $k<@value_cols; $k++) {
 306             #print STDERR "adding  $values[$k] to column $value_cols[$k]\n";
 307             $html .= "<td>".($values[$k])."</td>";
 308         }
 309
 310         for(my $n=0; $n<@values; $n++) {
 311             #print STDERR "Building hash for trait $accession_name and value $value_cols[$n]\n";
 312             $analysis_data{$accession_name}->{$value_cols[$n]} = [ $values[$n], $timestamp, $operator, "", "" ];
 313
 314
 315
 316         }
 317         $html .= "</tr>"
 318     }
 319     $html .= "</table>";
 320
 321     #print STDERR "Analysis data formatted: ".Dumper(\%analysis_data);
 322
 323     return (\%analysis_data, $html, \@accession_names, \@value_cols);
 324 }
 325
 326
 327 sub extract_trait_data :Path('/ajax/mixedmodels/grabdata') Args(0) {
 328     my $self = shift;
 329     my $c = shift;
 330
 331     my $file = $c->req->param("file");
 332     my $trait = $c->req->param("trait");
 333
 334     $file = basename($file);
 335
 336     my $temppath = File::Spec->catfile($c->config->{basepath}, "static/documents/tempfiles/mixedmodels/".$file);
 337
 338     my $F;
 339     if (! open($F, "<", $temppath)) {
 340         $c->stash->{rest} = { error => "Can't find data." };
 341         return;
 342     }
 343
 344     my $header = <$F>;
 345     chomp($header);
 346
 347     my @keys = split("\t", $header);
 348
 349     my @data = ();
 350
 351     while (<$F>) {
 352         chomp;
 353
 354         my @fields = split "\t";
 355         my %line = ();
 356         for(my $n=0; $n <@keys; $n++) {
 357             if (exists($fields[$n]) && defined($fields[$n])) {
 358                 $line{$keys[$n]}=$fields[$n];
 359             }
 360         }
 361         push @data, \%line;
 362     }
 363
 364     $c->stash->{rest} = { data => \@data, trait => $trait};
 365 }
 366
 367
 368 sub make_R_trait_name {
 369     my $trait = shift;
 370     $trait =~ s/\s/\_/g;
 371     $trait =~ s/\//\_/g;
 372     $trait =~ tr/ /./;
 373     $trait =~ tr/\//./;
 374     $trait =~ s/\:/\_/g;
 375     $trait =~ s/\|/\_/g;
 376     $trait =~ s/\-/\_/g;
 377
 378     return $trait;
 379 }
 380
 381
 382 1;