lib/CXGN/Pedigree/AddCrosses.pm

   1 package CXGN::Pedigree::AddCrosses;
   2
   3 =head1 NAME
   4
   5 CXGN::Pedigree::AddCrosses - a module to add cross.
   6
   7 =head1 USAGE
   8
   9  my $cross_add = CXGN::Pedigree::AddCrosses->new({ schema => $schema, location => $location_name, program => $program_name, crosses =>  \@array_of_pedigree_objects} );
  10  my $validated = $cross_add->validate_crosses(); #is true when all of the crosses are valid and the accessions they point to exist in the database.
  11  $cross_add->add_crosses();
  12
  13 =head1 DESCRIPTION
  14
  15 Adds an array of crosses. The parents used in the cross must already exist in the database, and the verify function does this check.   This module is intended to be used in independent loading scripts and interactive dialogs.
  16
  17 =head1 AUTHORS
  18
  19  Jeremy D. Edwards (jde22@cornell.edu)
  20  Titima Tantikanjana (tt15@cornell.edu)
  21
  22 =cut
  23
  24 use Moose;
  25 use MooseX::FollowPBP;
  26 use Moose::Util::TypeConstraints;
  27 use Try::Tiny;
  28 use Bio::GeneticRelationships::Pedigree;
  29 use Bio::GeneticRelationships::Individual;
  30 use CXGN::Stock::StockLookup;
  31 use CXGN::BreedersToolbox::Projects;
  32 use CXGN::Trial;
  33 use CXGN::Trial::Folder;
  34 use SGN::Model::Cvterm;
  35 use Data::Dumper;
  36 use File::Basename qw | basename dirname|;
  37 use CXGN::UploadFile;
  38
  39
  40 class_type 'Pedigree', { class => 'Bio::GeneticRelationships::Pedigree' };
  41
  42 has 'chado_schema' => (
  43     is => 'rw',
  44     isa => 'DBIx::Class::Schema',
  45     predicate => 'has_chado_schema',
  46     required => 1,
  47 );
  48
  49 has 'phenome_schema' => (
  50     is => 'rw',
  51     isa => 'DBIx::Class::Schema',
  52     predicate => 'has_phenome_schema',
  53     required => 1,
  54 );
  55
  56 has 'metadata_schema' => (
  57     is => 'rw',
  58     isa => 'DBIx::Class::Schema',
  59     predicate => 'has_metadata_schema',
  60     required => 0,
  61 );
  62
  63 has 'dbh' => (
  64     is  => 'rw',
  65     predicate => 'has_dbh',
  66     required => 1,
  67 );
  68
  69 has 'crosses' => (
  70     isa =>'ArrayRef[Pedigree]',
  71     is => 'rw',
  72     predicate => 'has_crosses',
  73     required => 1,
  74 );
  75
  76 has 'user_id' => (
  77     isa => 'Int',
  78     is => 'rw',
  79     predicate => 'has_user_id',
  80     required => 1,
  81 );
  82
  83 has 'crossing_trial_id' => (
  84     isa =>'Int',
  85     is => 'rw',
  86     predicate => 'has_crossing_trial_id',
  87     required => 1,
  88 );
  89
  90 has 'file_id' => (
  91     isa => 'Int',
  92     is => 'rw',
  93     predicate => 'has_file_id',
  94     required => 0,
  95 );
  96
  97
  98 sub add_crosses {
  99     my $self = shift;
 100     my $chado_schema = $self->get_chado_schema();
 101     my $phenome_schema = $self->get_phenome_schema();
 102     my $metadata_schema = $self->get_metadata_schema();
 103     my $crossing_trial_id = $self->get_crossing_trial_id();
 104     my $owner_id = $self->get_user_id();
 105     my @crosses;
 106     my $transaction_error;
 107     my @added_stock_ids;
 108     my %nd_experiments;
 109
 110     if (!$self->validate_crosses()) {
 111         print STDERR "Invalid pedigrees in array.  No crosses will be added\n";
 112         return;
 113     }
 114
 115     #add all crosses in a single transaction
 116     my $coderef = sub {
 117
 118         #get cvterms for parents
 119         my $female_parent_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'female_parent', 'stock_relationship');
 120         my $male_parent_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'male_parent', 'stock_relationship');
 121
 122                 #get cvterm for cross_combination
 123                 my $cross_combination_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'cross_combination', 'stock_property');
 124
 125         #get cvterm for cross_experiment
 126         my $cross_experiment_type_cvterm =  SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'cross_experiment', 'experiment_type');
 127
 128         #get cvterm for stock type cross
 129         my $cross_stock_type_cvterm  =  SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'cross', 'stock_type');
 130
 131         #get cvterm for female and male plots
 132         my $female_plot_of_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'female_plot_of', 'stock_relationship');
 133         my $male_plot_of_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'male_plot_of', 'stock_relationship');
 134
 135         #get cvterm for female and male plants
 136         my $female_plant_of_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'female_plant_of', 'stock_relationship');
 137         my $male_plant_of_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'male_plant_of', 'stock_relationship');
 138
 139                 my $project_location_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'project location', 'project_property')->cvterm_id();
 140                 my $geolocation_rs = $chado_schema->resultset("Project::Projectprop")->find({project_id => $crossing_trial_id, type_id => $project_location_cvterm_id});
 141
 142         my $cross_identifier_cvterm  =  SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'cross_identifier', 'stock_property');
 143
 144         @crosses = @{$self->get_crosses()};
 145         foreach my $pedigree (@crosses) {
 146             my $experiment;
 147             my $cross_stock;
 148             my $organism_id;
 149             my $female_parent_name;
 150             my $male_parent_name;
 151             my $female_parent;
 152             my $male_parent;
 153             my $population_stock;
 154             my $cross_type = $pedigree->get_cross_type();
 155             my $cross_name = $pedigree->get_name();
 156                         my $cross_combination = $pedigree->get_cross_combination();
 157             my $female_plot_name;
 158             my $male_plot_name;
 159             my $female_plot;
 160             my $male_plot;
 161             my $female_plant_name;
 162             my $male_plant_name;
 163             my $female_plant;
 164             my $male_plant;
 165
 166             $cross_name =~ s/^\s+|\s+$//g; #trim whitespace from both ends
 167
 168
 169             if ($pedigree->has_female_parent()) {
 170                 $female_parent_name = $pedigree->get_female_parent()->get_name();
 171                 if ($cross_type eq 'backcross') {
 172                     $female_parent = $self->_get_accession_or_cross($female_parent_name);
 173                 } else {
 174                     $female_parent = $self->_get_accession($female_parent_name);
 175                 }
 176             }
 177
 178             if ($pedigree->has_male_parent()) {
 179                 $male_parent_name = $pedigree->get_male_parent()->get_name();
 180                 if ($cross_type eq 'backcross') {
 181                     $male_parent = $self->_get_accession_or_cross($male_parent_name);
 182                 } else {
 183                     $male_parent = $self->_get_accession($male_parent_name);
 184                 }
 185             }
 186
 187             if ($pedigree->has_female_plot()) {
 188                 $female_plot_name = $pedigree->get_female_plot()->get_name();
 189                 $female_plot = $self->_get_plot($female_plot_name);
 190             }
 191
 192             if ($pedigree->has_male_plot()) {
 193                 $male_plot_name = $pedigree->get_male_plot()->get_name();
 194                 $male_plot = $self->_get_plot($male_plot_name);
 195             }
 196
 197             if ($pedigree->has_female_plant()) {
 198                 $female_plant_name = $pedigree->get_female_plant()->get_name();
 199                 $female_plant = $self->_get_plant($female_plant_name);
 200             }
 201
 202             if ($pedigree->has_male_plant()) {
 203                 $male_plant_name = $pedigree->get_male_plant()->get_name();
 204                 $male_plant = $self->_get_plant($male_plant_name);
 205             }
 206
 207             #organism of cross experiment will be the same as the female parent
 208             if ($female_parent) {
 209                 $organism_id = $female_parent->organism_id();
 210             } else {
 211                 $organism_id = $male_parent->organism_id();
 212             }
 213
 214             my $previous_cross_stock_rs = $chado_schema->resultset("Stock::Stock")->search({
 215                 organism_id => $organism_id,
 216                 uniquename => $cross_name,
 217                 type_id => $cross_stock_type_cvterm->cvterm_id,
 218             });
 219             if ($previous_cross_stock_rs->count > 0){
 220             #If cross already exists, just go to next cross
 221                 next;
 222             }
 223
 224             #create cross experiment
 225             $experiment = $chado_schema->resultset('NaturalDiversity::NdExperiment')->create({
 226                 nd_geolocation_id => $geolocation_rs->value,
 227                 type_id => $cross_experiment_type_cvterm->cvterm_id,
 228             });
 229             my $nd_experiment_id = $experiment->nd_experiment_id();
 230             $nd_experiments{$nd_experiment_id}++;
 231
 232             #create a stock of type cross
 233             $cross_stock = $chado_schema->resultset("Stock::Stock")->find_or_create({
 234                 organism_id => $organism_id,
 235                 name => $cross_name,
 236                 uniquename => $cross_name,
 237                 type_id => $cross_stock_type_cvterm->cvterm_id,
 238             });
 239
 240             #add stock_id of cross to an array so that the owner can be associated in the phenome schema after the transaction on the chado schema completes
 241             push (@added_stock_ids,  $cross_stock->stock_id());
 242
 243
 244             #link parents to the stock of type cross
 245             if ($female_parent) {
 246                 $cross_stock->find_or_create_related('stock_relationship_objects', {
 247                     type_id => $female_parent_cvterm->cvterm_id(),
 248                     object_id => $cross_stock->stock_id(),
 249                     subject_id => $female_parent->stock_id(),
 250                     value => $cross_type,
 251                 });
 252             }
 253
 254             if ($male_parent) {
 255                 $cross_stock->find_or_create_related('stock_relationship_objects', {
 256                     type_id => $male_parent_cvterm->cvterm_id(),
 257                     object_id => $cross_stock->stock_id(),
 258                     subject_id => $male_parent->stock_id(),
 259                 });
 260             }
 261
 262             if ( ( $cross_type eq "self" || $cross_type eq "dihaploid_induction" || $cross_type eq "doubled_haploid") &&  $female_parent) {
 263                 $cross_stock->find_or_create_related('stock_relationship_objects', {
 264                     type_id => $male_parent_cvterm->cvterm_id(),
 265                     object_id => $cross_stock->stock_id(),
 266                     subject_id => $female_parent->stock_id(),
 267                 });
 268             }
 269
 270             #link cross to female_plot
 271             if ($female_plot) {
 272                 $cross_stock->find_or_create_related('stock_relationship_objects', {
 273                     type_id => $female_plot_of_cvterm->cvterm_id(),
 274                     object_id => $cross_stock->stock_id(),
 275                     subject_id => $female_plot->stock_id(),
 276                 });
 277             }
 278
 279             #link cross to male_plot
 280             if ($male_plot) {
 281                 $cross_stock->find_or_create_related('stock_relationship_objects', {
 282                     type_id => $male_plot_of_cvterm->cvterm_id(),
 283                     object_id => $cross_stock->stock_id(),
 284                     subject_id => $male_plot->stock_id(),
 285                 });
 286             }
 287
 288             #link cross to female_plant
 289             if ($female_plant) {
 290                 $cross_stock->find_or_create_related('stock_relationship_objects', {
 291                     type_id => $female_plant_of_cvterm->cvterm_id(),
 292                     object_id => $cross_stock->stock_id(),
 293                     subject_id => $female_plant->stock_id(),
 294                 });
 295             }
 296
 297             #link cross to male_plant
 298             if ($male_plant) {
 299                 $cross_stock->find_or_create_related('stock_relationship_objects', {
 300                     type_id => $male_plant_of_cvterm->cvterm_id(),
 301                     object_id => $cross_stock->stock_id(),
 302                     subject_id => $male_plant->stock_id(),
 303                 });
 304             }
 305
 306             #link cross to cross_combination
 307                         if ($cross_combination) {
 308                                 $cross_stock->create_stockprops({$cross_combination_cvterm->name() => $cross_combination});
 309             }
 310
 311             #link the stock of type cross to the experiment
 312             $experiment->find_or_create_related('nd_experiment_stocks' , {
 313                       stock_id => $cross_stock->stock_id(),
 314                       type_id  =>  $cross_experiment_type_cvterm->cvterm_id(),
 315                         });
 316
 317             #link the experiment to the project
 318             $experiment->find_or_create_related('nd_experiment_projects', {
 319                 project_id => $self->get_crossing_trial_id,
 320             });
 321
 322             my $identifier_female_id;
 323             my $identifier_male_id;
 324             if ($female_plant){
 325                 $identifier_female_id = $female_plant->stock_id();
 326             } elsif ($female_plot){
 327                 $identifier_female_id = $female_plot->stock_id();
 328             } else {
 329                 $identifier_female_id = $female_parent->stock_id();
 330             }
 331
 332             if ($male_plant){
 333                 $identifier_male_id = $male_plant->stock_id();
 334             } elsif ($male_plot){
 335                 $identifier_male_id = $male_plot->stock_id();
 336             } elsif ($male_parent) {
 337                 $identifier_male_id = $male_parent->stock_id();
 338             } else {
 339                 $identifier_male_id = 'NA'
 340             }
 341
 342             my $cross_identifier = $crossing_trial_id.'_'.$identifier_female_id.'_'.$identifier_male_id;
 343             $cross_stock->create_stockprops({$cross_identifier_cvterm->name() => $cross_identifier});
 344             print STDERR "CROSS IDENTIFIER =".Dumper($cross_identifier)."\n";
 345         }
 346
 347     };
 348
 349     #try to add all crosses in a transaction
 350     try {
 351         $chado_schema->txn_do($coderef);
 352     } catch {
 353         $transaction_error =  $_;
 354     };
 355
 356     if ($transaction_error) {
 357         print STDERR "Transaction error creating a cross: $transaction_error\n";
 358         return;
 359     }
 360
 361     foreach my $stock_id (@added_stock_ids) {
 362         #add the owner for this stock
 363         $phenome_schema->resultset("StockOwner")->find_or_create({
 364             stock_id => $stock_id,
 365             sp_person_id => $owner_id,
 366         });
 367     }
 368
 369     #link nd_experiments to file_id
 370     my $file_id = $self->get_file_id;
 371 #    print STDERR "FILE ID =".Dumper($file_id)."\n";
 372     if ($file_id) {
 373         foreach my $nd_experiment_id (keys %nd_experiments) {
 374             my $nd_experiment_files = $phenome_schema->resultset("NdExperimentMdFiles")->create({
 375                 nd_experiment_id => $nd_experiment_id,
 376                 file_id => $file_id,
 377             });
 378         }
 379     }
 380
 381     return 1;
 382 }
 383
 384
 385 sub validate_crosses {
 386     my $self = shift;
 387     my $chado_schema = $self->get_chado_schema();
 388     my @crosses = @{$self->get_crosses()};
 389     my $invalid_cross_count = 0;
 390     my $crossing_trial_lookup;
 391     my $crossing_trial;
 392     my $trial_lookup;
 393
 394     $crossing_trial_lookup = CXGN::BreedersToolbox::Projects->new({ schema => $chado_schema});
 395     $crossing_trial = $crossing_trial_lookup->get_crossing_trials($self->get_crossing_trial_id());
 396     if (!$crossing_trial) {
 397         print STDERR "Crossing trial ". $self->get_crossing_trials() ." not found\n";
 398         return;
 399     }
 400
 401     foreach my $cross (@crosses) {
 402         my $validated_cross = $self->_validate_cross($cross);
 403
 404         if (!$validated_cross) {
 405             $invalid_cross_count++;
 406         }
 407
 408     }
 409
 410     if ($invalid_cross_count > 0) {
 411         print STDERR "There were $invalid_cross_count invalid crosses\n";
 412         return;
 413     }
 414
 415     return 1;
 416 }
 417
 418 sub _validate_cross {
 419     my $self = shift;
 420     my $pedigree = shift;
 421     my $chado_schema = $self->get_chado_schema();
 422     my $name = $pedigree->get_name();
 423     my $cross_type = $pedigree->get_cross_type();
 424     my $female_parent_name;
 425     my $male_parent_name;
 426     my $female_parent;
 427     my $male_parent;
 428
 429     if ($cross_type eq "biparental") {
 430         $female_parent_name = $pedigree->get_female_parent()->get_name();
 431         $male_parent_name = $pedigree->get_male_parent()->get_name();
 432         $female_parent = $self->_get_accession($female_parent_name);
 433         $male_parent = $self->_get_accession($male_parent_name);
 434
 435         if (!$female_parent || !$male_parent) {
 436             print STDERR "Parent $female_parent_name or $male_parent_name in pedigree is not a stock\n";
 437             return;
 438         }
 439
 440     } elsif ($cross_type eq "self" || $cross_type eq "dihaploid_induction" || $cross_type eq "doubled_haploid" ) {
 441         $female_parent_name = $pedigree->get_female_parent()->get_name();
 442         $female_parent = $self->_get_accession($female_parent_name);
 443
 444         if (!$female_parent) {
 445             print STDERR "Parent $female_parent_name in pedigree is not a stock\n";
 446             return;
 447         }
 448
 449     }  elsif ($cross_type eq "open") {
 450         $female_parent_name = $pedigree->get_female_parent()->get_name();
 451         $female_parent = $self->_get_accession($female_parent_name);
 452
 453         if (!$female_parent) {
 454             print STDERR "Parent $female_parent_name in pedigree is not a stock\n";
 455             return;
 456         }
 457     } elsif ($cross_type eq 'backcross') {
 458                 $female_parent_name = $pedigree->get_female_parent()->get_name();
 459                 $male_parent_name = $pedigree->get_male_parent()->get_name();
 460                 $female_parent = $self->_get_accession_or_cross($female_parent_name);
 461                 $male_parent = $self->_get_accession_or_cross($male_parent_name);
 462
 463
 464         if (!$female_parent || !$male_parent) {
 465             print STDERR "Parent $female_parent_name or $male_parent_name in pedigree is not a stock\n";
 466             return;
 467             }
 468
 469     }
 470
 471     #add support for other cross types here
 472
 473     #else {
 474     #  return;
 475     #}
 476
 477     return 1;
 478 }
 479
 480 sub _get_accession {
 481     my $self = shift;
 482     my $accession_name = shift;
 483     my $chado_schema = $self->get_chado_schema();
 484     my $stock_lookup = CXGN::Stock::StockLookup->new(schema => $chado_schema);
 485     my $stock;
 486     my $accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'accession', 'stock_type');
 487     #not sure why vector_construct is in this function
 488     my $vector_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'vector_construct', 'stock_type');
 489     my $population_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'population', 'stock_type');
 490
 491     $stock_lookup->set_stock_name($accession_name);
 492     $stock = $stock_lookup->get_stock_exact();
 493
 494     if (!$stock) {
 495         print STDERR "Parent name is not a stock\n";
 496         return;
 497     }
 498
 499         #not sure why vector_construct is in this function
 500     if (($stock->type_id() != $accession_cvterm->cvterm_id()) && ($stock->type_id() != $population_cvterm->cvterm_id())  && ($stock->type_id() != $vector_cvterm->cvterm_id()) ) {
 501         print STDERR "Parent name is not a stock of type accession or population or vector_construct\n";
 502         return;
 503     }
 504
 505     return $stock;
 506 }
 507
 508 sub _get_plot {
 509     my $self = shift;
 510     my $plot_name = shift;
 511     my $chado_schema = $self->get_chado_schema();
 512     my $stock_lookup = CXGN::Stock::StockLookup->new(schema => $chado_schema);
 513     my $stock;
 514     my $plot_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'plot', 'stock_type');
 515
 516     $stock_lookup->set_stock_name($plot_name);
 517     $stock = $stock_lookup->get_stock_exact();
 518
 519     if (!$stock) {
 520         print STDERR "Parent name is not a stock\n";
 521         return;
 522     }
 523
 524         if ($stock->type_id() != $plot_cvterm->cvterm_id()) {
 525         print STDERR "Parent name is not a stock of type plot\n";
 526         return;
 527     }
 528
 529     return $stock;
 530 }
 531
 532 sub _get_plant {
 533     my $self = shift;
 534     my $plant_name = shift;
 535     my $chado_schema = $self->get_chado_schema();
 536     my $stock_lookup = CXGN::Stock::StockLookup->new(schema => $chado_schema);
 537     my $stock;
 538     my $plant_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'plant', 'stock_type');
 539
 540     $stock_lookup->set_stock_name($plant_name);
 541     $stock = $stock_lookup->get_stock_exact();
 542
 543     if (!$stock) {
 544         print STDERR "Parent name is not a stock\n";
 545         return;
 546     }
 547
 548         if ($stock->type_id() != $plant_cvterm->cvterm_id()) {
 549         print STDERR "Parent name is not a stock of type plant\n";
 550         return;
 551     }
 552
 553     return $stock;
 554 }
 555
 556 sub _get_accession_or_cross {
 557     my $self = shift;
 558     my $parent_name = shift;
 559     my $chado_schema = $self->get_chado_schema();
 560     my $stock_lookup = CXGN::Stock::StockLookup->new(schema => $chado_schema);
 561     my $stock;
 562     my $accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'accession', 'stock_type');
 563         my $cross_cvterm = SGN::Model::Cvterm->get_cvterm_row($chado_schema, 'cross', 'stock_type');
 564
 565     $stock_lookup->set_stock_name($parent_name);
 566     $stock = $stock_lookup->get_stock_exact();
 567
 568     if (!$stock) {
 569         print STDERR "Parent name is not a stock\n";
 570         return;
 571     }
 572
 573     if (($stock->type_id() != $accession_cvterm->cvterm_id()) && ($stock->type_id() != $cross_cvterm->cvterm_id())) {
 574         print STDERR "Parent name is not a stock of type accession or cross \n";
 575         return;
 576     }
 577
 578     return $stock;
 579 }
 580
 581 #######
 582 1;
 583 #######