lib/CXGN/Trial.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Trial - factory object for project entries (phenotyping trials, genotyping trials, crossing trials, and analyses
   5
   6 =head1 DESCRIPTION
   7
   8 my $trial = CXGN::Trial->new( { bcs_schema => $schema, ... , trial_id => $trial_id });
   9
  10 If $trial_id is a phenotyping trial, the type of object returned will be CXGN::PhenotypingTrial.
  11
  12 =head1 AUTHOR
  13
  14 Lukas Mueller <lam87@cornell.edu>
  15
  16 =head1 METHODS
  17
  18 =cut
  19
  20 package CXGN::Trial;
  21
  22 use Moose;
  23 use Data::Dumper;
  24 use Try::Tiny;
  25 use Data::Dumper;
  26 use CXGN::Trial::Folder;
  27 use CXGN::Trial::TrialLayout;
  28 use CXGN::Trial::TrialLayoutDownload;
  29 use SGN::Model::Cvterm;
  30 use Time::Piece;
  31 use Time::Seconds;
  32 use CXGN::Calendar;
  33 use JSON;
  34 use File::Basename qw | basename dirname|;
  35 use CXGN::BrAPI::v2::ExternalReferences;
  36
  37 =head1 NAME
  38
  39
  40 =head1 DESCRIPTION
  41
  42 If $trial_id is a genotyping trial, the type of object returned will be CXGN::GenotypingTrial.
  43
  44 If $trial_id is a crossing trial, the type of object returned will be CXGN::CrossingTrial.
  45
  46 If $trial_id is an analysis, the type of object returned will be CXGN::Analysis.
  47
  48 (you get the idea).
  49
  50 Inheritance structure of Trial objects:
  51
  52 CXGN::Trial - Factory object (for backwards compatibility)
  53
  54 CXGN::Project
  55 |
  56 ---CXGN::PhenotypingTrial
  57 |  |
  58 |  ---CXGN::GenotypingTrial
  59 |  |
  60 |  ---CXGN::CrossingTrial
  61 |
  62 ---CXGN::Analysis
  63
  64 =head1 AUTHOR
  65
  66 Lukas Mueller <lam87@cornell.edu>
  67
  68 Based on work by the entire group :-)
  69
  70 =cut
  71
  72 package CXGN::Trial;
  73
  74 use CXGN::PhenotypingTrial;
  75 use CXGN::GenotypingTrial;
  76 use CXGN::CrossingTrial;
  77 use CXGN::Analysis;
  78 use CXGN::SamplingTrial;
  79 use CXGN::ManagementFactor;
  80 use CXGN::GenotypeDataProject;
  81 use CXGN::AerialImagingEventBandProject;
  82 use CXGN::AerialImagingEventProject;
  83 use Data::Dumper;
  84
  85 sub new {
  86     my $class = shift;
  87     my $args = shift;
  88     my $schema = $args->{bcs_schema};
  89     my $trial_id = $args->{trial_id};
  90
  91     my $trial_rs = $schema->resultset("Project::Projectprop")->search( { project_id => $trial_id },{ join => 'type' });
  92
  93     if ($trial_id && $trial_rs->count() == 0) {
  94         return CXGN::PhenotypingTrial->new($args);
  95     }
  96
  97     my $object;
  98     while (my $trial_row = $trial_rs->next()) {
  99         my $name = $trial_row->type()->name();
 100         my $val = $trial_row->value();
 101         # print STDERR Dumper [$name, $val];
 102         if ($val eq "genotyping_plate") {
 103             return CXGN::GenotypingTrial->new($args);
 104         }
 105         elsif ($name eq "crossing_trial") {
 106             return CXGN::CrossingTrial->new($args);
 107         }
 108         elsif ($name eq "analysis") {
 109             return CXGN::Analysis->new($args);
 110         }
 111         elsif ($val eq "treatment") {
 112             return CXGN::ManagementFactor->new($args);
 113         }
 114         elsif ($val eq "sampling_trial") {
 115             return CXGN::SamplingTrial->new($args);
 116         }
 117         elsif (($val eq "genotype_data_project") || ($val eq "pcr_genotype_data_project")) {
 118             return CXGN::GenotypeDataProject->new($args);
 119         }
 120         elsif ($val eq "drone_run") {
 121             return CXGN::AerialImagingEventProject->new($args);
 122         }
 123         elsif ($val eq "drone_run_band") {
 124             return CXGN::AerialImagingEventBandProject->new($args);
 125         }
 126         else {
 127             $object = CXGN::PhenotypingTrial->new($args);
 128         }
 129     }
 130     return $object;
 131 }
 132
 133 =head2 class method get_all_locations()
 134
 135  Usage:        my $locations = CXGN::Trial::get_all_locations($schema)
 136  Desc:
 137  Ret:
 138  Args:
 139  Side Effects:
 140  Example:
 141
 142 =cut
 143
 144 sub get_all_locations {
 145     my $schema = shift;
 146         my $location_id = shift;
 147     my @locations;
 148
 149         my %search_params;
 150         if ($location_id){
 151                 $search_params{'nd_geolocation_id'} = $location_id;
 152         }
 153
 154     my $loc = $schema->resultset('NaturalDiversity::NdGeolocation')->search( \%search_params, {order_by => { -asc => 'nd_geolocation_id' }} );
 155     while (my $s = $loc->next()) {
 156         my $loc_props = $schema->resultset('NaturalDiversity::NdGeolocationprop')->search( { nd_geolocation_id => $s->nd_geolocation_id() }, {join=>'type', '+select'=>['me.value', 'type.name'], '+as'=>['value', 'cvterm_name'] } );
 157
 158                 my %attr;
 159         $attr{'geodetic datum'} = $s->geodetic_datum();
 160
 161         my $country = '';
 162         my $country_code = '';
 163         my $location_type = '';
 164         my $abbreviation = '';
 165         my $address = '';
 166
 167         while (my $sp = $loc_props->next()) {
 168             if ($sp->get_column('cvterm_name') eq 'country_name') {
 169                 $country = $sp->get_column('value');
 170             } elsif ($sp->get_column('cvterm_name') eq 'country_code') {
 171                 $country_code = $sp->get_column('value');
 172             } elsif ($sp->get_column('cvterm_name') eq 'location_type') {
 173                 $location_type = $sp->get_column('value');
 174             } elsif ($sp->get_column('cvterm_name') eq 'abbreviation') {
 175                 $abbreviation = $sp->get_column('value');
 176             } elsif ($sp->get_column('cvterm_name') eq 'geolocation address') {
 177                 $address = $sp->get_column('value');
 178             } else {
 179                 $attr{$sp->get_column('cvterm_name')} = $sp->get_column('value') ;
 180             }
 181         }
 182
 183         my @reference_locations = ($s->nd_geolocation_id());
 184         my $references = CXGN::BrAPI::v2::ExternalReferences->new({
 185             bcs_schema => $schema,
 186             table_name => 'nd_geolocation',
 187             table_id_key => 'nd_geolocation_id',
 188             id => \@reference_locations
 189         });
 190         my $external_references_search = $references->search();
 191         my $external_references = $external_references_search->{$s->nd_geolocation_id()} || [];
 192
 193
 194         push @locations, [$s->nd_geolocation_id(), $s->description(), $s->latitude(), $s->longitude(), $s->altitude(), $country, $country_code, \%attr, $location_type, $abbreviation, $address, $external_references],
 195     }
 196
 197     return \@locations;
 198 }
 199
 200 # CLASS METHOD!
 201
 202 =head2 class method get_all_project_types()
 203
 204  Usage:        my @cvterm_ids = CXGN::Trial::get_all_project_types($schema)
 205  Desc:
 206  Ret:
 207  Args:
 208  Side Effects:
 209  Example:
 210
 211 =cut
 212
 213 sub get_all_project_types {
 214     ##my $class = shift;
 215     my $schema = shift;
 216     my $project_type_cv_id = $schema->resultset('Cv::Cv')->find( { name => 'project_type' } )->cv_id();
 217     my $rs = $schema->resultset('Cv::Cvterm')->search( { cv_id=> $project_type_cv_id }, {order_by=>'me.cvterm_id'} );
 218     my @cvterm_ids;
 219     if ($rs->count() > 0) {
 220         @cvterm_ids = map { [ $_->cvterm_id(), $_->name(), $_->definition ] } ($rs->all());
 221     }
 222     return @cvterm_ids;
 223 }
 224
 225
 226 =head2 function get_all_phenotype_metadata($schema, $n)
 227
 228  Note:         Class method!
 229  Usage:        CXGN::Trial->get_phenotype_metadata($schema, 100);
 230  Desc:         retrieves maximally $n metadata.md_file entries for the any trial . These entries are created during StorePhenotypes.
 231  Ret:
 232  Args:
 233  Side Effects:
 234  Example:
 235
 236 =cut
 237
 238 sub get_all_phenotype_metadata {
 239     my $class = shift;
 240     my $schema = shift;
 241     my $n = shift || 200;
 242     my @file_array;
 243     my %file_info;
 244     my $q = "SELECT file_id, m.create_date, p.sp_person_id, p.username, basename, dirname, filetype FROM nd_experiment_project JOIN nd_experiment_phenotype USING(nd_experiment_id) JOIN phenome.nd_experiment_md_files ON (nd_experiment_phenotype.nd_experiment_id=nd_experiment_md_files.nd_experiment_id) LEFT JOIN metadata.md_files using(file_id) LEFT JOIN metadata.md_metadata as m using(metadata_id) LEFT JOIN sgn_people.sp_person as p ON (p.sp_person_id=m.create_person_id) WHERE m.obsolete = 0 and NOT (metadata.md_files.filetype='generated from plot from plant phenotypes') and NOT (metadata.md_files.filetype='direct phenotyping') ORDER BY file_id ASC LIMIT $n";
 245     my $h = $schema->storage()->dbh()->prepare($q);
 246     $h->execute();
 247
 248     while (my ($file_id, $create_date, $person_id, $username, $basename, $dirname, $filetype) = $h->fetchrow_array()) {
 249         $file_info{$file_id} = [$file_id, $create_date, $person_id, $username, $basename, $dirname, $filetype];
 250     }
 251     foreach (keys %file_info){
 252         push @file_array, $file_info{$_};
 253     }
 254     return \@file_array;
 255
 256 }
 257
 258
 259
 260 =head2 function get_sorted_plots()
 261
 262  Usage: CXGN::Trial->get_sorted_plots($schema, $trials, $order, $start, $gaps)
 263  Desc:  Get an array of plot metadata (plot_id, plot_name, row_number, col_number, etc)
 264         for plots in the trial.  Sort the plots by the provided traversal parameters.
 265  Requirements: The Trial(s) MUST have row/col positions for every plot AND there must not
 266         be any overlapping plots (more than one plot with the same row/col position).
 267  Ret:   An array of sorted plot metadata
 268  Args:  trials = an arrayref of trial ids to include
 269         order = the order to traverse the plots ('by_col_serpentine', 'by_col_zigzag', 'by_row_serpentine', 'by_row_zigzag')
 270         start = the corner of the trial layout to start the traversal ('bottom_left', 'top_left', 'top_right', 'bottom_right')
 271         borders = a hashref with keys top, right, bottom, left.  If the value is 1, then include that side as a border
 272         gaps = when set to 1, include missing plots / gaps as items in the order
 273  Side Effects:
 274  Example:
 275
 276 =cut
 277
 278 sub get_sorted_plots {
 279     my $class = shift;
 280     my $schema = shift;
 281     my $trials = shift;
 282     my $order = shift || 'by_row_serpentine';
 283     my $start = shift || 'bottom_left';
 284     my $borders = shift || { top => 0, right => 0, bottom => 0, left => 0 };
 285     my $gaps = shift || 0;
 286
 287     # Parse each trial
 288     my @plot_details;
 289     my ($min_row, $max_row, $min_col, $max_col, %seen_row_cols);
 290     foreach my $trial_id (@$trials) {
 291
 292         # Get plot details from the stored layout information
 293         my $trial_layout_download = CXGN::Trial::TrialLayoutDownload->new({
 294             schema => $schema,
 295             trial_id => $trial_id,
 296             data_level => 'plots',
 297             selected_columns => {
 298                 "location_name"=>1,"trial_name"=>1,"plot_name"=>1,"plot_id"=>1,"plot_number"=>1,
 299                 "row_number"=>1,"col_number"=>1,"accession_name"=>1,"seedlot_name"=>1,
 300                 "rep_number"=>1,"block_number"=>1,"is_a_control"=>1,"accession_id"=>1
 301             },
 302         });
 303         my $output = $trial_layout_download->get_layout_output()->{output};
 304
 305         # Convert plot layout array into hash and add each plot to the plot_details array (of hashes)
 306         # Check for plot row/col requirements
 307         # Set the overall min/max row/col positions
 308         my @outer_array = @{$output};
 309         my ($inner_array, @keys);
 310         for my $i (0 .. $#outer_array) {
 311             $inner_array = $outer_array[$i];
 312             if (scalar @keys > 0) {
 313                 my %detail_hash;
 314                 @detail_hash{@keys} = @{$outer_array[$i]};
 315                 my $row = $detail_hash{'row_number'};
 316                 my $col = $detail_hash{'col_number'};
 317                 my $key = "$row|$col";
 318
 319                 # Check for undefined row and column positions
 320                 if ( !defined($row) || !defined($col) ) {
 321                     return { error => "One or more plots do not have a row and/or column defined!" };
 322                 }
 323
 324                 # Check for duplicate positions (plots with the same row / col positions)
 325                 if ( exists $seen_row_cols{$key} ) {
 326                     return { error => "One or more plots share the same row and column position!" };
 327                 }
 328
 329                 # Set the min/max row/col
 330                 $row = int($row);
 331                 $col = int($col);
 332                 if ( !defined($min_row) || $row < $min_row ) {
 333                     $min_row = $row;
 334                 }
 335                 if ( !defined($max_row) || $row > $max_row ) {
 336                     $max_row = $row;
 337                 }
 338                 if ( !defined($min_col) || $col < $min_col ) {
 339                     $min_col = $col;
 340                 }
 341                 if ( !defined($max_col) || $col > $max_col ) {
 342                     $max_col = $col;
 343                 }
 344
 345                 push(@plot_details, \%detail_hash);
 346             }
 347             else {
 348                 @keys = @{$inner_array};
 349             }
 350         }
 351     }
 352
 353     # Set starting position:
 354     #   right = col from max to min
 355     #   left = col from min to max
 356     #   top = row from max to min
 357     #   bottom = row from min to max
 358     # Add a row/col on either side for the borders
 359     my ($start_row, $end_row, $delta_row);
 360     my ($start_col, $end_col, $delta_col);
 361     if ( $start =~ /right/ ) {
 362         $start_col = $max_col + 1;
 363         $end_col = $min_col - 1;
 364         $delta_col = -1;
 365     }
 366     else {
 367         $start_col = $min_col - 1;
 368         $end_col = $max_col + 1;
 369         $delta_col = 1;
 370     }
 371     if ( $start =~ /top/ ) {
 372         $start_row = $max_row + 1;
 373         $end_row = $min_row - 1;
 374         $delta_row = -1;
 375     }
 376     else {
 377         $start_row = $min_row - 1;
 378         $end_row = $max_row + 1;
 379         $delta_row = 1;
 380     }
 381
 382     # Set traversal order:
 383     #   by_col = first by column (outer loop) then by row (inner loop)
 384     #   by_row = first by row (outer loop) then by col (inner loop)
 385     my ($outerloop_key, $outerloop_start, $outerloop_end, $outerloop_delta);
 386     my ($innerloop_key, $innerloop_start, $innerloop_end, $innerloop_delta);
 387     if ( $order =~ /by_col/ ) {
 388         $outerloop_key = 'col_number';
 389         $outerloop_start = $start_col;
 390         $outerloop_end = $end_col;
 391         $outerloop_delta = $delta_col;
 392         $innerloop_key = 'row_number';
 393         $innerloop_start = $start_row;
 394         $innerloop_end = $end_row;
 395         $innerloop_delta = $delta_row;
 396     }
 397     else {
 398         $outerloop_key = 'row_number';
 399         $outerloop_start = $start_row;
 400         $outerloop_end = $end_row;
 401         $outerloop_delta = $delta_row;
 402         $innerloop_key = 'col_number';
 403         $innerloop_start = $start_col;
 404         $innerloop_end = $end_col;
 405         $innerloop_delta = $delta_col;
 406     }
 407
 408     # Start the traversal
 409     my @ordered_plots;
 410     my $o_count = 0;
 411     my $p_order = 1;
 412
 413     # Start the outerloop...
 414     for ( my $o = $outerloop_start; $outerloop_delta > 0 ? $o <= $outerloop_end : $o >= $outerloop_end; $o=$o+$outerloop_delta ) {
 415         my $starting_p_order = $p_order;
 416
 417         # Invert the order of every other innerloop when serpentine
 418         my $i_start = $innerloop_start;
 419         my $i_end = $innerloop_end;
 420         my $i_delta = $innerloop_delta;
 421         if ( $order =~ /serpentine/ ) {
 422             if ( $o_count % 2 ) {
 423                 $i_start = $innerloop_end;
 424                 $i_end = $innerloop_start;
 425                 $i_delta = $innerloop_delta*-1;
 426             }
 427         }
 428
 429         # Start the innerloop...
 430         for ( my $i = $i_start; $i_delta > 0 ? $i <= $i_end : $i >= $i_end; $i=$i+$i_delta ) {
 431
 432             #
 433             # ADD BORDERS
 434             #
 435
 436             # Determine border type based on current position
 437             my $obt_start = $outerloop_key eq 'row_number' ? ($outerloop_delta > 0 ? 'bottom' : 'top') : ($outerloop_delta > 0 ? 'left' : 'right');
 438             my $obt_end = $outerloop_key eq 'row_number' ? ($outerloop_delta > 0 ? 'top' : 'bottom') : ($outerloop_delta > 0 ? 'right' : 'left');
 439             my $ibt_start = $innerloop_key eq 'col_number' ? ($innerloop_delta > 0 ? 'left' : 'right') : ($innerloop_delta > 0 ? 'bottom' : 'top');
 440             my $ibt_end = $innerloop_key eq 'col_number' ? ($innerloop_delta > 0 ? 'right' : 'left') : ($innerloop_delta > 0 ? 'top' : 'bottom');
 441
 442             # Add corner 1
 443             if ( $o == $outerloop_start && $i == $innerloop_start ) {
 444                 if ( $borders->{$obt_start} && $borders->{$ibt_start} ) {
 445                     push(@ordered_plots, {
 446                         order => $p_order,
 447                         type => 'border',
 448                         border => $obt_start . "_" . $ibt_start,
 449                         $outerloop_key => $o,
 450                         $innerloop_key => $i
 451                     });
 452                     $p_order++;
 453                 }
 454             }
 455
 456             # Add corner 2
 457             elsif ( $o == $outerloop_end && $i == $innerloop_start ) {
 458                 if ( $borders->{$obt_end} && $borders->{$ibt_start} ) {
 459                     push(@ordered_plots, {
 460                         order => $p_order,
 461                         type => 'border',
 462                         border => $obt_end . "_" . $ibt_start,
 463                         $outerloop_key => $o,
 464                         $innerloop_key => $i
 465                     });
 466                     $p_order++;
 467                 }
 468             }
 469
 470             # Add corner 3
 471             elsif ( $o == $outerloop_end && $i == $innerloop_end ) {
 472                 if ( $borders->{$obt_end} && $borders->{$ibt_end} ) {
 473                     push(@ordered_plots, {
 474                         order => $p_order,
 475                         type => 'border',
 476                         border => $obt_end . "_" . $ibt_end,
 477                         $outerloop_key => $o,
 478                         $innerloop_key => $i
 479                     });
 480                     $p_order++;
 481                 }
 482             }
 483
 484             # Add corner 4
 485             elsif ( $o == $outerloop_start && $i == $innerloop_end ) {
 486                 if ( $borders->{$obt_start} && $borders->{$ibt_end} ) {
 487                     push(@ordered_plots, {
 488                         order => $p_order,
 489                         type => 'border',
 490                         border => $obt_start . "_" . $ibt_end,
 491                         $outerloop_key => $o,
 492                         $innerloop_key => $i
 493                     });
 494                     $p_order++;
 495                 }
 496             }
 497
 498             # Add outer start border
 499             elsif ( $o == $outerloop_start ) {
 500                 if ( $borders->{$obt_start} ) {
 501                     push(@ordered_plots, {
 502                         order => $p_order,
 503                         type => 'border',
 504                         border => $obt_start,
 505                         $outerloop_key => $o,
 506                         $innerloop_key => $i
 507                     });
 508                     $p_order++;
 509                 }
 510             }
 511
 512             # Add outer end border
 513             elsif ( $o == $outerloop_end ) {
 514                 if ( $borders->{$obt_end} ) {
 515                     push(@ordered_plots, {
 516                         order => $p_order,
 517                         type => 'border',
 518                         border => $obt_end,
 519                         $outerloop_key => $o,
 520                         $innerloop_key => $i
 521                     });
 522                     $p_order++;
 523                 }
 524             }
 525
 526             # Add inner start border
 527             elsif ( $i == $innerloop_start ) {
 528                 if ( $borders->{$ibt_start} ) {
 529                     push(@ordered_plots, {
 530                         order => $p_order,
 531                         type => 'border',
 532                         border => $ibt_start,
 533                         $outerloop_key => $o,
 534                         $innerloop_key => $i
 535                     });
 536                     $p_order++;
 537                 }
 538             }
 539
 540             # Add inner end border
 541             elsif ( $i == $innerloop_end ) {
 542                 if ( $borders->{$ibt_end} ) {
 543                     push(@ordered_plots, {
 544                         order => $p_order,
 545                         type => 'border',
 546                         border => $ibt_end,
 547                         $outerloop_key => $o,
 548                         $innerloop_key => $i
 549                     });
 550                     $p_order++;
 551                 }
 552             }
 553
 554
 555             #
 556             # ADD PLOTS
 557             #
 558             else {
 559
 560                 # Find the plot with the matching row / col position
 561                 my ($p) = grep { $_->{$outerloop_key} == $o && $_->{$innerloop_key} == $i } @plot_details;
 562
 563                 # Add the plot, if it's found
 564                 if ( defined($p) ) {
 565                     $p->{order} = $p_order;
 566                     $p->{type} = 'plot';
 567                     push(@ordered_plots, $p);
 568                     $p_order++;
 569                 }
 570
 571                 # Add a gap item when there is no plot, if requested
 572                 elsif ( $gaps ) {
 573                     push(@ordered_plots, {
 574                         order => $p_order,
 575                         type => 'gap',
 576                         $outerloop_key => $o,
 577                         $innerloop_key => $i
 578                     });
 579                     $p_order++;
 580                 }
 581
 582             }
 583
 584         }
 585
 586         if ( $p_order > $starting_p_order ) {
 587             $o_count++;
 588         }
 589     }
 590
 591     return { plots => \@ordered_plots };
 592 }
 593
 594
 595 1;