lib/CXGN/BrAPI/v2/Pedigree.pm

   1 package CXGN::BrAPI::v2::Pedigree;
   2
   3 use Moose;
   4 use Data::Dumper;
   5 use SGN::Model::Cvterm;
   6 use CXGN::Trial;
   7 use CXGN::Stock::Search;
   8 use CXGN::Stock;
   9 use CXGN::BrAPI::v2::ExternalReferences;
  10 use CXGN::Chado::Organism;
  11 use CXGN::BrAPI::Pagination;
  12 use CXGN::BrAPI::JSONResponse;
  13 use CXGN::Cross;
  14 use List::Util qw | uniq |;
  15 use Try::Tiny;
  16
  17 extends 'CXGN::BrAPI::v2::Common';
  18
  19 sub search {
  20     my $self = shift;
  21     my $params = shift;
  22     my $inputs = shift;
  23
  24     my $status = $self->status;
  25     my $page_size = $self->page_size;
  26     my $page = $self->page;
  27
  28     my $progeny_depth_counter = 0;
  29     my $pedigree_depth_counter = 0;
  30     my $stock_id_list;
  31
  32     my $stock_id  = $params->{germplasmDbId}->[0];
  33     my $pedigree_depth = $params->{pedigreeDepth}->[0] || 1;
  34     my $progeny_depth = $params->{progenyDepth}->[0] || 1;
  35     my $full_tree = $params->{includeFullTree}->[0] || 'false';
  36     my $include_parents = $params->{includeParents}->[0] || 'true';
  37     my $include_siblings = $params->{includeSiblings}->[0] || 'false';
  38     my $include_progeny = $params->{includeProgeny}->[0] || 'true';
  39
  40     if(lc $full_tree ne 'false'){
  41         $pedigree_depth = 5;
  42         $progeny_depth = 5;
  43     }
  44
  45     my $result = _get_tree($self, $stock_id,$progeny_depth_counter,$pedigree_depth_counter,$progeny_depth,$pedigree_depth,$include_parents,$include_siblings,$include_progeny,$stock_id_list);
  46
  47     my @data_files;
  48     my $data = {'data'=>$result};
  49     my $total_count = $result ? scalar @{$result} : 0;
  50     my $pagination = CXGN::BrAPI::Pagination->pagination_response($total_count,$page_size, $page);
  51     return CXGN::BrAPI::JSONResponse->return_success($data, $pagination, \@data_files, $status, 'Germplasm pedigree result constructed');
  52 }
  53
  54 sub _get_tree {
  55     my $self = shift;
  56     my $stock_id = shift;
  57     my $progeny_depth_counter = shift;
  58     my $pedigree_depth_counter = shift;
  59     my $progeny_depth = shift;
  60     my $pedigree_depth = shift;
  61     my $include_parents = shift;
  62     my $include_siblings = shift;
  63     my $include_progeny = shift;
  64     my $stock_id_list = shift;
  65     my $results = shift;
  66
  67     my %list = map { $_ => 1 } @$stock_id_list;
  68     next if(exists($list{$stock_id}));
  69     push @$stock_id_list, $stock_id;
  70
  71     my $result = _get_pedigree_progeny($self, $stock_id,$include_parents,$include_siblings,$include_progeny);
  72     if ($result) { push @$results, @$result; }
  73
  74     $progeny_depth_counter++;
  75     $pedigree_depth_counter++;
  76
  77     foreach my $germplasm (@$result){
  78         my %list = map { $_ => 1 } @$stock_id_list;
  79         my $tmp_list;
  80         if($progeny_depth_counter < $progeny_depth ){
  81             foreach my $progeny (@{$germplasm->{progeny}}){
  82                 next if(exists($list{$progeny->{germplasmDbId}}));
  83                 push @$tmp_list, $progeny->{germplasmDbId};
  84             }
  85         }
  86
  87         if($pedigree_depth_counter < $pedigree_depth){
  88             foreach my $parent (@{$germplasm->{parents}}){
  89                 next if(exists($list{$parent->{germplasmDbId}}));
  90                 push @$tmp_list, $parent->{germplasmDbId};
  91             }
  92         }
  93
  94         my @filtered = uniq(@$tmp_list);
  95
  96         foreach my $item (@filtered){
  97             next if(exists($list{$item}));
  98             _get_tree($self,$item,$progeny_depth_counter,$pedigree_depth_counter,$progeny_depth,$pedigree_depth,$include_parents,$include_siblings,$include_progeny,$stock_id_list, $results);
  99         }
 100     }
 101     return $results;
 102 }
 103
 104 sub _get_pedigree_progeny {
 105     my $self = shift;
 106     my $stock_id = shift;
 107     my $include_parents = shift;
 108     my $include_siblings = shift;
 109     my $include_progeny = shift;
 110     my $status = $self->status;
 111
 112     my $result;
 113
 114     my $pedigree=_germplasm_pedigree($self,$stock_id, $include_parents, $include_siblings);
 115
 116     my $progeny_value=[];
 117     if(lc $include_progeny eq 'true'){
 118         my $progeny=_germplasm_progeny($self, $stock_id);
 119         $progeny_value=$progeny->{progeny};
 120     }
 121
 122     if (keys(%$pedigree) > 0) {
 123         push @$result, {
 124             additionalInfo=>{},
 125             breedingMethodDbId=>undef,
 126             breedingMethodName=>undef,
 127
 128             crossingProjectDbId=>$pedigree->{crossingProjectDbId},
 129             crossingYear=>$pedigree->{crossingYear},
 130             familyCode=>$pedigree->{familyCode},
 131
 132             defaultDisplayName=>undef,
 133             externalReferences=>[],
 134             germplasmDbId=>$pedigree->{germplasmDbId},
 135             germplasmName=>$pedigree->{germplasmName},
 136             germplasmPUI=>$pedigree->{germplasmPUI},
 137             parents=>$include_parents eq 'true' ? $pedigree->{parents} : [],
 138             pedigreeString=>$pedigree->{pedigree},
 139             progeny=>$progeny_value,
 140             siblings=> $include_siblings eq 'true' ? $pedigree->{siblings} : [],
 141         };
 142     }
 143     return $result;
 144 }
 145
 146 sub _germplasm_pedigree {
 147     my $self = shift;
 148     my $stock_id = shift;
 149     my $include_parents = shift;
 150     my $include_siblings = shift;
 151     my $status = $self->status;
 152
 153     my $direct_descendant_ids;
 154     my %result;
 155     my $total_count = 0;
 156     my @data_files;
 157
 158     push @$direct_descendant_ids, $stock_id; #excluded in parent retrieval to prevent loops
 159     my $accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'accession', 'stock_type')->cvterm_id();
 160     my $vector_construct_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'vector_construct', 'stock_type')->cvterm_id();
 161
 162     my $stock = $self->bcs_schema->resultset("Stock::Stock")->find({stock_id => $stock_id});
 163
 164     if ($stock) {
 165         $total_count = 1;
 166         my $stock_uniquename = $stock->uniquename();
 167         my $stock_type = $stock->type_id();
 168         if( $stock_type == $accession_cvterm || $stock_type == $vector_construct_cvterm){
 169
 170         my $mother;
 171         my $father;
 172
 173         ## Get parents relationships
 174         my $cvterm_female_parent = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'female_parent', 'stock_relationship')->cvterm_id();
 175         my $cvterm_male_parent = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'male_parent', 'stock_relationship')->cvterm_id();
 176         #get the stock relationships for the stock
 177         my $female_parent_stock_id;
 178         my $male_parent_stock_id;
 179
 180         my $stock_relationships = $stock->search_related("stock_relationship_objects",undef,{ prefetch => ['type','subject'] });
 181
 182         my $female_parent_relationship = $stock_relationships->find({type_id => $cvterm_female_parent, subject_id => {'not_in' => $direct_descendant_ids}});
 183         if ($female_parent_relationship) {
 184             $female_parent_stock_id = $female_parent_relationship->subject_id();
 185             $mother = $self->bcs_schema->resultset("Stock::Stock")->find({stock_id => $female_parent_stock_id})->uniquename();
 186         }
 187         my $male_parent_relationship = $stock_relationships->find({type_id => $cvterm_male_parent, subject_id => {'not_in' => $direct_descendant_ids}});
 188         if ($male_parent_relationship) {
 189             $male_parent_stock_id = $male_parent_relationship->subject_id();
 190             $father = $self->bcs_schema->resultset("Stock::Stock")->find({stock_id => $male_parent_stock_id})->uniquename();
 191         }
 192
 193         ##Get sibblings
 194         my @siblings = ();
 195         if($include_siblings eq 'true'){
 196             my $q = "SELECT DISTINCT female_parent.stock_id, female_parent.uniquename, male_parent.stock_id, male_parent.uniquename, progeny.stock_id, progeny.uniquename, stock_relationship1.value
 197                 FROM stock_relationship as stock_relationship1
 198                 INNER JOIN stock AS female_parent ON (stock_relationship1.subject_id = female_parent.stock_id) AND stock_relationship1.type_id = ?
 199                 INNER JOIN stock AS progeny ON (stock_relationship1.object_id = progeny.stock_id) AND ( progeny.type_id = ? OR progeny.type_id= ? )
 200                 LEFT JOIN stock_relationship AS stock_relationship2 ON (progeny.stock_id = stock_relationship2.object_id) AND stock_relationship2.type_id = ?
 201                 LEFT JOIN stock AS male_parent ON (stock_relationship2.subject_id = male_parent.stock_id) ";
 202
 203             my $h;
 204
 205             if($female_parent_stock_id && $male_parent_stock_id){
 206                 $q = $q . "WHERE female_parent.stock_id = ? AND male_parent.stock_id = ?";
 207                 $h = $self->bcs_schema()->storage->dbh()->prepare($q);
 208                 $h->execute($cvterm_female_parent, $accession_cvterm, $vector_construct_cvterm, $cvterm_male_parent, $female_parent_stock_id, $male_parent_stock_id);
 209             }
 210             elsif ($female_parent_stock_id) {
 211                 $q = $q . "WHERE female_parent.stock_id = ? ORDER BY male_parent.stock_id";
 212                 $h = $self->bcs_schema()->storage->dbh()->prepare($q);
 213                 $h->execute($cvterm_female_parent, $accession_cvterm, $vector_construct_cvterm, $cvterm_male_parent, $female_parent_stock_id);
 214             }
 215             elsif ($male_parent_stock_id) {
 216                 $q = $q . "WHERE male_parent.stock_id = ? ORDER BY female_parent.stock_id";
 217                 $h = $self->bcs_schema()->storage->dbh()->prepare($q);
 218                 $h->execute($cvterm_female_parent, $accession_cvterm, $vector_construct_cvterm, $cvterm_male_parent, $male_parent_stock_id);
 219             }
 220             else {
 221                 $h = $self->bcs_schema()->storage->dbh()->prepare($q);
 222                 $h->execute($cvterm_female_parent, $accession_cvterm, $vector_construct_cvterm, $cvterm_male_parent);
 223             }
 224
 225
 226             my $cross_plan;
 227
 228             while (my($female_parent_id, $female_parent_name, $male_parent_id, $male_parent_name, $progeny_id, $progeny_name, $cross_type) = $h->fetchrow_array()){
 229                 if ($progeny_id ne $stock_id){
 230                     push @siblings, {
 231                         germplasmDbId => qq|$progeny_id|,
 232                         germplasmName => $progeny_name
 233                     };
 234                 }
 235                 $cross_plan = $cross_type;
 236             }
 237         }
 238
 239         #Cross information
 240         my @membership_info = ();
 241         my $cross_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'cross', 'stock_type')->cvterm_id();
 242
 243         if ($stock_type eq $cross_cvterm){
 244
 245             my $cross_member_of_type_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, "cross_member_of", "stock_relationship")->cvterm_id();
 246             my $cross_experiment_type_id =  SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'cross_experiment', 'experiment_type')->cvterm_id();
 247             my $family_name_type_id = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, "family_name", "stock_type")->cvterm_id();
 248             my $project_year_cvterm_id =  SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'project year', 'project_property')->cvterm_id();
 249
 250             my $q = "SELECT project.project_id, project.name, project.description, stock.stock_id, stock.uniquename, year.value
 251                 FROM nd_experiment_stock
 252                 JOIN nd_experiment ON (nd_experiment_stock.nd_experiment_id = nd_experiment.nd_experiment_id) AND nd_experiment.type_id = ?
 253                 JOIN nd_experiment_project ON (nd_experiment_project.nd_experiment_id = nd_experiment.nd_experiment_id)
 254                 JOIN project ON (nd_experiment_project.project_id = project.project_id)
 255                 LEFT JOIN projectprop AS year ON (project.project_id=year.project_id)
 256                 LEFT JOIN stock_relationship ON (nd_experiment_stock.stock_id = stock_relationship.subject_id) AND stock_relationship.type_id = ?
 257                 LEFT JOIN stock ON (stock_relationship.object_id = stock.stock_id) AND stock.type_id = ?
 258                 WHERE nd_experiment_stock.stock_id = ? AND year.type_id = ?";
 259
 260             my $h = $self->bcs_schema->storage->dbh()->prepare($q);
 261             $h->execute($cross_experiment_type_id, $cross_member_of_type_id, $family_name_type_id, $stock_id, $project_year_cvterm_id);
 262
 263
 264             while (my ($crossing_experiment_id, $crossing_experiment_name, $description, $family_id, $family_name, $year) = $h->fetchrow_array()){
 265                 push @membership_info, [$crossing_experiment_id, $crossing_experiment_name, $description, $family_id, $family_name, $year]
 266             }
 267         }
 268
 269         #Add parents:
 270         my $parent = [];
 271         if($include_parents eq 'true'){
 272             if ($female_parent_stock_id){
 273                 push @$parent, {
 274                     germplasmDbId=>$female_parent_stock_id ? qq|$female_parent_stock_id| : $female_parent_stock_id ,
 275                     germplasmName=>$mother,
 276                     parentType=>'FEMALE',
 277                 };
 278             }
 279             if ($male_parent_stock_id){
 280                 push @$parent, {
 281                     germplasmDbId=>$male_parent_stock_id ? qq|$male_parent_stock_id| : $male_parent_stock_id,
 282                     germplasmName=>$father,
 283                     parentType=>'MALE',
 284                 }
 285
 286             }
 287         }
 288
 289         %result = (
 290             crossingProjectDbId=>$membership_info[0][0],
 291             crossingYear=>$membership_info[0][5],
 292             familyCode=>$membership_info[0][4],
 293             germplasmDbId=>qq|$stock_id|,
 294             germplasmName=>$stock_uniquename,
 295             parents=>$parent,
 296             pedigree=>"$mother/$father",
 297             siblings=>\@siblings
 298         );
 299     }
 300     }
 301
 302     return \%result;
 303 }
 304
 305 sub _germplasm_progeny {
 306     my $self = shift;
 307     my $stock_id = shift;
 308     my $page_size = $self->page_size;
 309     my $page = $self->page;
 310     my $status = $self->status;
 311
 312     my $mother_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'female_parent', 'stock_relationship')->cvterm_id();
 313     my $father_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'male_parent', 'stock_relationship')->cvterm_id();
 314     my $accession_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'accession', 'stock_type')->cvterm_id();my $vector_construct_cvterm = SGN::Model::Cvterm->get_cvterm_row($self->bcs_schema, 'vector_construct', 'stock_type')->cvterm_id();
 315
 316     my $result;
 317
 318     my $stock = $self->bcs_schema()->resultset("Stock::Stock")->find({
 319         'type_id'=> [ $accession_cvterm, $vector_construct_cvterm ],
 320         'stock_id'=> $stock_id,
 321     });
 322     if ($stock){
 323         my $edges = $self->bcs_schema()->resultset("Stock::StockRelationship")->search(
 324             [
 325                 {
 326                     'me.subject_id' => $stock_id,
 327                     'me.type_id' => $father_cvterm,
 328                     'object.type_id'=> $accession_cvterm
 329                 },
 330                 {
 331                     'me.subject_id' => $stock_id,
 332                     'me.type_id' => $mother_cvterm,
 333                     'object.type_id'=> $accession_cvterm
 334                 }
 335             ],
 336             {
 337                 join => 'object',
 338                 '+select' => ['object.uniquename'],
 339                 '+as' => ['progeny_uniquename']
 340             }
 341         );
 342         my $full_data = [];
 343         while (my $edge = $edges->next) {
 344             if ($edge->type_id==$mother_cvterm){
 345                 push @{$full_data}, {
 346                     germplasmDbId => "". $edge->object_id,
 347                     germplasmName => $edge->get_column('progeny_uniquename'),
 348                     parentType => "FEMALE"
 349                 };
 350             } else {
 351                 push @{$full_data}, {
 352                     germplasmDbId => "". $edge->object_id,
 353                     germplasmName => $edge->get_column('progeny_uniquename'),
 354                     parentType => "MALE"
 355                 };
 356             }
 357         }
 358         my $total_count = scalar @{$full_data};
 359         my $last_item = $page_size*($page+1)-1;
 360         if($last_item > $total_count-1){
 361             $last_item = $total_count-1;
 362         }
 363
 364         $result = {
 365             germplasmName=>$stock->uniquename,
 366             germplasmDbId=>$stock_id,
 367             progeny=>[@{$full_data}],
 368         };
 369
 370     }
 371     return $result;
 372 }
 373
 374
 375 1;