mason/gem/template/expression_info.mas

   1 <%doc>
   2
   3 =head1 NAME
   4
   5  expression_info.mas
   6  Mason component to take the expression data associated to a template web_page.
   7
   8 =cut
   9
  10 =head1 VERSION
  11
  12 0.1
  13
  14 =cut
  15
  16 =head1 DESCRIPTION
  17
  18  Mason component to take the expression data associated to a template web_page.
  19
  20  It will return two sections:
  21
  22    1) By hybridization
  23
  24    2) By Experiment (where the expression will be a median or mean of the hybridization values)
  25
  26 =cut
  27
  28 =head 1 AUTHOR
  29
  30  Aureliano Bombarely (ab782@cornell.edu)
  31
  32 =cut
  33
  34 </%doc>
  35
  36
  37 <%args>
  38 $template
  39 </%args>
  40
  41 <%once>
  42 use strict;
  43 use warnings;
  44 use Math::BigFloat;
  45 use CXGN::GEM::Hybridization;
  46 use CXGN::Page::FormattingHelpers  qw/ info_section_html info_table_html columnar_table_html page_title_html html_break_string /;
  47 use CXGN::GEM::Experiment;
  48 </%once>
  49
  50 <%perl>
  51
  52 my $experiment_info_content;
  53
  54 ## define a hash with keys=experiment_id and values=experiment_name
  55
  56 my %experiments;
  57
  58 ## If there aren't any template_row that comes from template_detail.mas, it will return nothing
  59 ## (the message is returned by basic_info.mas).
  60
  61 if (defined $template->get_template_id() ) {
  62
  63     ## Get schema
  64
  65     my $schema = $template->get_schema();
  66
  67     ## Get the template_id and all the expression_experiment_values associated to them with the experimental design
  68
  69     my (%exp_info, %expdes_info);
  70
  71     my $template_id = $template->get_template_id();
  72
  73     my @exp_exp_values_rows = $schema->resultset('GeExpressionByExperiment')
  74                                      ->search( { template_id => $template_id } );
  75
  76     ## declare the array to order
  77
  78     my %order_by_po = ();
  79
  80     foreach my $expexp_value_row (@exp_exp_values_rows) {
  81
  82         my %exp_values = $expexp_value_row->get_columns();
  83
  84         my $rep_used = $exp_values{'replicates_used'} || 'none';
  85
  86         my $mean = Math::BigFloat->new( $exp_values{'mean'})
  87                                  ->ffround(-2)
  88                                  ->bstr();
  89
  90         my $median = Math::BigFloat->new( $exp_values{'median'} )
  91                                    ->ffround(-2)
  92                                    ->bstr();
  93
  94         my $sd = Math::BigFloat->new($exp_values{'standard_desviation'})
  95                                ->ffround(-2)
  96                                ->bstr();
  97
  98         my $cv = Math::BigFloat->new($exp_values{'coefficient_of_variance'})
  99                                ->ffround(-2)
 100                                ->bstr();
 101
 102
 103         ## To create the tags it is better to use % of sd instead a fixed number
 104
 105         my $sd_perc = '';
 106         if ($mean != 0) {
 107             $sd_perc = 100 * $sd / $mean;
 108         }
 109         else {
 110             $rep_used = 'none';
 111         }
 112
 113         if ($rep_used eq 'none') {
 114             my $def1 = '<font color=gray>NA</font>';
 115             ($mean, $median, $sd, $cv) = ($def1, $def1, $def1, $def1);
 116         } elsif ($rep_used == 1) {
 117             my $def2 = '<font color=darkcyan>NA</font>';
 118             ($sd, $cv) = ($def2, $def2);
 119             $mean = '<b><font color=darkcyan>'.$mean.'</font></b>';
 120             $median = '<b><font color=darkcyan>'.$median.'</font></b>';
 121         } else {
 122             if ($sd_perc < 5) {
 123                 $mean = '<b><font color=darkblue>'.$mean.'</font></b>';
 124                 $median = '<b><font color=darkblue>'.$median.'</font></b>';
 125                 $sd = '<b><font color=darkblue>'.$sd.'</font></b>';
 126                 $cv = '<b><font color=darkblue>'.$cv.'</font></b>';
 127             } elsif ($sd_perc < 10) {
 128                 $mean = '<font color=darkblue>'.$mean.'</font>';
 129                 $median = '<font color=darkblue>'.$median.'</font>';
 130                 $sd = '<font color=darkorange>'.$sd.'</font>';
 131                 $cv = '<font color=darkblue>'.$cv.'</font>';
 132             } else {
 133                 $mean = '<font color=darkblue>'.$mean.'</font>';
 134                 $median = '<font color=darkblue>'.$median.'</font>';
 135                 $sd = '<font color=darkred>'.$sd.'</font>';
 136                 $cv = '<font color=darkblue>'.$cv.'</font>';
 137             }
 138         }
 139
 140         my $exp_id = $exp_values{'experiment_id'};
 141
 142         my $experiment = CXGN::GEM::Experiment->new($schema, $exp_id);
 143
 144         if (defined $experiment->get_experiment_id() ) {
 145
 146             my $exp_name = $experiment->get_experiment_name();
 147
 148             $experiments{$exp_id} = $exp_name;
 149             my $exp_link = '/gem/experiment.pl?id='.$exp_id;
 150             my $exp_html = "<a href=$exp_link>$exp_name</a>";
 151
 152             my $exp_rep = $experiment->get_replicates_nr();
 153
 154             my $expdesign = $experiment->get_experimental_design();
 155
 156             ## It will take po terms to identify the tissue
 157             ## It will choose the shorter term to take
 158
 159             my $chooser = 1000;
 160             my $p_onto = '';
 161
 162             my @target_list = $experiment->get_target_list();
 163
 164             foreach my $target (@target_list) {
 165                 my @sample_list = $target->get_sample_list();
 166
 167                 foreach my $sample (@sample_list) {
 168                     my %po = $sample->get_dbxref_related('PO');
 169
 170                     foreach my $sample_dbxref_id (keys %po) {
 171                         my %dbxref_po = %{ $po{$sample_dbxref_id} };
 172
 173                         my $po_name = $dbxref_po{'cvterm.name'};
 174                         if (length($po_name) < $chooser) {
 175                             $chooser = length($po_name);
 176                             my $onto_link = '/cvterm/' . $dbxref_po{'cvterm.cvterm_id'}.'/view';
 177                             my $onto_html = "<a href=$onto_link>$po_name</a>";
 178
 179                             $p_onto = $onto_html;
 180
 181                             my @opo = split(/ /, $po_name);
 182                             my $opo_name = join(' ', reverse(@opo));
 183
 184                             unless (exists $order_by_po{$opo_name}) {
 185                                 $order_by_po{$opo_name} = [$exp_name];
 186                             }
 187                             else {
 188                                 push @{$order_by_po{$opo_name}}, $exp_name;
 189                             }
 190                         }
 191                     }
 192                 }
 193             }
 194
 195             if (defined $expdesign->get_experimental_design_id() ) {
 196
 197                 my $expdesign_id = $expdesign->get_experimental_design_id();
 198                 my $expdesign_name = $expdesign->get_experimental_design_name();
 199
 200                 my $expdesign_link = '/gem/experimental_design.pl?id='.$expdesign_id;
 201                 my $expdesign_html = "<a href=$expdesign_link>$expdesign_name</a>";
 202
 203                 ## Check if exists or not the experimental design. If exists, use " instead the name. Store in an array.
 204
 205                 if (exists $exp_info{$exp_name}) {
 206
 207                     push @{ $exp_info{$exp_name} }, ['"', $exp_html, $p_onto, $exp_rep, $rep_used, $mean, $median, $sd, $cv];
 208
 209                     push @{ $expdes_info{$expdesign_name} }, $exp_name;
 210
 211                 } else {
 212                     $exp_info{$exp_name} = [ [ $expdesign_html, $exp_html, $p_onto, $exp_rep, $rep_used, $mean, $median, $sd, $cv] ];
 213
 214                     if (exists $expdes_info{$expdesign_name} ) {
 215
 216                         push @{ $expdes_info{$expdesign_name} }, $exp_name;
 217                     }
 218                     else {
 219
 220                         $expdes_info{$expdesign_name} = [$exp_name];
 221                     }
 222                 }
 223             }
 224         }
 225     }
 226
 227     ## Create the array to order the experiments if they have PO terms
 228
 229     my @exp_order = ();
 230     my %exp_check = ();
 231
 232     foreach my $po (sort keys %order_by_po) {
 233         if (defined $order_by_po{$po}) {
 234             my @exp_o_list = @{ $order_by_po{$po} };
 235
 236             foreach my $exp_o_name (sort @exp_o_list) {
 237                 unless (defined $exp_check{$exp_o_name}) {
 238                     push @exp_order, $exp_o_name;
 239                     $exp_check{$exp_o_name} = 1;
 240                 }
 241             }
 242         }
 243     }
 244
 245     ## Build the array for the table ordened
 246
 247     my %firstdata;
 248     my @expression_data;
 249     foreach my $exper_design (keys %expdes_info) {
 250         my @experid_list = @{ $expdes_info{$exper_design} };
 251
 252         if (scalar(@experid_list) == scalar(@exp_order)) {
 253             @experid_list = @exp_order;
 254         }
 255
 256         foreach my $exp_o (@experid_list) {
 257             my $expdata_aref = $exp_info{$exp_o};
 258
 259             if (defined $expdata_aref) {
 260                 my @exp_single_list = @{$expdata_aref};
 261
 262                 foreach my $single_exp (@exp_single_list) {
 263                     my $first = $single_exp->[0];
 264                     if (exists $firstdata{$first}) {
 265                         $single_exp->[0] = ' ';
 266                     } else {
 267                         $firstdata{$first} = 1;
 268                     }
 269                     push @expression_data, $single_exp;
 270                 }
 271             }
 272         }
 273     }
 274
 275     ## Create the table using columnar_table_html
 276
 277     my $experiments_html = columnar_table_html( headings => [ 'Experimental design name',
 278                                                               'Experiment name',
 279                                                               'Tissue',
 280                                                               'Experiment replicates',
 281                                                               'Replicates pValue<0.05',
 282                                                               'Mean',
 283                                                               'Median',
 284                                                               'SD',
 285                                                               'CV' ],
 286                                                 data     => \@expression_data,
 287                                                 __align  => ['l', 'l', 'l', 'c', 'c', 'c', 'c', 'c'],
 288                                                );
 289
 290    ## If there are any experiment, replace the table for a message
 291    my $exp_number = scalar(@expression_data);
 292    if ($exp_number == 0) {
 293        $experiments_html = 'No experiment was found associated to this template';
 294    }
 295
 296     $experiment_info_content = info_section_html( title       => "Table: Expression Data by Experiment (".$exp_number.")",
 297                                                   contents    => $experiments_html,
 298                                                   collapsible => 1,
 299                                                   collapsed   => 1 );
 300
 301
 302 ## Now we are going to add the expression data by targets (experiment replicates)
 303
 304     my (%exptemp_info);
 305     my ($template_signal_type, $statistical_signal_type);
 306
 307     my @exptemp_values_rows = $schema->resultset('GeTemplateExpression')
 308                                      ->search({ template_id => $template_id });
 309
 310     foreach my $exptemp_values_row (@exptemp_values_rows) {
 311         my %exp_temp_values = $exptemp_values_row->get_columns();
 312
 313         $template_signal_type = $exp_temp_values{'template_signal_type'};
 314         $statistical_signal_type = $exp_temp_values{'statistical_value_type'};
 315         my $signal = $exp_temp_values{'template_signal'};
 316         my $stats = $exp_temp_values{'statistical_value'};
 317
 318         my $fstats;
 319         if (defined $stats) {
 320
 321             my $number = Math::BigFloat->new($stats);
 322
 323             ## Change the colour of the html depending of the value
 324
 325             if ($number->bcmp(0.05) < 0) {
 326
 327                 if ($number->bcmp(0.001) < 0) {
 328                     my $cvalue = $number->fround(1)->bsstr();
 329                     $fstats = '<b><font color=green>'.$cvalue.'</font></b>';
 330                 }
 331                 else {
 332                     my $nvalue = $number->ffround(-3)->bstr();
 333                     $fstats = '<b><font color=green>'.$nvalue.'</font></b>';
 334                 }
 335             }
 336             else {
 337                 my $mvalue = $number->ffround(-3)->bstr();
 338                 $fstats = '<b><font color=red>'.$mvalue.'</font></b>';
 339             }
 340         }
 341
 342         my $hyb = CXGN::GEM::Hybridization->new($schema, $exp_temp_values{'hybridization_id'});
 343
 344         my $htarget = $hyb->get_target();
 345         my $htarget_name = $htarget->get_target_name();
 346         my $htarget_id = $htarget->get_target_id();
 347         my $htarget_html = '<a href=/gem/target.pl?id=' . $htarget_id . '>' . $htarget_name . '</a>';
 348
 349         my $hexper = $htarget->get_experiment();
 350         my $hexper_name = $hexper->get_experiment_name();
 351         my $hexper_id = $hexper->get_experiment_id();
 352         my $hexper_html = '<a href=/gem/experiment.pl?id=' . $hexper_id . '>' . $hexper_name . '</a>';
 353
 354         if (exists $exptemp_info{$hexper_name}) {
 355             push @{ $exptemp_info{$hexper_name} }, [' ', $htarget_html, $signal, $fstats, $exp_temp_values{'flag'}];
 356         }
 357         else {
 358             $exptemp_info{$hexper_name} = [ [$hexper_html, $htarget_html, $signal, $fstats, $exp_temp_values{'flag'}] ];
 359         }
 360
 361     }
 362
 363     ## Now define the array for the table. If it has the same number of experiments that
 364     ## the @exp_order array made using the PO terms, it will use that as order list
 365
 366     my @expression_targ_list;
 367     my @experiment_list = keys %exptemp_info;
 368     if (scalar(@experiment_list) == scalar(@exp_order)) {
 369         @experiment_list = @exp_order;
 370     }
 371     foreach my $exp_t (@experiment_list) {
 372         if (exists $exptemp_info{$exp_t} ) {
 373             my @target_list = @{ $exptemp_info{$exp_t}};
 374            foreach my $target_data (@target_list) {
 375                 push @expression_targ_list, $target_data;
 376             }
 377         }
 378     }
 379
 380
 381     my $experiments_by_targets_html;
 382     my $exprep_n = scalar(@expression_targ_list);
 383     if ($exprep_n == 0) {
 384         $experiments_by_targets_html = 'No hybridization target data was found associated to this template';
 385     } else {
 386         $experiments_by_targets_html = columnar_table_html( headings => [ 'Experiment name',
 387                                                                           'Target name',
 388                                                                           $template_signal_type,
 389                                                                           $statistical_signal_type,
 390                                                                           'flag' ],
 391                                                             data     => \@expression_targ_list,
 392                                                             __align  => ['l', 'l', 'c', 'c', 'c'],
 393                                                            );
 394     }
 395     $experiment_info_content .= info_section_html( title    => "Expression Data by Targets (experiment replicates) ($exprep_n)",
 396                                                    contents => $experiments_by_targets_html,
 397                                                    collapsible =>1,
 398                                                    collapsed =>1 );
 399
 400
 401 }
 402
 403 </%perl>
 404
 405 <% $experiment_info_content %>
 406
 407 <&
 408    /util/import_javascript.mas,
 409    classes => 'CXGN.Effects'
 410 &>