lib/SGN/Controller/AJAX/BreedingProgram.pm

   1
   2 =head1 NAME
   3
   4 SGN::Controller::AJAX::BreedingProgram
   5  REST controller for viewing breeding programs and the data associated with them
   6
   7 =head1 DESCRIPTION
   8
   9
  10 =head1 AUTHOR
  11
  12 Naama Menda <nm249@cornell.edu>
  13
  14
  15 =cut
  16
  17 package SGN::Controller::AJAX::BreedingProgram;
  18
  19 use Moose;
  20
  21 BEGIN { extends 'Catalyst::Controller::REST' };
  22
  23 use List::MoreUtils qw | any all |;
  24 use JSON::Any;
  25 use Data::Dumper;
  26 use Try::Tiny;
  27 use Math::Round;
  28 use CXGN::BreedingProgram;
  29 use CXGN::Phenotypes::PhenotypeMatrix;
  30
  31 __PACKAGE__->config(
  32     default   => 'application/json',
  33     stash_key => 'rest',
  34     map       => { 'application/json' => 'JSON', 'text/html' => 'JSON' },
  35     );
  36
  37
  38 =head2 action program_trials()
  39
  40   Usage:        /breeders/program/<program_id>/datatables/trials
  41   Desc:         retrieves trials associated with the breeding program
  42   Ret:          a table in json suitable for datatables
  43   Args:
  44     Side Effects:
  45   Example:
  46
  47 =cut
  48
  49
  50 sub ajax_breeding_program : Chained('/')  PathPart('ajax/breeders/program')  CaptureArgs(1) {
  51     my ($self, $c, $program_id) = @_;
  52
  53     my $schema = $c->dbic_schema('Bio::Chado::Schema', 'sgn_chado');
  54     my $program = CXGN::BreedingProgram->new( { schema=> $schema , program_id => $program_id } );
  55
  56     $c->stash->{schema} = $schema;
  57     $c->stash->{program} = $program;
  58
  59 }
  60
  61
  62
  63
  64 sub program_trials :Chained('ajax_breeding_program') PathPart('trials') Args(0) {
  65     my $self = shift;
  66     my $c = shift;
  67     my $program = $c->stash->{program};
  68
  69     my $trials = $program->get_trials();
  70
  71     my @formatted_trials;
  72     while (my $trial = $trials->next ) {
  73
  74         my $name = $trial->name;
  75         my $id = $trial->project_id;
  76         my $description = $trial->description;
  77         push @formatted_trials, [ '<a href="/breeders/trial/'.$id.'">'.$name.'</a>', $description ];
  78     }
  79     $c->stash->{rest} = { data => \@formatted_trials };
  80 }
  81
  82
  83 sub phenotype_summary : Chained('ajax_breeding_program') PathPart('phenotypes') Args(0) {
  84     my $self = shift;
  85     my $c = shift;
  86     my $program = $c->stash->{program};
  87     my $program_id = $program->get_program_id;
  88     my $schema = $c->stash->{schema};
  89     my $round = Math::Round::Var->new(0.01);
  90     my $dbh = $c->dbc->dbh();
  91
  92     my $trials = $program->get_trials;
  93     my @trial_ids;
  94     while (my $trial = $trials->next() ) {
  95         my $trial_id = $trial->project_id;
  96         push @trial_ids , $trial_id;
  97     }
  98     my $trial_ids = join ',', map { "?" } @trial_ids;
  99     my @phenotype_data;
 100     my @trait_list;
 101
 102     if ( $trial_ids ) {
 103         my $h = $dbh->prepare("SELECT (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text) || dbxref.accession::text AS trait,
 104         cvterm.cvterm_id,
 105         count(phenotype.value),
 106         to_char(avg(phenotype.value::real), 'FM999990.990'),
 107         to_char(max(phenotype.value::real), 'FM999990.990'),
 108         to_char(min(phenotype.value::real), 'FM999990.990'),
 109         to_char(stddev(phenotype.value::real), 'FM999990.990')
 110
 111         FROM cvterm
 112             JOIN phenotype ON (cvterm_id=cvalue_id)
 113             JOIN nd_experiment_phenotype USING(phenotype_id)
 114             JOIN nd_experiment_project USING(nd_experiment_id)
 115             JOIN nd_experiment_stock USING(nd_experiment_id)
 116             JOIN stock as plot USING(stock_id)
 117             JOIN stock_relationship on (plot.stock_id = stock_relationship.subject_id)
 118             JOIN stock as accession on (accession.stock_id = stock_relationship.object_id)
 119             JOIN dbxref ON cvterm.dbxref_id = dbxref.dbxref_id JOIN db ON dbxref.db_id = db.db_id
 120         WHERE project_id IN ( $trial_ids )
 121             AND phenotype.value~?
 122
 123         GROUP BY (((cvterm.name::text || '|'::text) || db.name::text) || ':'::text) || dbxref.accession::text, cvterm.cvterm_id
 124         ORDER BY cvterm.name ASC
 125        ;");
 126
 127         my $numeric_regex = '^[0-9]+([,.][0-9]+)?$';
 128         $h->execute( @trial_ids , $numeric_regex);
 129
 130         while (my ($trait, $trait_id, $count, $average, $max, $min, $stddev) = $h->fetchrow_array()) {
 131             push @trait_list, [$trait_id, $trait];
 132             my $cv = 0;
 133             if ($stddev && $average != 0) {
 134                 $cv = ($stddev /  $average) * 100;
 135                 $cv = $round->round($cv) . '%';
 136             }
 137             if ($average) { $average = $round->round($average); }
 138             if ($min) { $min = $round->round($min); }
 139             if ($max) { $max = $round->round($max); }
 140             if ($stddev) { $stddev = $round->round($stddev); }
 141
 142             my @return_array;
 143
 144
 145             push @return_array, ( qq{<a href="/cvterm/$trait_id/view">$trait</a>}, $average, $min, $max, $stddev, $cv, $count, qq{<a href="#raw_data_histogram_well" onclick="trait_summary_hist_change($program_id, $trait_id)"><span class="glyphicon glyphicon-stats"></span></a>} );
 146             push @phenotype_data, \@return_array;
 147         }
 148     }
 149     $c->stash->{trait_list} = \@trait_list;
 150     $c->stash->{rest} = { data => \@phenotype_data };
 151 }
 152
 153
 154 sub traits_assayed : Chained('ajax_breeding_program') PathPart('traits_assayed') Args(0) {
 155     my $self = shift;
 156     my $c = shift;
 157     my $program = $c->stash->{program};
 158     my @traits_assayed  =  $program->get_traits_assayed;
 159     $c->stash->{rest} = { traits_assayed => \@traits_assayed };
 160 }
 161
 162 sub trait_phenotypes : Chained('ajax_breeding_program') PathPart('trait_phenotypes') Args(0) {
 163     my $self = shift;
 164     my $c = shift;
 165     my $program = $c->stash->{program};
 166     #get userinfo from db
 167     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 168     #my $user = $c->user();
 169     #if (! $c->user) {
 170     #  $c->stash->{rest} = {
 171     #    status => "not logged in"
 172     #  };
 173     #  return;
 174     #}
 175     my $display = $c->req->param('display') || 'plot' ;
 176     my $trials = $program->get_trials;
 177     my @trial_ids;
 178     while (my $trial = $trials->next() ) {
 179         my $trial_id = $trial->project_id;
 180         push @trial_ids , $trial_id;
 181     }
 182     my $trait = $c->req->param('trait');
 183     my $phenotypes_search = CXGN::Phenotypes::PhenotypeMatrix->new(
 184         bcs_schema=> $schema,
 185         search_type => "MaterializedViewTable",
 186         data_level => $display,
 187         trait_list=> [$trait],
 188         trial_list => \@trial_ids
 189     );
 190     my @data = $phenotypes_search->get_phenotype_matrix();
 191     $c->stash->{rest} = {
 192       status => "success",
 193       data => \@data
 194    };
 195 }
 196
 197
 198 sub accessions : Chained('ajax_breeding_program') PathPart('accessions') Args(0) {
 199     my ($self, $c) = @_;
 200     my $program = $c->stash->{program};
 201     my $accessions = $program->get_accessions;
 202     my $schema = $c->dbic_schema("Bio::Chado::Schema");
 203     my @formatted_accessions;
 204
 205     foreach my $id ( @$accessions ) {
 206         my $acc =  my $row = $schema->resultset("Stock::Stock")->find(
 207             { stock_id => $id , }
 208             );
 209
 210         my $name        = $acc->uniquename;
 211         my $description = $acc->description;
 212         push @formatted_accessions, [ '<a href="/stock/' .$id. '/view">'.$name.'</a>', $description ];
 213     }
 214     $c->stash->{rest} = { data => \@formatted_accessions };
 215 }
 216
 217 1;
 218
 219