new pheno download tests pass
[sgn.git] / mason / phenotypes / phenotype_data.mas
blob770e41ba53b78d14907e19feae986f254b2fb0aa
2 <%doc>
4 =head1 NAME
6 /phenotypes/phenotype_data.mas - a component for printing table with stats of a phenotype object
8 =head1 DESCRIPTION
11 Parameters:
13 =over 4
15 =item phenotypes
17 arrayref of L<Bio::Chado::Schema::Phenotype> objects
19 =item div
21 div id (for using with javascript)
23 =item has_qtl
25 applies to qtl populations. Used for adding a link to the qtl page
27 =item object_id
29 the database id of the object with associated phenotyeps
32 =back
34 =head1 AUTHOR
36 Naama Menda <nm249@cornell.edu>
38 =cut
40 </%doc>
42 <%args>
43     $phenotypes=>undef
44     $div=> ''
45     $has_qtl => undef
46     $object_id => undef
47 </%args>
49 <%once>
50 use CXGN::Page::FormattingHelpers qw/ tooltipped_text columnar_table_html /;
52 use Statistics::Descriptive;
53 use Scalar::Util qw(looks_like_number);
55 </%once>
57 <%perl>
59 my %data;
60 my @qual_data;
61 my %info; # hash of term names, since we can have multiple phenotypes of the same term
62 my $graph_icon = qq |<img src="/documents/img/pop_graph.png"/> |;
64 ####
65 if ($phenotypes) { ###  && UNIVERSAL::isa($phenotypes,"UNIVERSAL"))  { 
66 foreach my $phenotype (@$phenotypes) {
67   ###while ( my $phenotype = $phenotypes->next ) { 
68    #$phenotype is a list of row objects with the following column values
69    # qw/ stock_id value observable observable_id definition method_name type_name  accession db_name project_description cv_name unit_name ##  
70   
71   #first make sure phenotype_cvterm is a unit.ontology# Not sure this is necessary, since all we have (now) in phenotype_cvterm is units
72   ##### if $phenotype->get_column('cv_name') ne 'unit.ontology' || undef ;    
73   my $unit_name = $phenotype->get_column('unit_name');
74   my $type_name = $phenotype->get_column('type_name');
75   my $method_name;
76   if ($type_name eq 'method') {
77      $method_name = $phenotype->get_column('method_name');
78   } elsif ( !$type_name ) {
79      $method_name =  'Trait' ;
80   } else { next; } #skip the row if a phenotypeprop was fetched , but it is not a 'mehtod' type.
82   #push @ { $info{$observable->name."|". $observable->cvterm_id ."|". $definition . "|" . $unit} } , $phenotype;
85   my $observable_name = $phenotype->get_column('observable');
86   my $value =  $phenotype->get_column('value') ;
87   push @{ $info{$method_name}{$observable_name}{phenotypes}} , $phenotype->get_column('value') ;
88   $info{$method_name}{$observable_name}{cvterm_id} = $phenotype->get_column('observable_id');
89   $info{$method_name}{$observable_name}{definition} = $phenotype->get_column('definition');
90   $info{$method_name}{$observable_name}{unit} = $unit_name ;
94 my $count = 0;
95 #display traits sorted by name
96 ##NEED TO SORT BY cvtermprop or by parent? , then by name######
97 foreach my $method(sort keys %info ) {
98   foreach my $term_name(sort keys %{ $info{$method} } ) {
99     my $term_id    = $info{$method}{$term_name}{cvterm_id};
100     my $definition = $info{$method}{$term_name}{definition};
101     my $unit       = $info{$method}{$term_name}{unit} ;
102     $unit = " ($unit)" if $unit;
103     $definition .= $definition . $unit if $unit;
105     my @values; # all quantitative data does here
106     my @qual_values; #all qualitative data goes here
107     foreach my $i ( @{ $info{$method}{$term_name}{phenotypes} } ) {
108       my $value = $i ;###->value;
109       if (looks_like_number($value))  {  push @values, $value ; }
110       else { push @qual_values, $value ; }
111     }
112     my $stat = Statistics::Descriptive::Sparse->new();
113     $stat->add_data(@values);
115     my $mean_value =  sprintf("%.2f", $stat->mean);
116     my $min = sprintf("%.2f", $stat->min);
117     my $max = sprintf("%.2f", $stat->max);
118     
119     if (scalar(@values) ) {
120        no warnings 'uninitialized';
121        push  @ { $data{$method}{phen} } ,  [map {$_}
122                      ( { width => "320" , content => (tooltipped_text(qq|<a href="/cvterm/$term_id/view">$term_name</a> $unit|, $definition ) ) } , { width => "60", content => $mean_value }, { with => "60" , content => $min } , { width => "60" , content => $max }, { width => "40" , content => scalar(@values) } )  ];
124       push  @ { $data{$method}{phen}[$count] } , qq | <a href="/phenome/qtl_analysis.pl?stock_id=$object_id&amp;cvterm_id=$term_id" onClick="Qtl.waitPage()"> $graph_icon</a> |    if $has_qtl;
125       $count++;
126     }
127     if (scalar(@qual_values) ) {
128       push  @qual_data,  [map {$_}
129                           ( (tooltipped_text(qq|<a href="/cvterm/$term_id/view">$term_name</a>|, $definition) )  , join(', ' , @qual_values ) ) ];
130     }
131   }
132      @ { $data{$method}{headings} } = ("$method" , "Average", "Min", "Max", "Lines/repeats");
133      push @ { $data{$method}{headings} } , 'QTL(s)' if $has_qtl;
134 }      
136 </%perl>
138 <script  language="javascript">
140 </script>
142 <& /util/import_javascript.mas, classes => [ "CXGN.Phenome.Qtl" ] &>
144 <div id = "$div">
146 % foreach my $key( sort keys %data ) {
147 %  my @data_points = @ { $data{$key}{phen} } if $data{$key}{phen};
148 %  my @headings    = @ { $data{$key}{headings} };
149 %  if (@data_points) {
151 <& /page/columnar_table.mas,
152       headings   => \@headings,
153       data       => \@data_points,
154         __alt_freq   =>2,
155         __alt_width  =>1,
156         __alt_offset =>3,
157         __align =>'lrrrc',
160 %   }
161 % }
163 % if(@qual_data) {
165 <& /page/columnar_table.mas,
166   headings => ["Qualitative Trait", "Value"],
167     data     => \@qual_data ,
168       __alt_freq   =>2,
169       __alt_width  =>1,
170       __alt_offset =>3,
171       __align =>'ll',
174 % }
175 </div>
177 <& /qtl/waitmessage.mas &>