lib/CXGN/BreedingProgram.pm

   1 =head1 NAME
   2
   3 CXGN::BreedingProgram - class for retrieving breeding program information and filtering by location/s, year/s, etc.
   4
   5 =head1 AUTHORS
   6
   7 Naama Menda <nm249@cornell.edu>
   8
   9
  10 =head1 METHODS
  11
  12 =cut
  13
  14 package CXGN::BreedingProgram;
  15
  16 use Moose;
  17 use Data::Dumper;
  18 use Try::Tiny;
  19 use SGN::Model::Cvterm;
  20 use CXGN::BreedersToolbox::Projects;
  21 use JSON;
  22
  23 has 'schema' => (
  24     isa => 'Bio::Chado::Schema',
  25     is => 'rw',
  26     required => 1,
  27 );
  28
  29 sub BUILD {
  30     my $self = shift;
  31     my $breeding_program_cvterm_id = $self->get_breeding_program_cvterm_id;
  32     my $row = $self->schema->resultset("Project::Project")->find(
  33         { project_id             => $self->get_program_id(),
  34           'projectprops.type_id' => $breeding_program_cvterm_id },
  35         { join => 'projectprops' }
  36         );
  37     $self->set_project_object($row);
  38     if (!$row) {
  39         die "The breeding program  ".$self->get_program_id()." does not exist";
  40     }
  41 }
  42
  43 =head2 accessors get_program_id()
  44
  45  Desc: get the breeding program project_id
  46
  47 =cut
  48
  49 has 'program_id' => (isa => 'Int',
  50                      is => 'rw',
  51                      reader => 'get_program_id',
  52                      writer => 'set_program_id',
  53     );
  54
  55
  56
  57 =head2 accessors get_name, set_name
  58
  59  Usage:
  60  Desc:
  61  Property
  62  Side Effects:
  63  Example:
  64
  65 =cut
  66
  67 sub get_name {
  68     my $self = shift;
  69     my $project_obj = $self->get_project_object;
  70
  71     if ($project_obj) {
  72         return $project_obj->name();
  73     }
  74 }
  75
  76 sub set_name {
  77     my $self = shift;
  78     my $name = shift;
  79     my $project_obj = $self->get_project_object;
  80     if ($project_obj) {
  81         $project_obj->name($name);
  82         $project_obj->update();
  83     }
  84 }
  85
  86 sub get_project_object {
  87   my $self = shift;
  88   return $self->{project_object};
  89 }
  90
  91 sub set_project_object {
  92   my $self = shift;
  93   $self->{project_object} = shift;
  94 }
  95
  96
  97 =head2 accessors get_description, set_description
  98
  99  Usage:
 100  Desc:
 101  Property
 102  Side Effects:
 103  Example:
 104
 105 =cut
 106
 107 sub get_description {
 108   my $self = shift;
 109   return $self->{description};
 110 }
 111
 112 sub set_description {
 113   my $self = shift;
 114   $self->{description} = shift;
 115 }
 116
 117
 118 sub get_breeding_program_cvterm_id {
 119     my $self = shift;
 120
 121     my $breeding_program_cvterm_id;
 122     my $breeding_program_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'breeding_program', 'project_property');
 123     if ($breeding_program_cvterm) {
 124         $breeding_program_cvterm_id = $breeding_program_cvterm->cvterm_id();
 125     }
 126     return $breeding_program_cvterm_id;
 127 }
 128
 129 sub get_project_year_cvterm_id {
 130     my $self = shift;
 131     my $year_cvterm_row = SGN::Model::Cvterm->get_cvterm_row( $self->schema, 'project year', 'project_property' );
 132     return $year_cvterm_row->cvterm_id();
 133 }
 134
 135 sub get_accession_cvterm_id {
 136     my $self = shift;
 137     my $accession_cvterm_row = SGN::Model::Cvterm->get_cvterm_row( $self->schema, 'accession', 'stock_type' );
 138     return $accession_cvterm_row->cvterm_id();
 139 }
 140 =head2 get_trials
 141
 142  Usage: $self->get_trials
 143  Desc:  find the trials (projects) associated with the breeding program. Will fetch only trials that have a design. This is to avoid printing crosses etc.
 144  Ret:   BCS Project resultset
 145  Args:  none
 146  Side Effects: none
 147  Example:
 148
 149 =cut
 150
 151 sub get_trials {
 152     my $self = shift;
 153     my $project_obj = $self->get_project_object;
 154
 155     my $trials_rs;
 156     my $trials_fetched;
 157     my $trial_rel_rs = $project_obj->project_relationship_object_projects;
 158
 159     if ($trial_rel_rs) {
 160         my $design_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->schema, 'design', 'project_property');
 161         $trials_rs = $trial_rel_rs->search_related('subject_project');
 162         $trials_fetched = $trials_rs->search(
 163             {
 164                 'projectprops.type_id' => $design_cvterm->cvterm_id
 165             },
 166             {
 167                 join => 'projectprops'
 168             }
 169             );
 170     }
 171     return $trials_fetched;
 172 }
 173
 174
 175 =head2 function get_traits_assayed()
 176  Usage:
 177  Desc: Find the traits assayed in the breeding program
 178  Ret:  arrayref of [cvterm_id, cvterm_name]
 179  Args:
 180  Side Effects:
 181  Example:
 182
 183 =cut
 184 sub get_traits_assayed {
 185     my $self= shift;
 186     my $dbh = $self->schema->storage()->dbh();
 187
 188     my $trials = $self->get_trials;
 189     my @trial_ids;
 190     while (my $trial = $trials->next() ) {
 191         my $trial_id = $trial->project_id;
 192         push @trial_ids , $trial_id;
 193     }
 194     my $trial_ids = join ',', map { "?" } @trial_ids;
 195     my @traits_assayed;
 196
 197     my $q;
 198     if ($trial_ids) {
 199         $q = "SELECT (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text) || dbxref.accession::text AS trait, cvterm.cvterm_id, count(phenotype.value) FROM cvterm JOIN dbxref ON cvterm.dbxref_id = dbxref.dbxref_id JOIN db ON dbxref.db_id = db.db_id JOIN phenotype ON (cvterm_id=cvalue_id) JOIN nd_experiment_phenotype USING(phenotype_id) JOIN nd_experiment_project USING(nd_experiment_id) WHERE project_id in ( $trial_ids )  and phenotype.value~? GROUP BY trait, cvterm.cvterm_id ORDER BY trait;";
 200
 201
 202         my $traits_assayed_q = $dbh->prepare($q);
 203
 204         my $numeric_regex = '^-?[0-9]+([,.][0-9]+)?$';
 205         $traits_assayed_q->execute(@trial_ids, $numeric_regex );
 206         while (my ($trait_name, $trait_id, $count) = $traits_assayed_q->fetchrow_array()) {
 207             push @traits_assayed, [$trait_id, $trait_name];
 208         }
 209     }
 210     return \@traits_assayed;
 211 }
 212
 213 =head2 get_locations
 214
 215  Usage: my $locations = $breeding_program->get_locations()
 216  Desc:  find nd_geolocations by breeding program
 217  Ret:   NdGeolocation resultset
 218  Args:  none
 219  Side Effects: calls get_trials
 220  Example:
 221
 222 =cut
 223
 224 sub get_locations {
 225     my $self = shift;
 226     my $trials = $self->get_trials();
 227     my $nd_exp_projects = $trials->nd_experiment_projects;
 228     my $locations;
 229
 230     if ( $nd_exp_projects ) {
 231         $locations = $nd_exp_projects->nd_experiment->nd_geolocation;
 232     }
 233     return $locations
 234 }
 235
 236
 237 =head2 get_years
 238
 239  Usage:
 240  Desc:
 241  Ret: arrayref of project year values from projectprop
 242  Args:
 243  Side Effects: calls $self->get_trials
 244  Example:
 245
 246 =cut
 247
 248 sub get_years {
 249     my $self = shift;
 250     my $trials = $self->get_trials();
 251     my $project_year_cvterm_id = $self->get_project_year_cvterm_id;
 252     my $trialprops_rs = $trials->projectprops->search( { type_id=>$project_year_cvterm_id }, { distinct => 1, } );
 253     my @years = $trialprops_rs->value;
 254     return \@years;
 255 }
 256
 257 =head2 get_accessions
 258
 259  Usage: $self->get_accessions
 260  Desc:
 261  Ret: list of stock IDs
 262  Args:
 263  Side Effects:
 264  Example:
 265
 266 =cut
 267
 268 sub get_accessions {
 269     my $self = shift;
 270     my $program_id = $self->get_program_id;
 271     my $dbh = $self->schema->storage()->dbh();
 272
 273     my $q = "SELECT distinct acc.stock_id, acc.uniquename FROM stock AS acc
 274              JOIN  stock_relationship ON object_id = acc.stock_id
 275              JOIN  stock AS plot ON plot.stock_id = stock_relationship.subject_id
 276              JOIN nd_experiment_stock ON nd_experiment_stock.stock_id = plot.stock_id
 277              JOIN nd_experiment_project using (nd_experiment_id)
 278              JOIN project trial ON trial.project_id = nd_experiment_project.project_id
 279              JOIN project_relationship ON project_relationship.subject_project_id = trial.project_id
 280              JOIN project program ON program.project_id = project_relationship.object_project_id
 281              WHERE program.project_id = ? AND acc.type_id = ?;";
 282     $q = $dbh->prepare($q);
 283     $q->execute($program_id, $self->get_accession_cvterm_id);
 284
 285     my @accessions;
 286     while (my ( $acc_id, $acc_name ) = $q->fetchrow_array()) {
 287         push @accessions,  $acc_id;
 288     }
 289     return \@accessions;
 290 }
 291
 292 =head2 get_locations_with_details
 293
 294  Usage: my $locations = $breeding_program->get_locations_with_details()
 295
 296 =cut
 297
 298 sub get_locations_with_details {
 299     my $self = shift;
 300     my $schema = $self->schema;
 301     my $project_obj = $self->get_project_object;
 302     my $program_name = $project_obj->name;
 303 #    print STDERR "PROGRAM NAME =".Dumper($program_name)."\n";
 304     my $obj = CXGN::BreedersToolbox::Projects->new({schema => $schema});
 305     my $all_locations = decode_json $obj->get_location_geojson();
 306
 307     my @program_locations;
 308     foreach my $location_hash (@$all_locations) {
 309         my $location = $location_hash->{'properties'};
 310         my $name = $location->{'Program'};
 311         if ($name eq $program_name) {
 312             push @program_locations, $location_hash;
 313         }
 314     }
 315
 316     my $json = JSON->new();
 317     $json->canonical(); # output sorted JSON
 318     return $json->encode(\@program_locations);
 319 }
 320
 321
 322 =head2 get_crosses
 323
 324  Usage: $self->get_crosses
 325  Desc:
 326  Ret: crosses with parents
 327  Args:
 328  Side Effects:
 329  Example:
 330
 331 =cut
 332
 333 sub get_crosses {
 334     my $self = shift;
 335     my $program_id = $self->get_program_id;
 336     my $schema = $self->schema;
 337     my $dbh = $self->schema->storage()->dbh();
 338     my $cross_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'cross', 'stock_type')->cvterm_id();
 339     my $female_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'female_parent', 'stock_relationship')->cvterm_id();
 340     my $male_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'male_parent', 'stock_relationship')->cvterm_id();
 341
 342     my $q = "select stock.stock_id, stock.uniquename, female.stock_id, female.uniquename, male.stock_id, male.uniquename, stock_relationship1.value
 343         From stock join stock_relationship as stock_relationship1 on (stock.stock_id = stock_relationship1.object_id) and stock_relationship1.type_id = ?
 344         JOIN stock as female on (stock_relationship1.subject_id = female.stock_id)
 345         LEFT JOIN stock_relationship as stock_relationship2 on (stock.stock_id = stock_relationship2.object_id) and stock_relationship2.type_id = ?
 346         LEFT JOIN stock as male on (stock_relationship2.subject_id = male.stock_id)
 347         LEFT JOIN nd_experiment_stock on (stock.stock_id = nd_experiment_stock.stock_id)
 348         LEFT JOIN nd_experiment_project on (nd_experiment_stock.nd_experiment_id = nd_experiment_project.nd_experiment_id)
 349         LEFT JOIN project_relationship on (project_relationship.subject_project_id = nd_experiment_project.project_id)  where stock.type_id = ? and project_relationship.object_project_id = ?;";
 350
 351     my $h = $schema->storage->dbh()->prepare($q);
 352     $h->execute($female_cvterm_id, $male_cvterm_id, $cross_cvterm_id, $program_id);
 353
 354     my @crosses = ();
 355     while (my($cross_id, $cross_name, $female_parent_id, $female_parent_name, $male_parent_id, $male_parent_name, $cross_type) = $h->fetchrow_array()){
 356         push @crosses, [$cross_id, $cross_name, $female_parent_id, $female_parent_name, $male_parent_id, $male_parent_name, $cross_type]
 357     }
 358
 359     return \@crosses;
 360
 361 }
 362
 363
 364 =head2 get_seedlots
 365
 366  Usage: $self->get_seedlots
 367  Desc:
 368  Ret: seedlot with content
 369  Args:
 370  Side Effects:
 371  Example:
 372
 373 =cut
 374
 375 sub get_seedlots {
 376     my $self = shift;
 377     my $program_id = $self->get_program_id;
 378     my $schema = $self->schema;
 379     my $dbh = $self->schema->storage()->dbh();
 380     my $seedlot_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'seedlot', 'stock_type')->cvterm_id();
 381     my $collection_of_cvterm_id = SGN::Model::Cvterm->get_cvterm_row($schema, 'collection_of', 'stock_relationship')->cvterm_id();
 382
 383     my $q = "select stock.stock_id, stock.uniquename, content.stock_id, content.uniquename, cvterm.name
 384         From stock join stock_relationship on (stock.stock_id = stock_relationship.object_id) and stock_relationship.type_id = ?
 385         JOIN stock as content on (stock_relationship.subject_id = content.stock_id)
 386         JOIN cvterm on (content.type_id = cvterm.cvterm_id)
 387         JOIN nd_experiment_stock on (stock.stock_id = nd_experiment_stock.stock_id)
 388         JOIN nd_experiment_project on (nd_experiment_stock.nd_experiment_id = nd_experiment_project.nd_experiment_id)
 389         where stock.type_id = ? and nd_experiment_project.project_id = ?;";
 390
 391     my $h = $schema->storage->dbh()->prepare($q);
 392     $h->execute($collection_of_cvterm_id, $seedlot_cvterm_id, $program_id);
 393
 394     my @seedlots = ();
 395     while (my($seedlot_id, $seedlot_name, $content_id, $content_name, $content_type) = $h->fetchrow_array()){
 396         push @seedlots, [$seedlot_id, $seedlot_name, $content_id, $content_name, $content_type]
 397     }
 398
 399     return \@seedlots;
 400
 401 }
 402
 403
 404
 405
 406 ####
 407 1;##
 408 ####