lib/CXGN/Trial/FieldMap.pm

   1
   2 package CXGN::Trial::FieldMap;
   3
   4 use CXGN::Chado::Cvterm;
   5 use Moose;
   6 use SGN::Model::Cvterm;
   7 use Data::Dumper;
   8 use CXGN::Trial;
   9 use CXGN::Trial::TrialLayout;
  10 #use List::Util 'max';
  11 use List::MoreUtils qw | :all !before !after |;
  12 use Bio::Chado::Schema;
  13 use CXGN::Stock;
  14
  15 has 'bcs_schema' => ( isa => 'Bio::Chado::Schema',
  16         is => 'rw',
  17         required => 1,
  18 );
  19
  20 has 'trial_id' => (isa => "Int",
  21         is => 'rw',
  22 );
  23
  24 has 'experiment_type' => (isa => "Str",
  25         is => 'rw',
  26 );
  27
  28 has 'first_plot_selected' => (isa => "Int",
  29         is => 'rw',
  30 );
  31
  32 has 'second_plot_selected' => (isa => "Int",
  33         is => 'rw',
  34 );
  35
  36 has 'first_accession_selected' => (isa => "Str",
  37         is => 'rw',
  38 );
  39
  40 has 'second_accession_selected' => (isa => "Str",
  41         is => 'rw',
  42 );
  43
  44 has 'trial_stock_type' => (isa => "Str",
  45         is => 'rw',
  46         required => 0,
  47 );
  48
  49
  50 sub display_fieldmap {
  51         my $self = shift;
  52         my $schema = $self->bcs_schema;
  53         my $trial_id = $self->trial_id;
  54
  55     my $experiment_type = $self->experiment_type() ? $self->experiment_type() : 'field_layout';
  56
  57         my $layout = CXGN::Trial::TrialLayout->new({
  58                 schema => $schema,
  59                 trial_id => $trial_id,
  60         experiment_type => $experiment_type
  61         });
  62
  63         my $design = $layout-> get_design();
  64     my $design_type = $layout->get_design_type();
  65     #print STDERR Dumper($design_type);
  66
  67         my @plot_names = ();
  68     my @row_numbers = ();
  69     my @col_numbers = ();
  70     my @rep_numbers = ();
  71     my @block_numbers = ();
  72     my @accession_names = ();
  73         my @plot_numbers_from_design = ();
  74     my @plot_numbers_not_used;
  75         my $result;
  76
  77     my @layout_info;
  78     while ( my ($k, $v) = (each %$design)) {
  79         my $plot_number = $k;
  80         my $plot_id = $v->{plot_id};
  81         my $row_number = $v->{row_number};
  82         my $col_number = $v->{col_number};
  83         my $block_number = $v->{block_number};
  84         my $rep_number = $v->{rep_number};
  85         my $plot_name = $v->{plot_name};
  86         my $accession_name = $v->{accession_name};
  87         my $plant_names = $v->{plant_names};
  88                 my $plot_number_fromDesign = $v->{plot_number};
  89
  90                 my $image_id = CXGN::Stock->new({
  91                         schema => $schema,
  92                         stock_id => $plot_id,
  93                 });
  94                 my @plot_image_ids = map $_->[0], $image_id->get_image_ids();
  95
  96         push @plot_numbers_not_used, $plot_number;
  97                 push @plot_numbers_from_design, $plot_number_fromDesign;
  98         if ($col_number) {
  99             push @col_numbers, $col_number;
 100         }
 101         if ($row_number) {
 102             push @row_numbers, $row_number;
 103         }elsif (!$row_number){
 104                         if ($block_number && $design_type ne 'splitplot'){
 105                                 $row_number = $block_number;
 106                                 push @row_numbers, $row_number;
 107                         }elsif ($rep_number && !$block_number && $design_type ne 'splitplot'){
 108                                 $row_number = $rep_number;
 109                                 push @row_numbers, $row_number;
 110                         }elsif ($design_type eq 'splitplot'){
 111                 $row_number = $rep_number;
 112                                 push @row_numbers, $row_number;
 113             }
 114                 }
 115         if ($rep_number) {
 116             push @rep_numbers, $rep_number;
 117         }
 118         if ($block_number) {
 119             push @block_numbers, $block_number;
 120         }
 121         if ($accession_name) {
 122             push @accession_names, $accession_name;
 123         }
 124                 if ($plot_name) {
 125                         push @plot_names, $plot_name;
 126                 }
 127
 128                 push @layout_info, {
 129             plot_id => $plot_id,
 130             plot_number => $plot_number,
 131             row_number => $row_number,
 132             col_number => $col_number,
 133             block_number=> $block_number,
 134             rep_number =>  $rep_number,
 135             plot_name => $plot_name,
 136             accession_name => $accession_name,
 137             plant_names => $plant_names,
 138                         plot_image_ids => \@plot_image_ids,
 139         };
 140
 141     }
 142         @layout_info = sort { $a->{plot_number} <=> $b->{plot_number}} @layout_info;
 143         my @plot_numbers;
 144     my @stocks_hm;
 145         my $false_coord;
 146         if (scalar(@col_numbers) < 1){
 147         @col_numbers = ();
 148         $false_coord = 'false_coord';
 149                 my @row_instances = uniq @row_numbers;
 150                 my %unique_row_counts;
 151                 $unique_row_counts{$_}++ for @row_numbers;
 152         my @col_number2;
 153         for my $key (keys %unique_row_counts){
 154             push @col_number2, (1..$unique_row_counts{$key});
 155         }
 156         for (my $i=0; $i < scalar(@layout_info); $i++){
 157                         $layout_info[$i]->{'col_number'} = $col_number2[$i];
 158             push @col_numbers, $col_number2[$i];
 159         }
 160         }
 161         my $plot_popUp;
 162         foreach my $hash (@layout_info){
 163         push @plot_numbers, $hash->{'plot_number'};
 164         push @stocks_hm, $hash->{'accession_name'};
 165                 if (scalar(@{$hash->{"plant_names"}}) < 1) {
 166                         $plot_popUp = $hash->{'plot_name'}."\nplot_No:".$hash->{'plot_number'}."\nblock_No:".$hash->{'block_number'}."\nrep_No:".$hash->{'rep_number'}."\nstock:".$hash->{'accession_name'};
 167                 }
 168                 else{
 169                         $plot_popUp = $hash->{'plot_name'}."\nplot_No:".$hash->{'plot_number'}."\nblock_No:".$hash->{'block_number'}."\nrep_No:".$hash->{'rep_number'}."\nstock:".$hash->{'accession_name'}."\nnumber_of_plants:".scalar(@{$hash->{"plant_names"}});
 170                 }
 171                 push @$result,  {plotname => $hash->{'plot_name'}, plot_id => $hash->{'plot_id'}, stock => $hash->{'accession_name'}, plotn => $hash->{'plot_number'}, blkn=>$hash->{'block_number'}, rep=>$hash->{'rep_number'}, row=>$hash->{'row_number'}, plot_image_ids=>$hash->{'plot_image_ids'}, col=>$hash->{'col_number'}, plot_msg=>$plot_popUp} ;
 172         }
 173         #print STDERR Dumper(\@col_numbers);
 174         #print STDERR Dumper($result);
 175         my @plot_name = ();
 176         my @plot_id = ();
 177         my @acc_name = ();
 178         my @blk_no = ();
 179         my @rep_no = ();
 180         my @array_msg = ();
 181         my @plot_number = ();
 182         my $my_hash;
 183
 184         foreach $my_hash (@layout_info) {
 185                 if ($my_hash->{'row_number'}) {
 186                         if ($my_hash->{'row_number'} =~ m/\d+/) {
 187                                 if (scalar(@{$my_hash->{"plant_names"}}) < 1) {
 188                                         $array_msg[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = "rep_number: ".$my_hash->{'rep_number'}."\nblock_number: ".$my_hash->{'block_number'}."\nrow_number: ".$my_hash->{'row_number'}."\ncol_number: ".$my_hash->{'col_number'}."\naccession_name: ".$my_hash->{'accession_name'}."\nPlot_name: ".$my_hash->{'plot_name'};
 189                                 }
 190                                 else{
 191                                         $array_msg[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = "rep_number: ".$my_hash->{'rep_number'}."\nblock_number: ".$my_hash->{'block_number'}."\nrow_number: ".$my_hash->{'row_number'}."\ncol_number: ".$my_hash->{'col_number'}."\naccession_name: ".$my_hash->{'accession_name'}."\nnumber_of_plants:".scalar(@{$my_hash->{"plant_names"}})."\nPlot_name: ".$my_hash->{'plot_name'};
 192                                 }
 193                                 $plot_id[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = $my_hash->{'plot_id'};
 194                                 $plot_number[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = $my_hash->{'plot_number'};
 195                                 $acc_name[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = $my_hash->{'accession_name'};
 196                                 $blk_no[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = $my_hash->{'block_number'};
 197                                 $rep_no[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = $my_hash->{'rep_number'};
 198                                 $plot_name[$my_hash->{'row_number'}-1][$my_hash->{'col_number'}-1] = $my_hash->{'plot_name'};
 199                         }
 200                 }
 201         }
 202
 203         my @plotcnt;
 204         my $plotcounter_nu = 0;
 205         if ($plot_numbers_not_used[0] =~ m/^\d{3}/){
 206                 foreach my $plot (@plot_numbers_not_used) {
 207                         $plotcounter_nu++;
 208                 }
 209                 for my $n (1..$plotcounter_nu){
 210                         push @plotcnt, $n;
 211                 }
 212         }
 213
 214         my @sorted_block = sort@block_numbers;
 215         my @uniq_block = uniq(@sorted_block);
 216         my ($min_rep, $max_rep) = minmax @rep_numbers;
 217         my ($min_block, $max_block) = minmax @block_numbers;
 218         my ($min_col, $max_col) = minmax @col_numbers;
 219         my ($min_row, $max_row) = minmax @row_numbers;
 220         my (@unique_col,@unique_row);
 221         for my $x (1..$max_col){
 222                 push @unique_col, $x;
 223         }
 224         for my $y (1..$max_row){
 225                 push @unique_row, $y;
 226         }
 227
 228         my $trial = CXGN::Trial->new({
 229                 bcs_schema => $schema,
 230                 trial_id => $trial_id
 231         });
 232         my $data = $trial->get_controls();
 233
 234         my @control_name;
 235         foreach my $cntrl (@{$data}) {
 236                 push @control_name, $cntrl->{'accession_name'};
 237         }
 238
 239         my %return = (
 240                 coord_row =>  \@row_numbers,
 241                 coords =>  \@layout_info,
 242                 coord_col =>  \@col_numbers,
 243                 max_row => $max_row,
 244                 max_col => $max_col,
 245                 plot_msg => \@array_msg,
 246                 rep => \@rep_numbers,
 247                 block => \@sorted_block,
 248                 accessions => \@accession_names,
 249                 plot_name => \@plot_name,
 250                 plot_id => \@plot_id,
 251                 plot_number => \@plot_number,
 252         plot_numbers => \@plot_numbers,
 253         stocks => \@stocks_hm,
 254                 max_rep => $max_rep,
 255                 max_block => $max_block,
 256                 sudo_plot_no => \@plotcnt,
 257                 controls => \@control_name,
 258                 blk => \@blk_no,
 259                 acc => \@acc_name,
 260                 rep_no => \@rep_no,
 261                 unique_col => \@unique_col,
 262                 unique_row => \@unique_row,
 263                 false_coord => $false_coord,
 264                 result => $result,
 265         design_type => $design_type,
 266         );
 267         #print STDERR Dumper(\%return);
 268         return \%return;
 269 }
 270
 271 sub delete_fieldmap {
 272         my $self = shift;
 273         my $error;
 274         my $trial_id = $self->trial_id;
 275         my $dbh = $self->bcs_schema->storage->dbh();
 276
 277   my $h = $dbh->prepare("delete from stockprop where stockprop.stockprop_id IN (select stockprop.stockprop_id from project join nd_experiment_project using(project_id) join nd_experiment_stock using(nd_experiment_id) join stock using(stock_id) join stockprop on(stock.stock_id=stockprop.stock_id) where (stockprop.type_id IN (select cvterm_id from cvterm where name='col_number') or stockprop.type_id IN (select cvterm_id from cvterm where name='row_number')) and project.project_id=? and stock.type_id IN (select cvterm_id from cvterm join cv using(cv_id) where cv.name = 'stock_type' and cvterm.name ='plot'));");
 278   $h->execute($trial_id);
 279
 280   $self->_regenerate_trial_layout_cache();
 281
 282         return $error;
 283 }
 284
 285 sub update_fieldmap_precheck {
 286         my $self = shift;
 287         my $error;
 288         my $trial_id = $self->trial_id;
 289
 290         my $trial = CXGN::Trial->new({
 291                 bcs_schema => $self->bcs_schema,
 292                 trial_id => $trial_id
 293         });
 294         my $triat_name = $trial->get_traits_assayed();
 295         #print STDERR Dumper($triat_name);
 296
 297         if (scalar(@{$triat_name}) != 0)  {
 298          $error = "One or more traits have been assayed for this trial; Map/Layout can not be modified. Please contact us.";
 299          return $error;
 300         }
 301         my $seedlots = $trial->get_seedlots();
 302         if (scalar(@$seedlots) != 0){
 303                 $error = "Seedlots have already been saved as the source material for the plots in this trial. Map/Layout can not be modified. Please contact us.";
 304         }
 305         return $error;
 306 }
 307
 308 sub substitute_accession_precheck {
 309         my $self = shift;
 310         my $error;
 311         my @plots;
 312         my @ids;
 313         my $dbh = $self->bcs_schema->storage->dbh;
 314         my $plot_1_id = $self->first_plot_selected;
 315         my $plot_2_id = $self->second_plot_selected;
 316         push @ids, $plot_1_id;
 317         push @ids, $plot_2_id;
 318
 319         my $isAcontrol_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'is a control', 'stock_property' )->cvterm_id();
 320
 321         foreach my $id (@ids) {
 322                 my $h = $dbh->prepare("select value from stockprop where stock_id=? and type_id=?;");
 323                 $h->execute($id,$isAcontrol_cvterm_id);
 324                 while (my $plot = $h->fetchrow_array()) {
 325                         push @plots, $plot;
 326                 }
 327         }
 328
 329         if (scalar(@plots) != 0)  {
 330          $error = "Accessions used as control/check can't be substituted between plots...";
 331         }
 332         return $error;
 333 }
 334
 335 sub substitute_accession_fieldmap {
 336         my $self = shift;
 337         my $error;
 338         my $plot_1_id = $self->first_plot_selected;
 339         my $plot_2_id = $self->second_plot_selected;
 340         my $dbh = $self->bcs_schema->storage->dbh;
 341
 342         my @plot_1_objectIDs;
 343         my @plot_2_objectIDs;
 344         my $h = $dbh->prepare("select object_id from stock_relationship where subject_id=?;");
 345         $h->execute($plot_1_id);
 346         while (my $plot_1_objectID = $h->fetchrow_array()) {
 347                 push @plot_1_objectIDs, $plot_1_objectID;
 348         }
 349
 350         my $h1 = $dbh->prepare("select object_id from stock_relationship where subject_id=?;");
 351         $h1->execute($plot_2_id);
 352         while (my $plot_2_objectID = $h1->fetchrow_array()) {
 353                 push @plot_2_objectIDs, $plot_2_objectID;
 354         }
 355
 356         for (my $n=0; $n<scalar(@plot_2_objectIDs); $n++) {
 357                 my $h2 = $dbh->prepare("update stock_relationship set object_id =? where object_id=? and subject_id=?;");
 358                 $h2->execute($plot_1_objectIDs[$n],$plot_2_objectIDs[$n],$plot_2_id);
 359         }
 360
 361         for (my $n=0; $n<scalar(@plot_2_objectIDs); $n++) {
 362                 my $h2 = $dbh->prepare("update stock_relationship set object_id =? where object_id=? and subject_id=?;");
 363                 $h2->execute($plot_2_objectIDs[$n],$plot_1_objectIDs[$n],$plot_1_id);
 364         }
 365
 366     $self->_regenerate_trial_layout_cache();
 367
 368         return $error;
 369 }
 370
 371 sub replace_plot_accession_fieldMap {
 372         my $self = shift;
 373         my $plot_id = shift;
 374         my $accession_id = shift;
 375         my $plot_of_type_id = shift;
 376         my $error;
 377         my $schema = $self->bcs_schema;
 378         my $dbh = $self->bcs_schema->storage->dbh;
 379
 380         my $stockprop_rs = $schema->resultset("Stock::StockRelationship")->search({
 381                 subject_id => $plot_id,
 382                 type_id => $plot_of_type_id
 383     });
 384
 385         if ($stockprop_rs->count == 1) {
 386                 $stockprop_rs->update({
 387                         object_id => $accession_id,
 388                 });
 389         }
 390         elsif ($stockprop_rs->count > 1) {
 391                 $error = "There should only be one accession linked to the plot via plot_of\n";
 392         } else {
 393                 $error = "Plot entry does not exist in database.\n";
 394         }
 395
 396     $self->_regenerate_trial_layout_cache();
 397
 398         return $error;
 399
 400 }
 401
 402 sub replace_plot_name_fieldMap {
 403         my $self = shift;
 404         my $plot_id = shift;
 405         my $new_plot_name = shift;
 406         my $error;
 407         my $schema = $self->bcs_schema;
 408
 409         my $new_plot_name_validator = CXGN::List::Validate->new();
 410     my $valid_new_plot_name = @{$new_plot_name_validator->validate($schema,'plots',[$new_plot_name])->{'missing'}};
 411     if (!$valid_new_plot_name) {
 412                 $error .= "Plot name $new_plot_name already exists in the database";
 413     } else {
 414                 my $plot_type_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'plot', 'stock_type')->cvterm_id();
 415                 my $stock_rs = $schema->resultset("Stock::Stock")->search({
 416                 stock_id => $plot_id,
 417                 type_id => $plot_type_id,
 418             });
 419                 $stock_rs->update({
 420                         uniquename => $new_plot_name,
 421                 });
 422         }
 423
 424         $self->_regenerate_trial_layout_cache();
 425         return $error;
 426 }
 427
 428
 429 sub replace_trial_stock_fieldMap {
 430         my $self = shift;
 431         my $new_stock = shift;
 432         my $old_stock_id = shift;
 433         my $error;
 434         my $schema = $self->bcs_schema;
 435         my $dbh = $self->bcs_schema->storage->dbh;
 436         my $trial_id = $self->trial_id;
 437     my $trial_stock_type = $self->trial_stock_type;
 438
 439         print "New Stock: $new_stock and OLD Stock: $old_stock_id\n";
 440
 441         my $new_stock_id = $schema->resultset("Stock::Stock")->search({uniquename => $new_stock})->first->stock_id();
 442         my $accession_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'accession', 'stock_type' )->cvterm_id();
 443         my $family_name_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'family_name', 'stock_type' )->cvterm_id();
 444         my $cross_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'cross', 'stock_type' )->cvterm_id();
 445         my $field_trial_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, "field_layout", "experiment_type")->cvterm_id();
 446         my $plot_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, "plot_of", "stock_relationship")->cvterm_id();
 447         my $plant_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, "plant_of", "stock_relationship")->cvterm_id();
 448         my $subplot_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, "subplot_of", "stock_relationship")->cvterm_id();
 449
 450         my $h_update = $dbh->prepare("update stock_relationship set object_id=? where stock_relationship_id in (SELECT stock_relationship.stock_relationship_id FROM stock as accession JOIN stock_relationship on (accession.stock_id = stock_relationship.object_id) JOIN stock as plot on (plot.stock_id = stock_relationship.subject_id) JOIN nd_experiment_stock on (plot.stock_id=nd_experiment_stock.stock_id) JOIN nd_experiment using(nd_experiment_id) JOIN nd_experiment_project using(nd_experiment_id) JOIN project using(project_id) WHERE accession.type_id =? AND stock_relationship.type_id IN (?,?,?) AND project.project_id =? and nd_experiment.type_id=?) and object_id=?;");
 451     if ($trial_stock_type eq 'family_name') {
 452                 $h_update->execute($new_stock_id,$family_name_cvterm_id,$plot_of_cvterm_id,$plant_of_cvterm_id,$subplot_of_cvterm_id,$trial_id,$field_trial_cvterm_id,$old_stock_id);
 453     } elsif ($trial_stock_type eq 'cross') {
 454                 $h_update->execute($new_stock_id,$cross_cvterm_id,$plot_of_cvterm_id,$plant_of_cvterm_id,$subplot_of_cvterm_id,$trial_id,$field_trial_cvterm_id,$old_stock_id);
 455     } else {
 456                 $h_update->execute($new_stock_id,$accession_cvterm_id,$plot_of_cvterm_id,$plant_of_cvterm_id,$subplot_of_cvterm_id,$trial_id,$field_trial_cvterm_id,$old_stock_id);
 457     }
 458
 459     $self->_regenerate_trial_layout_cache();
 460
 461         return $error;
 462 }
 463
 464 sub _regenerate_trial_layout_cache {
 465     my $self = shift;
 466     my $experiment_type = $self->experiment_type() ? $self->experiment_type() : 'field_layout';
 467     my $layout = CXGN::Trial::TrialLayout->new({
 468         schema => $self->bcs_schema,
 469         trial_id => $self->trial_id,
 470         experiment_type => $experiment_type
 471     });
 472     $layout->generate_and_cache_layout();
 473 }
 474
 475 1;