lib/SGN/Controller/solGS/Search.pm

   1
   2 =head1 AUTHOR
   3
   4 Isaak Y Tecle <iyt2@cornell.edu>
   5
   6 =head1 LICENSE
   7
   8 This library is free software. You can redistribute it and/or modify
   9 it under the same terms as Perl itself.
  10 # Sets the actions in this controller to be registered with no prefix
  11 # so they function identically to actions created in MyApp.pm
  12 #
  13
  14 =cut
  15
  16 package SGN::Controller::solGS::Search;
  17
  18 use Moose;
  19 use namespace::autoclean;
  20
  21 use Algorithm::Combinatorics qw /combinations/;
  22 use Array::Utils qw(:all);
  23 use Carp qw/ carp confess croak /;
  24 use File::Slurp qw /write_file read_file/;
  25 use File::Copy;
  26 use File::Basename;
  27 use JSON;
  28 use List::MoreUtils qw /uniq/;
  29 use Try::Tiny;
  30
  31 BEGIN { extends 'Catalyst::Controller' }
  32
  33 sub solgs : Path('/solgs') {
  34     my ( $self, $c ) = @_;
  35     $c->forward('search');
  36 }
  37
  38 sub solgs_breeder_search : Path('/solgs/breeder_search') Args(0) {
  39     my ( $self, $c ) = @_;
  40     $c->stash->{referer}  = $c->req->referer();
  41     $c->stash->{template} = '/solgs/search/breeder_search_solgs.mas';
  42 }
  43
  44 sub solgs_login_message : Path('/solgs/login/message') Args(0) {
  45     my ( $self, $c ) = @_;
  46
  47     my $page = $c->req->param('page');
  48
  49     my $msg = "This is a private data. If you are the owner, "
  50       . "please <a href=\"/user/login?goto_url=$page\">login</a> to view it.";
  51
  52     $c->controller('solGS::Utils')->generic_message( $c, $msg );
  53
  54     $c->stash->{template} = "/generic_message.mas";
  55
  56 }
  57
  58 sub search : Path('/solgs/search') Args() {
  59     my ( $self, $c ) = @_;
  60
  61     # $self->gs_traits_index($c);
  62     # my $gs_traits_index = $c->stash->{gs_traits_index};
  63
  64     $c->stash(
  65         template =>
  66           $c->controller('solGS::Files')->template('/search/solgs.mas'),
  67
  68         # gs_traits_index => $gs_traits_index,
  69     );
  70
  71 }
  72
  73 sub search_trials : Path('/solgs/search/trials') Args() {
  74     my ( $self, $c ) = @_;
  75
  76     my $show_result = $c->req->param('show_result');
  77
  78     my $limit = $show_result =~ /all/ ? undef : 10;
  79
  80     my $projects_ids = $self->model($c)->all_gs_projects($limit);
  81
  82     my $ret->{status} = 'failed';
  83     my $formatted_trials = [];
  84
  85     if (@$projects_ids) {
  86         my $projects_rs = $self->model($c)->project_details( [$projects_ids] );
  87
  88         $self->get_projects_details( $c, $projects_rs );
  89         my $projects = $c->stash->{projects_details};
  90
  91         $self->format_gs_projects( $c, $projects );
  92         $formatted_trials = $c->stash->{formatted_gs_projects};
  93
  94         $ret->{status} = 'success';
  95     }
  96
  97     $ret->{trials} = $formatted_trials;
  98     $ret = to_json($ret);
  99
 100     $c->res->content_type('application/json');
 101     $c->res->body($ret);
 102
 103 }
 104
 105 sub search_trials_trait : Path('/solgs/search/trials/trait') Args() {
 106     my ( $self, $c, $trait_id, $gp, $protocol_id ) = @_;
 107
 108     $c->controller('solGS::Trait')->get_trait_details( $c, $trait_id );
 109     $c->stash->{genotyping_protocol_id} = $protocol_id;
 110
 111     $c->stash->{template} =
 112       $c->controller('solGS::Files')->template('/search/trials/trait.mas');
 113
 114 }
 115
 116 sub show_search_result_pops : Path('/solgs/search/result/populations') Args() {
 117     my ( $self, $c, $trait_id, $gp, $protocol_id ) = @_;
 118
 119     my $combine = $c->req->param('combine');
 120     my $page    = $c->req->param('page') || 1;
 121
 122     my $projects_ids =
 123       $self->model($c)->search_trait_trials( $trait_id, $protocol_id );
 124
 125     my $ret->{status} = 'failed';
 126     my $formatted_projects = [];
 127
 128     if (@$projects_ids) {
 129         my $projects_rs = $self->model($c)->project_details($projects_ids);
 130         my $trait       = $self->model($c)->trait_name($trait_id);
 131
 132         $self->get_projects_details( $c, $projects_rs );
 133         my $projects = $c->stash->{projects_details};
 134
 135         $self->format_trait_gs_projects( $c, $trait_id, $projects,
 136             $protocol_id );
 137         $formatted_projects = $c->stash->{formatted_gs_projects};
 138
 139         $ret->{status} = 'success';
 140     }
 141
 142     $ret->{trials} = $formatted_projects;
 143
 144     $ret = to_json($ret);
 145
 146     $c->res->content_type('application/json');
 147     $c->res->body($ret);
 148
 149 }
 150
 151 sub search_traits : Path('/solgs/search/traits/') Args() {
 152     my ( $self, $c, $query, $gp, $protocol_id ) = @_;
 153
 154     my $traits = $self->model($c)->search_trait($query);
 155     my $result = $self->model($c)->trait_details($traits);
 156
 157     my $ret->{status} = 0;
 158     if ( $result->first ) {
 159         $ret->{status}                 = 1;
 160         $ret->{genotyping_protocol_id} = $protocol_id;
 161     }
 162
 163     $ret = to_json($ret);
 164
 165     $c->res->content_type('application/json');
 166     $c->res->body($ret);
 167
 168 }
 169
 170 sub load_acronyms : Path('/solgs/load/trait/acronyms') Args() {
 171     my ( $self, $c ) = @_;
 172
 173     my $id = $c->req->param('id');
 174     $c->controller('solGS::Trait')->get_all_traits( $c, $id );
 175     my $acronyms = $c->controller('solGS::Trait')->get_acronym_pairs( $c, $id );
 176
 177     my $ret->{acronyms} = $acronyms;
 178     my $json = JSON->new();
 179     $ret = $json->encode($ret);
 180
 181     $c->res->content_type('application/json');
 182     $c->res->body($ret);
 183
 184 }
 185
 186 sub gs_traits : Path('/solgs/traits') Args(1) {
 187     my ( $self, $c, $index ) = @_;
 188
 189     my @traits_list;
 190
 191     if ( $index =~ /^\w{1}$/ ) {
 192         $self->traits_starting_with( $c, $index );
 193         my $traits_gr = $c->stash->{trait_subgroup};
 194
 195         foreach my $trait (@$traits_gr) {
 196             $self->hyperlink_traits( $c, $trait );
 197             my $trait_url = $c->stash->{traits_urls};
 198
 199             $c->controller('solGS::Trait')->get_trait_details( $c, $trait );
 200             push @traits_list, [ $trait_url, $c->stash->{trait_def} ];
 201         }
 202
 203         $c->stash(
 204             template => $c->controller('solGS::Files')
 205               ->template('/search/traits/list.mas'),
 206             index       => $index,
 207             traits_list => \@traits_list
 208         );
 209     }
 210     else {
 211         $c->forward('search');
 212     }
 213 }
 214
 215 sub show_search_result_traits : Path('/solgs/search/result/traits') Args() {
 216     my ( $self, $c, $query, $gp, $protocol_id ) = @_;
 217
 218     my $traits = $self->model($c)->search_trait($query);
 219     my $result = $self->model($c)->trait_details($traits);
 220
 221     my @rows;
 222     while ( my $row = $result->next ) {
 223         my $id   = $row->cvterm_id;
 224         my $name = $row->name;
 225         my $def  = $row->definition;
 226
 227         push @rows,
 228           [
 229 qq |<a href="/solgs/search/trials/trait/$id/gp/$protocol_id"  onclick="solGS.waitPage()">$name</a>|,
 230             $def
 231           ];
 232     }
 233
 234     if (@rows) {
 235         $c->stash(
 236             template => $c->controller('solGS::Files')
 237               ->template('/search/result/traits.mas'),
 238             result                 => \@rows,
 239             query                  => $query,
 240             genotyping_protocol_id => $protocol_id
 241         );
 242     }
 243
 244 }
 245
 246 sub check_genotype_data_population :
 247   Path('/solgs/check/genotype/data/population/') Args(1) {
 248     my ( $self, $c, $pop_id ) = @_;
 249
 250     $c->stash->{pop_id} = $pop_id;
 251     my $ret->{has_genotype} = $self->check_population_has_genotype($c);
 252
 253     $ret = to_json($ret);
 254
 255     $c->res->content_type('application/json');
 256     $c->res->body($ret);
 257
 258 }
 259
 260 sub check_phenotype_data_population :
 261   Path('/solgs/check/phenotype/data/population/') Args(1) {
 262     my ( $self, $c, $pop_id ) = @_;
 263
 264     $c->stash->{pop_id} = $pop_id;
 265     my $ret->{has_phenotype} = $self->check_population_has_phenotype($c);
 266
 267     $ret = to_json($ret);
 268
 269     $c->res->content_type('application/json');
 270     $c->res->body($ret);
 271
 272 }
 273
 274 sub check_population_exists : Path('/solgs/check/population/exists/') Args(0) {
 275     my ( $self, $c ) = @_;
 276
 277     my $name = $c->req->param('name');
 278
 279     my $rs = $self->model($c)->project_details_by_name($name);
 280
 281     my @pop_ids;
 282     while ( my $row = $rs->next ) {
 283         push @pop_ids, $row->id;
 284         my $id = $row->id;
 285     }
 286
 287     my $ret->{population_ids} = \@pop_ids;
 288     $ret = to_json($ret);
 289
 290     $c->res->content_type('application/json');
 291     $c->res->body($ret);
 292
 293 }
 294
 295 sub check_training_population : Path('/solgs/check/training/population/')
 296   Args() {
 297     my ( $self, $c ) = @_;
 298
 299     $c->controller('solGS::Utils')
 300       ->stash_json_args( $c, $c->req->param('arguments') );
 301     my @pop_ids     = $c->stash->{population_ids};
 302     my $protocol_id = $c->stash->{genotyping_protocol_id};
 303
 304     my @gs_pop_ids;
 305
 306     foreach my $pop_id (@pop_ids) {
 307         $c->stash->{pop_id}          = $pop_id;
 308         $c->stash->{training_pop_id} = $pop_id;
 309
 310         my $is_training_pop =
 311           $self->check_population_is_training_population( $c, $pop_id,
 312             $protocol_id );
 313
 314         if ($is_training_pop) {
 315             push @gs_pop_ids, $pop_id;
 316         }
 317     }
 318
 319     my $training_pop_data;
 320     my $ret = { is_training_population => 0 };
 321     if (@gs_pop_ids) {
 322         my $pr_rs = $self->model($c)->project_details( \@gs_pop_ids );
 323         $self->projects_links( $c, $pr_rs );
 324         $training_pop_data             = $c->stash->{projects_pages};
 325         $ret->{is_training_population} = 1 if @gs_pop_ids;
 326         $ret->{training_pop_data}      = $training_pop_data;
 327     }
 328
 329     $ret = to_json($ret);
 330     $c->res->content_type('application/json');
 331     $c->res->body($ret);
 332
 333 }
 334
 335 sub search_selection_pops : Path('/solgs/search/selection/populations/') {
 336     my ( $self, $c, $tr_pop_id ) = @_;
 337
 338     $c->controller('solGS::Utils')
 339       ->stash_json_args( $c, $c->req->param('arguments') );
 340
 341     $self->search_all_relevant_selection_pops( $c, $tr_pop_id );
 342     my $selection_pops_list = $c->stash->{all_relevant_selection_pops};
 343
 344     my $ret->{selection_pops_list} = 0;
 345     if ($selection_pops_list) {
 346         $ret->{data} = $selection_pops_list;
 347     }
 348
 349     $ret = to_json($ret);
 350
 351     $c->res->content_type('application/json');
 352     $c->res->body($ret);
 353
 354 }
 355
 356 sub check_selection_population_relevance :
 357   Path('/solgs/check/selection/population/relevance') Args() {
 358     my ( $self, $c ) = @_;
 359
 360     $c->controller('solGS::Utils')
 361       ->stash_json_args( $c, $c->req->param('arguments') );
 362     my $selection_pop_name = $c->stash->{'selection_pop_name'};
 363     my $training_pop_id    = $c->stash->{'training_pop_id'};
 364     my $protocol_id        = $c->stash->{'genotyping_protocol_id'};
 365
 366     my $referer = $c->req->referer;
 367
 368     my $selection_pop_id;
 369     my $pr_rs =
 370       $self->model($c)->project_details_by_exact_name($selection_pop_name);
 371     while ( my $row = $pr_rs->next ) {
 372         $selection_pop_id = $row->project_id;
 373     }
 374
 375     my $ret        = {};
 376     my $similarity = 0;
 377     if ( $selection_pop_id !~ /$training_pop_id/ ) {
 378         my $has_genotype;
 379         if ($selection_pop_id) {
 380             $has_genotype =
 381               $self->check_population_has_genotype( $c, $selection_pop_id,
 382                 $protocol_id );
 383         }
 384
 385         if ($has_genotype) {
 386
 387 # $c->controller('solGS::Files')->genotype_file_name($c, $selection_pop_id, $protocol_id);
 388 # my $selection_geno_file = $c->stash->{genotype_file_name};
 389 #
 390 # if (!-s $selection_geno_file)
 391 # {
 392 #       # $c->controller('solGS::solGS')->first_stock_genotype_data($c, $selection_pop_id, $protocol_id);
 393 #
 394 #       $c->controller('solGS::Files')->first_stock_genotype_file($c, $selection_pop_id, $protocol_id);
 395 #       $selection_geno_file = $c->stash->{first_stock_genotype_file};
 396 # }
 397
 398 # $c->controller('solGS::Files')->first_stock_genotype_file($c, $selection_pop_id, $protocol_id);
 399 # my $selection_geno_file = $c->stash->{first_stock_genotype_file};
 400
 401 # $c->controller('solGS::Files')->genotype_file_name($c, $training_pop_id, $protocol_id);
 402 # my $training_geno_file = $c->stash->{genotype_file_name};
 403
 404             $similarity = 1
 405               ; #$self->compare_marker_set_similarity([$selection_geno_file, $training_geno_file]);
 406         }
 407
 408         my $selection_pop_data;
 409         unless ( $similarity < 0.5 ) {
 410             $c->stash->{training_pop_id} = $training_pop_id;
 411             $self->format_selection_pops( $c, [$selection_pop_id] );
 412             $selection_pop_data = $c->stash->{selection_pops_list};
 413             $self->save_selection_pops( $c, [$selection_pop_id] );
 414         }
 415
 416         $ret->{selection_pop_data} = $selection_pop_data;
 417         $ret->{similarity}         = $similarity;
 418         $ret->{has_genotype}       = $has_genotype;
 419         $ret->{selection_pop_id}   = $selection_pop_id;
 420     }
 421     else {
 422         $ret->{selection_pop_id} = $selection_pop_id;
 423     }
 424
 425     $ret = to_json($ret);
 426
 427     $c->res->content_type('application/json');
 428     $c->res->body($ret);
 429
 430 }
 431
 432 sub check_selection_pops_list : Path('/solgs/check/selection/populations')
 433   Args(0) {
 434     my ( $self, $c ) = @_;
 435
 436     my $args = $c->req->param('arguments');
 437     $c->controller('solGS::Utils')->stash_json_args( $c, $args );
 438
 439     my $training_pop_id = $c->stash->{training_pop_id};
 440     $c->controller('solGS::Files')
 441       ->list_of_prediction_pops_file( $c, $training_pop_id );
 442     my $pred_pops_file = $c->stash->{list_of_prediction_pops_file};
 443
 444     my $ret->{result} = 0;
 445
 446     if ( -s $pred_pops_file ) {
 447         $self->list_of_prediction_pops( $c, $training_pop_id );
 448         my $selection_pops_ids       = $c->stash->{selection_pops_ids};
 449         my $formatted_selection_pops = $c->stash->{list_of_prediction_pops};
 450
 451         $c->controller('solGS::Gebvs')
 452           ->selection_pop_analyzed_traits( $c, $training_pop_id,
 453             $selection_pops_ids->[0] );
 454         my $selection_pop_traits =
 455           $c->stash->{selection_pop_analyzed_traits_ids};
 456
 457         $ret->{selection_traits} = $selection_pop_traits;
 458         $ret->{data}             = $formatted_selection_pops;
 459     }
 460
 461     $ret = to_json($ret);
 462
 463     $c->res->content_type('application/json');
 464     $c->res->body($ret);
 465
 466 }
 467
 468 sub projects_links {
 469     my ( $self, $c, $pr_rs ) = @_;
 470
 471     my $protocol_id = $c->stash->{genotyping_protocol_id};
 472
 473     $self->get_projects_details( $c, $pr_rs );
 474     my $projects = $c->stash->{projects_details};
 475
 476     my @projects_pages;
 477     my $update_marker_count;
 478
 479     foreach my $pr_id ( keys %$projects ) {
 480         my $pr_name     = $projects->{$pr_id}{project_name};
 481         my $pr_desc     = $projects->{$pr_id}{project_desc};
 482         my $pr_year     = $projects->{$pr_id}{project_year};
 483         my $pr_location = $projects->{$pr_id}{project_location};
 484
 485         my $dummy_name = $pr_name =~ /test\w*/ig;
 486
 487         #my $dummy_desc = $pr_desc =~ /test\w*/ig;
 488
 489         my $has_genotype = $self->check_population_has_genotype($c);
 490
 491         no warnings 'uninitialized';
 492
 493         unless ( $dummy_name || !$pr_name ) {
 494
 495             #$self->trial_compatibility_table($c, $has_genotype);
 496             #my $match_code = $c->stash->{trial_compatibility_code};
 497
 498             my $checkbox =
 499 qq |<form> <input type="checkbox" name="project" value="$pr_id" onclick="solGS.combinedTrials.getPopIds()"/> </form> |;
 500
 501 #$match_code = qq | <div class=trial_code style="color: $match_code; background-color: $match_code; height: 100%; width:30px">code</div> |;
 502
 503             my $args = {
 504                 'training_pop_id'        => $pr_id,
 505                 'genotyping_protocol_id' => $protocol_id,
 506                 'data_set_type'          => 'single_population'
 507             };
 508
 509             my $training_pop_page =
 510               $c->controller('solGS::Path')->training_page_url($args);
 511             my $trial_url =
 512               $c->controller('solGS::Path')->trial_page_url($pr_id);
 513             my $trial_link = $c->controller('solGS::Path')
 514               ->create_hyperlink( $trial_url, 'View' );
 515
 516             push @projects_pages,
 517               [
 518                 $checkbox,
 519 qq|<a href="$training_pop_page" onclick="solGS.waitPage(this.href); return false;">$pr_name</a>|,
 520                 $pr_desc,
 521                 $pr_location,
 522                 $pr_year,
 523                 $trial_link
 524               ];
 525
 526         }
 527
 528     }
 529
 530     $c->stash->{projects_pages} = \@projects_pages;
 531 }
 532
 533 sub project_description {
 534     my ( $self, $c, $pr_id ) = @_;
 535
 536     $c->stash->{pop_id}          = $pr_id;
 537     $c->stash->{training_pop_id} = $pr_id;
 538     my $protocol_id = $c->stash->{genotyping_protocol_id};
 539
 540     if ( $c->stash->{list_id} ) {
 541         $c->controller('solGS::List')->list_population_summary($c);
 542     }
 543     elsif ( $c->stash->{dataset_id} ) {
 544         $c->controller('solGS::Dataset')->dataset_population_summary($c);
 545     }
 546     else {
 547
 548         my $pr_rs = $self->model($c)->project_details($pr_id);
 549
 550         while ( my $row = $pr_rs->next ) {
 551             $c->stash(
 552                 project_id   => $row->id,
 553                 project_name => $row->name,
 554                 project_desc => $row->description
 555             );
 556         }
 557
 558         $self->get_project_owners( $c, $pr_id );
 559         $c->stash->{owner} = $c->stash->{project_owners};
 560     }
 561
 562     my $markers_no =
 563       $c->controller('solGS::solGS')
 564       ->get_markers_count( $c,
 565         { 'training_pop' => 1, 'training_pop_id' => $pr_id } );
 566     my $stocks_no = $c->controller('solGS::solGS')
 567       ->training_pop_lines_count( $c, $pr_id, $protocol_id );
 568
 569     $c->controller('solGS::Files')->traits_acronym_file( $c, $pr_id );
 570     my $traits_file  = $c->stash->{traits_acronym_file};
 571     my @traits_lines = read_file( $traits_file, { binmode => ':utf8' } );
 572     my $traits_no    = scalar(@traits_lines) - 1;
 573
 574     my $protocol_url = $c->controller('solGS::genotypingProtocol')
 575       ->create_protocol_url( $c, $protocol_id );
 576
 577     $c->stash(
 578         markers_no   => $markers_no,
 579         traits_no    => $traits_no,
 580         stocks_no    => $stocks_no,
 581         protocol_url => $protocol_url,
 582     );
 583
 584 }
 585
 586 sub format_trait_gs_projects {
 587     my ( $self, $c, $trait_id, $projects, $protocol_id ) = @_;
 588
 589     my @formatted_projects;
 590     $c->stash->{genotyping_protocol_id} = $protocol_id;
 591
 592     foreach my $pr_id ( keys %$projects ) {
 593         my $pr_name     = $projects->{$pr_id}{project_name};
 594         my $pr_desc     = $projects->{$pr_id}{project_desc};
 595         my $pr_year     = $projects->{$pr_id}{project_year};
 596         my $pr_location = $projects->{$pr_id}{project_location};
 597
 598         if ( $pr_location !~ /computation/i ) {
 599             $c->stash->{pop_id} = $pr_id;
 600             my $has_genotype = $self->check_population_has_genotype($c);
 601
 602             if ($has_genotype) {
 603
 604             #my $trial_compatibility_file = $self->trial_compatibility_file($c);
 605
 606                 #$self->trial_compatibility_table($c, $has_genotype);
 607                 #my $match_code = $c->stash->{trial_compatibility_code};
 608
 609                 my $checkbox =
 610 qq |<form> <input  type="checkbox" name="project" value="$pr_id" onclick="solGS.combinedTrials.getPopIds()"/> </form> |;
 611
 612 #$match_code = qq | <div class=trial_code style="color: $match_code; background-color: $match_code; height: 100%; width:100%">code</div> |;
 613
 614                 my $args = {
 615                     'trait_id'               => $trait_id,
 616                     'training_pop_id'        => $pr_id,
 617                     'genotyping_protocol_id' => $protocol_id,
 618                     'data_set_type'          => 'single_population'
 619                 };
 620
 621                 my $model_page =
 622                   $c->controller('solGS::Path')->model_page_url($args);
 623                 my $trial_url =
 624                   $c->controller('solGS::Path')->trial_page_url($pr_id);
 625                 my $trial_link = $c->controller('solGS::Path')
 626                   ->create_hyperlink( $trial_url, 'View' );
 627
 628                 push @formatted_projects,
 629                   [
 630                     $checkbox,
 631 qq|<a href="$model_page" onclick="solGS.waitPage(this.href); return false;">$pr_name</a>|,
 632                     $pr_desc,
 633                     $pr_location,
 634                     $pr_year,
 635                     $trial_link
 636                   ];
 637             }
 638         }
 639     }
 640
 641     $c->stash->{formatted_gs_projects} = \@formatted_projects;
 642
 643 }
 644
 645 sub format_gs_projects {
 646     my ( $self, $c, $projects ) = @_;
 647
 648     my @formatted_projects;
 649
 650     my $protocol_id = $c->stash->{genotyping_protocol_id};
 651
 652     foreach my $pr_id ( keys %$projects ) {
 653         my $pr_name     = $projects->{$pr_id}{project_name};
 654         my $pr_desc     = $projects->{$pr_id}{project_desc};
 655         my $pr_year     = $projects->{$pr_id}{project_year};
 656         my $pr_location = $projects->{$pr_id}{project_location};
 657
 658         # $c->stash->{pop_id} = $pr_id;
 659         # $self->check_population_has_genotype($c);
 660         # my $has_genotype = $c->stash->{population_has_genotype};
 661         if ( $pr_location !~ /computation/i ) {
 662             my $has_genotype = $c->config->{default_genotyping_protocol};
 663
 664             if ($has_genotype) {
 665                 my $trial_compatibility_file =
 666                   $self->trial_compatibility_file($c);
 667
 668                 $self->trial_compatibility_table( $c, $has_genotype );
 669                 my $match_code = $c->stash->{trial_compatibility_code};
 670
 671                 my $checkbox =
 672 qq |<form> <input  type="checkbox" name="project" value="$pr_id" onclick="solGS.combinedTrials.getPopIds()"/> </form> |;
 673                 $match_code =
 674 qq | <div class=trial_code style="color: $match_code; background-color: $match_code; height: 100%; width:100%">code</div> |;
 675
 676                 my $args = {
 677                     'training_pop_id'        => $pr_id,
 678                     'genotyping_protocol_id' => $protocol_id,
 679                     'data_set_type'          => 'single_population'
 680                 };
 681
 682                 my $training_pop_page =
 683                   $c->controller('solGS::Path')->training_page_url($args);
 684                 my $trial_url =
 685                   $c->controller('solGS::Path')->trial_page_url($pr_id);
 686                 my $trial_link = $c->controller('solGS::Path')
 687                   ->create_hyperlink( $trial_url, 'View' );
 688
 689                 push @formatted_projects,
 690                   [
 691                     $checkbox,
 692 qq|<a href="$training_pop_page" onclick="solGS.waitPage(this.href); return false;">$pr_name</a>|,
 693                     $pr_desc,
 694                     $pr_location,
 695                     $pr_year,
 696                     $trial_link
 697                   ];
 698             }
 699         }
 700     }
 701
 702     $c->stash->{formatted_gs_projects} = \@formatted_projects;
 703
 704 }
 705
 706 sub trial_compatibility_table {
 707     my ( $self, $c, $markers ) = @_;
 708
 709     $self->trial_compatibility_file($c);
 710     my $compatibility_file = $c->stash->{trial_compatibility_file};
 711
 712     my $color;
 713
 714     if ( -s $compatibility_file ) {
 715         my @line = read_file( $compatibility_file, { binmode => ':utf8' } );
 716         my ($entry) = grep( /$markers/, @line );
 717         chomp($entry);
 718
 719         if ($entry) {
 720             ( $markers, $color ) = split( /\t/, $entry );
 721             $c->stash->{trial_compatibility_code} = $color;
 722         }
 723     }
 724
 725     if ( !$color ) {
 726         my ( $red, $blue, $green ) = map { int( rand(255) ) } 1 .. 3;
 727         $color = 'rgb' . '(' . "$red,$blue,$green" . ')';
 728
 729         my $color_code = $markers . "\t" . $color . "\n";
 730
 731         $c->stash->{trial_compatibility_code} = $color;
 732         write_file( $compatibility_file, { append => 1, binmode => ':utf8' },
 733             $color_code );
 734     }
 735 }
 736
 737 sub trial_compatibility_file {
 738     my ( $self, $c ) = @_;
 739
 740     my $cache_data = {
 741         key       => 'trial_compatibility',
 742         file      => 'trial_compatibility_codes',
 743         stash_key => 'trial_compatibility_file'
 744     };
 745
 746     $c->controller('solGS::Files')->cache_file( $c, $cache_data );
 747
 748 }
 749
 750 sub get_projects_details {
 751     my ( $self, $c, $pr_rs ) = @_;
 752
 753     my ( $year, $location, $pr_id, $pr_name, $pr_desc );
 754     my %projects_details = ();
 755
 756     while ( my $pr = $pr_rs->next ) {
 757         $pr_id   = $pr->get_column('project_id');
 758         $pr_name = $pr->get_column('name');
 759         $pr_desc = $pr->get_column('description');
 760
 761         my $pr_yr_rs = $self->model($c)->project_year($pr_id);
 762
 763         while ( my $pr = $pr_yr_rs->next ) {
 764             $year = $pr->value;
 765         }
 766
 767         my $location = $self->model($c)->project_location($pr_id);
 768
 769         $projects_details{$pr_id} = {
 770             project_name     => $pr_name,
 771             project_desc     => $pr_desc,
 772             project_year     => $year,
 773             project_location => $location,
 774         };
 775     }
 776
 777     $c->stash->{projects_details} = \%projects_details;
 778
 779 }
 780
 781 sub list_of_prediction_pops {
 782     my ( $self, $c, $training_pop_id ) = @_;
 783
 784     $c->controller('solGS::Files')
 785       ->list_of_prediction_pops_file( $c, $training_pop_id );
 786     my $pred_pops_file = $c->stash->{list_of_prediction_pops_file};
 787
 788     my @pred_pops_ids = read_file( $pred_pops_file, { binmode => ':utf8' } );
 789     grep( s/\s//g, @pred_pops_ids );
 790
 791     $c->stash->{selection_pops_ids} = \@pred_pops_ids;
 792
 793     $self->format_selection_pops( $c, \@pred_pops_ids );
 794     $c->stash->{list_of_prediction_pops} = $c->stash->{selection_pops_list};
 795
 796 }
 797
 798 sub check_population_is_training_population {
 799     my ( $self, $c, $pop_id, $protocol_id ) = @_;
 800
 801     $pop_id             = $c->stash->{pop_id} if !$pop_id;
 802     $c->stash->{pop_id} = $pop_id;
 803     $protocol_id        = $c->stash->{genotyping_protocol_id} if !$protocol_id;
 804
 805     my $is_training;
 806     my $has_phenotype  = $self->check_population_has_phenotype($c);
 807     my $is_computation = $self->check_saved_analysis_trial( $c, $pop_id );
 808
 809     if ( $has_phenotype && !$is_computation ) {
 810         my $has_genotype =
 811           $self->check_population_has_genotype( $c, $pop_id, $protocol_id );
 812         $is_training = 1 if $has_genotype;
 813     }
 814
 815     return $is_training;
 816
 817 }
 818
 819 sub check_saved_analysis_trial {
 820     my ( $self, $c, $pop_id ) = @_;
 821
 822     my $location = $self->model($c)->project_location($pop_id);
 823     if ( $location && $location =~ /computation/i ) {
 824         return 1;
 825     }
 826     else {
 827         return;
 828     }
 829
 830 }
 831
 832 sub check_population_has_phenotype {
 833     my ( $self, $c, $pop_id ) = @_;
 834
 835     my $pop_id = $c->stash->{pop_id} if !$pop_id;
 836
 837     $c->controller('solGS::Files')->phenotype_file_name( $c, $pop_id );
 838     my $pheno_file = $c->stash->{phenotype_file_name};
 839
 840     my $has_phenotype;
 841     if ( -s $pheno_file ) {
 842         $has_phenotype = 1;
 843     }
 844     else {
 845         $has_phenotype = $self->model($c)->has_phenotype($pop_id);
 846     }
 847
 848     return $has_phenotype;
 849
 850 }
 851
 852 sub check_population_has_genotype {
 853     my ( $self, $c, $pop_id, $protocol_id ) = @_;
 854
 855     $pop_id      = $c->stash->{pop_id}                 if !$pop_id;
 856     $protocol_id = $c->stash->{genotyping_protocol_id} if !$protocol_id;
 857
 858     $c->controller('solGS::Files')
 859       ->genotype_file_name( $c, $pop_id, $protocol_id );
 860     my $geno_file = $c->stash->{genotype_file_name};
 861
 862     $c->controller('solGS::Files')
 863       ->first_stock_genotype_file( $c, $pop_id, $protocol_id );
 864     my $first_stock_file = $c->stash->{first_stock_genotype_file};
 865     my $has_genotype;
 866     $has_genotype = 1 if -s $geno_file || -s $first_stock_file;
 867
 868     if ( !$has_genotype ) {
 869         $has_genotype = $self->model($c)->has_genotype( $pop_id, $protocol_id );
 870     }
 871
 872     return $has_genotype;
 873
 874 }
 875
 876 sub save_selection_pops {
 877     my ( $self, $c, $selection_pop_id ) = @_;
 878
 879     my $training_pop_id = $c->stash->{training_pop_id};
 880
 881     $c->controller('solGS::Files')
 882       ->list_of_prediction_pops_file( $c, $training_pop_id );
 883     my $selection_pops_file = $c->stash->{list_of_prediction_pops_file};
 884
 885     my @existing_pops_ids =
 886       read_file( $selection_pops_file, { binmode => ':utf8' } );
 887
 888     my @uniq_ids      = unique( @existing_pops_ids, @$selection_pop_id );
 889     my $formatted_ids = join( "\n", @uniq_ids );
 890
 891     write_file( $selection_pops_file, { binmode => ':utf8' }, $formatted_ids );
 892
 893 }
 894
 895 sub search_all_relevant_selection_pops {
 896     my ( $self, $c, $training_pop_id ) = @_;
 897
 898     my @pred_pops_ids =
 899       @{ $self->model($c)->prediction_pops($training_pop_id) };
 900
 901     $self->save_selection_pops( $c, \@pred_pops_ids );
 902
 903     $self->format_selection_pops( $c, \@pred_pops_ids );
 904
 905     $c->stash->{all_relevant_selection_pops} = $c->stash->{selection_pops_list};
 906
 907 }
 908
 909 sub get_project_owners {
 910     my ( $self, $c, $pr_id ) = @_;
 911
 912     my $owners = $self->model($c)->get_stock_owners($pr_id);
 913     my $owners_names;
 914
 915     if (@$owners) {
 916         for ( my $i = 0 ; $i < scalar(@$owners) ; $i++ ) {
 917             my $owner_name =
 918                 $owners->[$i]->{'first_name'} . "\t"
 919               . $owners->[$i]->{'last_name'}
 920               if $owners->[$i];
 921
 922             unless ( !$owner_name ) {
 923                 $owners_names .=
 924                   $owners_names ? ', ' . $owner_name : $owner_name;
 925             }
 926         }
 927     }
 928
 929     $c->stash->{project_owners} = $owners_names;
 930 }
 931
 932 sub format_selection_pops {
 933     my ( $self, $c, $selection_pops_ids ) = @_;
 934
 935     my $training_pop_id = $c->stash->{training_pop_id};
 936
 937     my @selection_pops_ids = @{$selection_pops_ids};
 938     my @data;
 939
 940     if (@selection_pops_ids) {
 941
 942         foreach my $selection_pop_id (@selection_pops_ids) {
 943             my $selection_pop_rs =
 944               $self->model($c)->project_details($selection_pop_id);
 945             my $selection_pop_link;
 946
 947             while ( my $row = $selection_pop_rs->next ) {
 948                 my $name = $row->name;
 949                 my $desc = $row->description;
 950
 951                 # unless ($name =~ /test/ || $desc =~ /test/)
 952                 # {
 953                 my $id_pop_name->{id} = $selection_pop_id;
 954                 $id_pop_name->{name}     = $name;
 955                 $id_pop_name->{pop_type} = 'selection';
 956                 $id_pop_name             = to_json($id_pop_name);
 957
 958 # $pred_pop_link = qq | <a href="/solgs/model/$training_pop_id/prediction/$selection_pop_id"
 959 #                    onclick="solGS.waitPage(this.href); return false;"><input type="hidden" value=\'$id_pop_name\'>$name</data>
 960 #                    </a>
 961 #                     |;
 962
 963                 $selection_pop_link =
 964 qq | <data><input type="hidden" value=\'$id_pop_name\'>$name</data>|;
 965
 966                 my $pr_yr_rs =
 967                   $self->model($c)->project_year($selection_pop_id);
 968                 my $project_yr;
 969
 970                 while ( my $yr_r = $pr_yr_rs->next ) {
 971                     $project_yr = $yr_r->value;
 972                 }
 973
 974                 my $trial_url = $c->controller('solGS::Path')
 975                   ->trial_page_url($selection_pop_id);
 976                 my $trial_link = $c->controller('solGS::Path')
 977                   ->create_hyperlink( $trial_url, 'View' );
 978
 979                 $c->controller('solGS::Download')
 980                   ->selection_prediction_download_urls( $c, $training_pop_id,
 981                     $selection_pop_id );
 982                 my $download_selection =
 983                   $c->stash->{selection_prediction_download};
 984
 985                 push @data,
 986                   [
 987                     $selection_pop_link, $desc, $project_yr,
 988                     $trial_link,         $download_selection
 989                   ];
 990             }
 991         }
 992     }
 993
 994     $c->stash->{selection_pops_list} = \@data;
 995
 996 }
 997
 998 sub get_project_details {
 999     my ( $self, $c, $pr_id ) = @_;
1000
1001     my $pr_rs = $self->model($c)->project_details($pr_id);
1002
1003     while ( my $row = $pr_rs->next ) {
1004         $c->stash(
1005             project_id   => $row->id,
1006             project_name => $row->name,
1007             project_desc => $row->description
1008         );
1009     }
1010
1011 }
1012
1013 sub compare_marker_set_similarity {
1014     my ( $self, $marker_file_pair ) = @_;
1015
1016     my $file_1 = $marker_file_pair->[0];
1017     my $file_2 = $marker_file_pair->[1];
1018
1019     my $first_markers =
1020       ( read_file( $marker_file_pair->[0], { binmode => ':utf8' } ) )[0];
1021     my $sec_markers =
1022       ( read_file( $marker_file_pair->[1], { binmode => ':utf8' } ) )[0];
1023
1024     my @first_geno_markers = split( /\t/, $first_markers );
1025     my @sec_geno_markers   = split( /\t/, $sec_markers );
1026
1027     if ( @first_geno_markers && @sec_geno_markers ) {
1028         my $common_markers =
1029           scalar( intersect( @first_geno_markers, @sec_geno_markers ) );
1030         my $similarity = $common_markers / scalar(@first_geno_markers);
1031
1032         return $similarity;
1033     }
1034     else {
1035         return 0;
1036     }
1037
1038 }
1039
1040 sub compare_genotyping_platforms {
1041     my ( $self, $c, $g_files ) = @_;
1042
1043     my $combinations = combinations( $g_files, 2 );
1044     my $combo_cnt    = combinations( $g_files, 2 );
1045
1046     my $not_matching_pops;
1047     my $cnt       = 0;
1048     my $cnt_pairs = 0;
1049
1050     while ( $combo_cnt->next ) {
1051         $cnt_pairs++;
1052     }
1053
1054     while ( my $pair = $combinations->next ) {
1055         $cnt++;
1056         my $similarity = $self->compare_marker_set_similarity($pair);
1057
1058         unless ( $similarity > 0.5 ) {
1059             no warnings 'uninitialized';
1060             my $pop_id_1 = fileparse( $pair->[0] );
1061             my $pop_id_2 = fileparse( $pair->[1] );
1062
1063             map { s/genotype_data_|\.txt//g } $pop_id_1, $pop_id_2;
1064
1065             my $list_type_pop = $c->stash->{list_prediction};
1066
1067             unless ($list_type_pop) {
1068                 my @pop_names;
1069                 foreach ( $pop_id_1, $pop_id_2 ) {
1070                     my $pr_rs = $self->model($c)->project_details($_);
1071
1072                     while ( my $row = $pr_rs->next ) {
1073                         push @pop_names, $row->name;
1074                     }
1075                 }
1076
1077                 $not_matching_pops .=
1078                   '[ ' . $pop_names[0] . ' and ' . $pop_names[1] . ' ]';
1079                 $not_matching_pops .= ', ' if $cnt != $cnt_pairs;
1080             }
1081
1082             # else
1083             # {
1084             #     $not_matching_pops = 'not_matching';
1085             # }
1086         }
1087     }
1088
1089     $c->stash->{pops_with_no_genotype_match} = $not_matching_pops;
1090
1091 }
1092
1093 sub store_project_marker_count {
1094     my ( $self, $c ) = @_;
1095
1096     my $pop_id       = $c->stash->{pop_id};
1097     my $marker_count = $c->stash->{marker_count};
1098
1099     unless ($marker_count) {
1100         my $markers = $self->model($c)->get_project_genotyping_markers($pop_id);
1101         my @markers = split( '\t', $markers );
1102         $marker_count = scalar(@markers);
1103     }
1104
1105     my $genoprop = { 'project_id' => $pop_id, 'marker_count' => $marker_count };
1106     $self->model($c)->set_project_genotypeprop($genoprop);
1107
1108 }
1109
1110 sub gs_traits_index {
1111     my ( $self, $c ) = @_;
1112
1113     $self->all_gs_traits_list($c);
1114     my $all_traits = $c->stash->{all_gs_traits};
1115     my @all_traits = sort { $a cmp $b } @$all_traits;
1116
1117     my @indices = ( 'A' .. 'Z' );
1118     my %traits_hash;
1119     my @valid_indices;
1120
1121     foreach my $index (@indices) {
1122         my @index_traits;
1123         foreach my $trait (@all_traits) {
1124             if ( $trait =~ /^$index/i ) {
1125                 push @index_traits, $trait;
1126             }
1127         }
1128         if (@index_traits) {
1129             $traits_hash{$index} = [@index_traits];
1130         }
1131     }
1132
1133     foreach my $k ( keys(%traits_hash) ) {
1134         push @valid_indices, $k;
1135     }
1136
1137     @valid_indices = sort(@valid_indices);
1138
1139     my $trait_index;
1140     foreach my $v_i (@valid_indices) {
1141         my $url = "/solgs/traits/$v_i";
1142         $trait_index .=
1143           $c->controller('solGS::Path')->create_hyperlink( $url, $v_i );
1144         unless ( $v_i eq $valid_indices[-1] ) {
1145             $trait_index .= " | ";
1146         }
1147     }
1148
1149     $c->stash->{gs_traits_index} = $trait_index;
1150
1151 }
1152
1153 sub hyperlink_traits {
1154     my ( $self, $c, $traits ) = @_;
1155
1156     if ( ref($traits) eq 'ARRAY' ) {
1157         my @traits_urls;
1158         foreach my $tr (@$traits) {
1159             my $url = "/solgs/search/result/traits/$tr";
1160             my $trait_url =
1161               $c->controller('solGS::Path')->create_hyperlink( $url, $tr );
1162             push @traits_urls, [$trait_url];
1163         }
1164
1165         $c->stash->{traits_urls} = \@traits_urls;
1166     }
1167     else {
1168         my $url = "/solgs/search/result/traits/$traits";
1169         $c->stash->{traits_urls} =
1170           $c->controller('solGS::Path')->create_hyperlink( $url, $traits );
1171     }
1172 }
1173
1174 sub traits_starting_with {
1175     my ( $self, $c, $index ) = @_;
1176
1177     $self->all_gs_traits_list($c);
1178     my $all_traits = $c->stash->{all_gs_traits};
1179
1180     my $trait_gr = [
1181         sort { $a cmp $b }
1182         grep { /^$index/i } uniq @$all_traits
1183     ];
1184
1185     $c->stash->{trait_subgroup} = $trait_gr;
1186 }
1187
1188 sub all_gs_traits_list {
1189     my ( $self, $c ) = @_;
1190
1191     # $self->trial_compatibility_file($c);
1192     # my $file = $c->stash->{trial_compatibility_file};
1193
1194     # my $traits;
1195     # my $mv_name = 'all_gs_traits';
1196     #
1197     # my $matview = $self->model($c)->check_matview_exists($mv_name);
1198     #
1199     # if (!$matview)
1200     # {
1201     # $self->model($c)->materialized_view_all_gs_traits();
1202     # $self->model($c)->insert_matview_public($mv_name);
1203     # }
1204     # else
1205     # {
1206     # if (!-s $file)
1207     # {
1208     # $self->model($c)->refresh_materialized_view_all_gs_traits();
1209     # $self->model($c)->update_matview_public($mv_name);
1210     # }
1211     # }
1212
1213     # try
1214     # {
1215     my $traits = $self->model($c)->all_gs_traits();
1216
1217     # }
1218     # catch
1219     # {
1220     #
1221     # if ($_ =~ /materialized view \"all_gs_traits\" has not been populated/)
1222     #     {
1223     #         try
1224     #         {
1225     #             $self->model($c)->refresh_materialized_view_all_gs_traits();
1226     #             $self->model($c)->update_matview_public($mv_name);
1227     #             $traits = $self->model($c)->all_gs_traits();
1228     #         };
1229     #     }
1230     # };
1231
1232     $c->stash->{all_gs_traits} = $traits;
1233     return $traits;
1234
1235 }
1236
1237 sub model {
1238     my ( $self, $c ) = @_;
1239     my $sp_person_id = $c->user() ? $c->user->get_object()->get_sp_person_id() : undef;
1240     my $bcs_schema    = $c->dbic_schema("Bio::Chado::Schema", undef, $sp_person_id);
1241     my $people_schema = $c->dbic_schema("CXGN::People::Schema", undef, $sp_person_id);
1242
1243     my $model = SGN::Model::solGS::solGS->new(
1244         {
1245             schema        => $bcs_schema,
1246             people_schema => $people_schema
1247         }
1248     );
1249
1250     return $model;
1251
1252 }
1253
1254 sub begin : Private {
1255     my ( $self, $c ) = @_;
1256
1257     $c->controller('solGS::Files')->get_solgs_dirs($c);
1258
1259 }
1260
1261 __PACKAGE__->meta->make_immutable;
1262
1263 #######
1264 1;
1265 ######