lib/SGN/Controller/solGS/pca.pm

   1 package SGN::Controller::solGS::pca;
   2
   3 use Moose;
   4 use namespace::autoclean;
   5
   6 use File::Spec::Functions qw / catfile catdir/;
   7 use File::Path qw / mkpath  /;
   8 use File::Temp qw / tempfile tempdir /;
   9 use File::Slurp qw /write_file read_file :edit prepend_file/;
  10 use JSON;
  11
  12 use CXGN::List;
  13
  14
  15 BEGIN { extends 'Catalyst::Controller' }
  16
  17
  18 sub pca_analysis :Path('/pca/analysis/') Args(0) {
  19     my ($self, $c) = @_;
  20
  21     $c->stash->{template} = '/pca/analysis.mas';
  22
  23 }
  24
  25
  26 sub check_result :Path('/pca/check/result/') Args(1) {
  27     my ($self, $c, $pop_id) = @_;
  28
  29     $c->stash->{pop_id} = $pop_id;
  30
  31     $self->pca_scores_file($c);
  32     my $pca_scores_file = $c->stash->{pca_scores_file};
  33
  34     my $ret->{result} = undef;
  35
  36     if (-s $pca_scores_file && $pop_id =~ /\d+/)
  37     {
  38         $ret->{result} = 1;
  39     }
  40
  41     $ret = to_json($ret);
  42
  43     $c->res->content_type('application/json');
  44     $c->res->body($ret);
  45
  46 }
  47
  48
  49 sub pca_result :Path('/pca/result/') Args(1) {
  50     my ($self, $c, $pop_id) = @_;
  51
  52     $c->stash->{pop_id} = $pop_id || $c->req->param('population_id');
  53
  54     my $list_id     = $c->req->param('list_id');
  55     my $list_type   = $c->req->param('list_type');
  56     my $list_name   = $c->req->param('list_name');
  57
  58     if ($list_id)
  59     {
  60         $c->stash->{data_set_type} = 'list';
  61         $c->stash->{list_id}       = $list_id;
  62         $c->stash->{list_type}     = $list_type;
  63     }
  64
  65     $self->create_pca_genotype_data($c);
  66
  67     my @genotype_files_list;
  68     my $geno_file;
  69     if ($c->stash->{genotype_files_list})
  70     {
  71         @genotype_files_list = @{$c->stash->{genotype_files_list}};
  72         $geno_file = $genotype_files_list[0] if !$genotype_files_list[1];
  73     }
  74     else
  75     {
  76         $geno_file = $c->stash->{genotype_file};
  77     }
  78
  79     $self->pca_scores_file($c);
  80     my $pca_scores_file = $c->stash->{pca_scores_file};
  81
  82     $self->pca_variance_file($c);
  83     my $pca_variance_file = $c->stash->{pca_variance_file};
  84
  85     my $ret->{status} = 'PCA analysis failed.';
  86     if( !-s $pca_scores_file)
  87     {
  88         if (!-s $geno_file )
  89         {
  90             $ret->{status} = 'There is no genotype data. Aborted PCA analysis.';
  91         }
  92         else
  93         {
  94             $self->run_pca($c);
  95         }
  96     }
  97
  98     my $pca_scores = $c->controller('solGS::solGS')->convert_to_arrayref_of_arrays($c, $pca_scores_file);
  99     my $pca_variances = $c->controller('solGS::solGS')->convert_to_arrayref_of_arrays($c, $pca_variance_file);
 100
 101     if ($pca_scores)
 102     {
 103         $ret->{pca_scores} = $pca_scores;
 104         $ret->{pca_variances} = $pca_variances;
 105         $ret->{status} = 'success';
 106         $ret->{pop_id} = $c->stash->{pop_id} if $list_type eq 'trials';
 107     }
 108
 109     $ret = to_json($ret);
 110
 111     $c->res->content_type('application/json');
 112     $c->res->body($ret);
 113
 114 }
 115
 116
 117 sub download_pca_scores : Path('/download/pca/scores/population') Args(1) {
 118     my ($self, $c, $id) = @_;
 119
 120     $self->create_pca_dir($c);
 121     my $pca_dir = $c->stash->{pca_dir};
 122     my $pca_file = catfile($pca_dir,  "pca_scores_${id}");
 123
 124     unless (!-e $pca_file || -s $pca_file <= 1)
 125     {
 126         my @pca_data;
 127         my $count=1;
 128
 129         foreach my $row ( read_file($pca_file) )
 130         {
 131             if ($count==1) {  $row = 'Individuals' . $row;}
 132             $row = join(",", split(/\s/, $row));
 133             $row .= "\n";
 134
 135             push @pca_data, [ $row ];
 136             $count++;
 137         }
 138
 139         $c->res->content_type("text/plain");
 140         $c->res->body(join "",  map{ $_->[0] } @pca_data);
 141     }
 142 }
 143
 144
 145 sub pca_genotypes_list :Path('/pca/genotypes/list') Args(0) {
 146     my ($self, $c) = @_;
 147
 148     my $list_id   = $c->req->param('list_id');
 149     my $list_name = $c->req->param('list_name');
 150     my $list_type = $c->req->param('list_type');
 151     my $pop_id    = $c->req->param('population_id');
 152
 153     $c->stash->{list_name} = $list_name;
 154     $c->stash->{list_id}   = $list_id;
 155     $c->stash->{pop_id}    = $pop_id;
 156     $c->stash->{list_type} = $list_type;
 157
 158     $c->stash->{data_set_type} = 'list';
 159     $self->create_pca_genotype_data($c);
 160
 161     my $geno_file = $c->stash->{genotype_file};
 162
 163     my $ret->{status} = 'failed';
 164     if (-s $geno_file )
 165     {
 166         $ret->{status} = 'success';
 167     }
 168
 169     $ret = to_json($ret);
 170
 171     $c->res->content_type('application/json');
 172     $c->res->body($ret);
 173
 174 }
 175
 176
 177 sub format_pca_scores {
 178    my ($self, $c) = @_;
 179
 180    my $file = $c->stash->{pca_scores_file};
 181    my $data = $c->controller('solGS::solGS')->convert_to_arrayref_of_arrays($c, $file);
 182
 183    $c->stash->{pca_scores} = $data;
 184
 185 }
 186
 187
 188 sub create_pca_genotype_data {
 189     my ($self, $c) = @_;
 190
 191     my $data_set_type = $c->stash->{data_set_type};
 192
 193     if ($data_set_type =~ /list/)
 194     {
 195         $self->_pca_list_genotype_data($c);
 196
 197     }
 198     else
 199     {
 200         $self->_pca_trial_genotype_data($c);
 201     }
 202
 203 }
 204
 205
 206 sub _pca_list_genotype_data {
 207     my ($self, $c) = @_;
 208
 209     my $list_id = $c->stash->{list_id};
 210     my $list_type = $c->stash->{list_type};
 211     my $pop_id = $c->stash->{pop_id};
 212
 213     my $referer = $c->req->referer;
 214     my $geno_file;
 215
 216     if ($referer =~ /solgs\/trait\/\d+\/population\/|solgs\/selection\//)
 217     {
 218         $c->controller('solGS::solGS')->genotype_file_name($c, $pop_id);
 219         $geno_file  = $c->stash->{genotype_file_name};
 220         $c->stash->{genotype_file} = $geno_file;
 221
 222     }
 223     else
 224     {
 225         if ($list_type eq 'accessions')
 226         {
 227
 228             my $list = CXGN::List->new( { dbh => $c->dbc()->dbh(), list_id => $list_id });
 229             my @genotypes_list = @{$list->elements};
 230
 231             $c->stash->{genotypes_list} = \@genotypes_list;
 232             my $geno_data = $c->model('solGS::solGS')->genotypes_list_genotype_data(\@genotypes_list);
 233
 234             my $tmp_dir = $c->stash->{solgs_prediction_upload_dir};
 235             my $file = "genotype_data_uploaded_${list_id}";
 236             $file = $c->controller("solGS::solGS")->create_tempfile($tmp_dir, $file);
 237
 238             write_file($file, $geno_data);
 239             $c->stash->{genotype_file} = $file;
 240
 241         }
 242         elsif ( $list_type eq 'trials')
 243         {
 244             my $list = CXGN::List->new( { dbh => $c->dbc()->dbh(), list_id => $list_id });
 245             my @trials_list = @{$list->elements};
 246
 247             my @genotype_files;
 248             foreach (@trials_list)
 249             {
 250                 my $trial_id = $c->model("solGS::solGS")
 251                     ->project_details_by_name($_)
 252                     ->first
 253                     ->project_id;
 254
 255                 $c->stash->{pop_id} = $trial_id;
 256                 $self->_pca_trial_genotype_data($c);
 257                 push @genotype_files, $c->stash->{genotype_file};
 258             }
 259
 260             $c->stash->{genotype_files_list} = \@genotype_files;
 261         }
 262     }
 263
 264 }
 265
 266
 267 sub _pca_trial_genotype_data {
 268     my ($self, $c) = @_;
 269
 270     my $referer = $c->req->referer;
 271     my $pop_id = $c->stash->{pop_id};
 272
 273     my $geno_file;
 274
 275     if ($referer =~ /solgs\/selection\//)
 276     {
 277         $c->stash->{selection_pop_id} = $c->stash->{pop_id};
 278         $c->controller('solGS::solGS')->filtered_selection_genotype_file($c, $pop_id);
 279         $geno_file = $c->stash->{filtered_selection_genotype_file};
 280     }
 281     else
 282     {
 283         $c->stash->{training_pop_id} = $c->stash->{pop_id};
 284         $c->controller('solGS::solGS')->filtered_training_genotype_file($c, $pop_id);
 285         $geno_file = $c->stash->{filtered_training_genotype_file};
 286
 287     }
 288
 289     if (!-s $geno_file)
 290     {
 291         $c->controller('solGS::solGS')->genotype_file_name($c, $pop_id);
 292         $geno_file = $c->stash->{genotype_file_name};
 293     }
 294
 295     if (-s $geno_file)
 296     {
 297         $c->stash->{genotype_file} = $geno_file;
 298     }
 299     else
 300     {
 301         $c->controller("solGS::solGS")->genotype_file($c);
 302     }
 303
 304 }
 305
 306 sub create_pca_dir {
 307     my ($self, $c) = @_;
 308
 309     $c->controller("solGS::solGS")->get_solgs_dirs($c);
 310
 311 }
 312
 313
 314 sub pca_scores_file {
 315     my ($self, $c) = @_;
 316
 317     my $pop_id = $c->stash->{pop_id};
 318
 319     $self->create_pca_dir($c);
 320     my $pca_dir = $c->stash->{pca_dir};
 321
 322     $c->stash->{cache_dir} = $pca_dir;
 323
 324     my $cache_data = {key       => "pca_scores_${pop_id}",
 325                       file      => "pca_scores_${pop_id}",,
 326                       stash_key => 'pca_scores_file'
 327     };
 328
 329     $c->controller("solGS::solGS")->cache_file($c, $cache_data);
 330
 331 }
 332
 333
 334 sub pca_variance_file {
 335     my ($self, $c) = @_;
 336
 337     my $pop_id = $c->stash->{pop_id};
 338
 339     $self->create_pca_dir($c);
 340     my $pca_dir = $c->stash->{pca_dir};
 341
 342     $c->stash->{cache_dir} = $pca_dir;
 343
 344     my $cache_data = {key       => "pca_variance_${pop_id}",
 345                       file      => "pca_variance_${pop_id}",,
 346                       stash_key => 'pca_variance_file'
 347     };
 348
 349     $c->controller("solGS::solGS")->cache_file($c, $cache_data);
 350
 351 }
 352
 353
 354 sub pca_loadings_file {
 355     my ($self, $c) = @_;
 356
 357     my $pop_id = $c->stash->{pop_id};
 358
 359     $self->create_pca_dir($c);
 360     my $pca_dir = $c->stash->{pca_dir};
 361
 362     $c->stash->{cache_dir} = $pca_dir;
 363
 364     my $cache_data = {key       => "pca_loadings_${pop_id}",
 365                       file      => "pca_loadings_${pop_id}",,
 366                       stash_key => 'pca_loadings_file'
 367     };
 368
 369     $c->controller("solGS::solGS")->cache_file($c, $cache_data);
 370
 371 }
 372
 373
 374 sub pca_output_files {
 375     my ($self, $c) = @_;
 376
 377     $self->pca_scores_file($c);
 378     $self->pca_loadings_file($c);
 379     $self->pca_variance_file($c);
 380
 381     my $file_list = join ("\t",
 382                           $c->stash->{pca_scores_file},
 383                           $c->stash->{pca_loadings_file},
 384                           $c->stash->{pca_variance_file},
 385         );
 386
 387     my $pop_id = $c->stash->{pop_id};
 388     my $tmp_dir = $c->stash->{solgs_tempfiles_dir};
 389     my $name = "pca_output_files_${pop_id}";
 390     my $tempfile =  $c->controller("solGS::solGS")->create_tempfile($tmp_dir, $name);
 391     write_file($tempfile, $file_list);
 392
 393     $c->stash->{output_files} = $tempfile;
 394
 395 }
 396
 397
 398 sub run_pca {
 399     my ($self, $c) = @_;
 400
 401     my $pop_id = $c->stash->{pop_id};
 402
 403     my $pca_output_file = $self->pca_output_files($c);
 404     my $geno_file = $c->stash->{genotype_file};
 405
 406     $c->stash->{input_files}  = $geno_file;
 407     $c->stash->{output_files} = $pca_output_file;
 408     $c->stash->{r_temp_file}  = "pca-${pop_id}";
 409     $c->stash->{r_script}     = 'R/solGS/pca.r';
 410
 411     $c->controller("solGS::solGS")->run_r_script($c);
 412
 413 }
 414
 415
 416 sub begin : Private {
 417     my ($self, $c) = @_;
 418
 419     $c->controller("solGS::solGS")->get_solgs_dirs($c);
 420
 421 }
 422
 423
 424
 425 __PACKAGE__->meta->make_immutable;
 426
 427 ####
 428 1;
 429 ####