cgi-bin/phenome/population.pl

   1 use strict;
   2 use warnings;
   3
   4 my $population_detail_page = CXGN::Phenome::PopulationDetailPage->new();
   5
   6 package CXGN::Phenome::PopulationDetailPage;
   7
   8
   9 use CXGN::Page;
  10 use CXGN::Page::FormattingHelpers qw /info_section_html
  11                                       page_title_html
  12                                       columnar_table_html
  13                                       html_optional_show
  14                                       info_table_html
  15                                       tooltipped_text
  16                                       html_alternate_show
  17                                       /;
  18
  19 use CXGN::Phenome::Population;
  20 use CXGN::Phenome::PopulationDbxref;
  21 use CXGN::People::PageComment;
  22 use CXGN::People::Person;
  23 use CXGN::Chado::Publication;
  24 use CXGN::Chado::Pubauthor;
  25 use CXGN::Contact;
  26 use CXGN::Map;
  27 use File::Temp qw / tempfile /;
  28 use File::Path qw / mkpath  /;
  29 use File::Copy;
  30 use File::Spec;
  31 use File::Basename;
  32
  33 use base qw / CXGN::Page::Form::SimpleFormPage CXGN::Phenome::Main/;
  34
  35 use CatalystX::GlobalContext qw( $c );
  36
  37
  38 sub new {
  39     my $class = shift;
  40     my $self = $class->SUPER::new(@_);
  41     $self->set_script_name("population.pl");
  42
  43
  44     return $self;
  45 }
  46
  47 sub define_object {
  48     my $self = shift;
  49
  50     # call set_object_id, set_object and set_primary_key here
  51     # with the appropriate parameters.
  52     #
  53     $self->set_dbh( CXGN::DB::Connection->new );
  54     my %args = $self->get_args();
  55     my $population_id= $args{population_id};
  56     unless (!$population_id || $population_id =~m /^\d+$/) { $self->get_page->message_page("No population exists for identifier $population_id"); }
  57     $self->set_object_id($population_id);
  58     $self->set_object(CXGN::Phenome::Population->new($self->get_dbh(),$self->get_object_id()));
  59     $self->set_primary_key("population_id");
  60     $self->set_owners($self->get_object()->get_owners());
  61 }
  62
  63
  64
  65
  66 sub generate_form {
  67     my $self = shift;
  68
  69     $self->init_form();
  70
  71     my %args = $self->get_args();
  72
  73     my $population = $self->get_object();
  74     my $population_id = $self->get_object_id();
  75     my $type_id = $args{type_id};
  76     my $type=$args{type};
  77
  78     my ($submitter, $submitter_link) = $self->submitter();
  79
  80     my $login_user= $self->get_user();
  81     my $login_user_id= $login_user->get_sp_person_id();
  82     my $form = undef;
  83
  84     if ($self->get_action()=~/edit|store/ && ($login_user_id = $submitter || $self->get_user()->get_user_type() eq 'curator') ) {
  85         $form = CXGN::Page::Form::Editable->new();
  86     }
  87     else {
  88         $form = CXGN::Page::Form::Static->new();
  89     }
  90
  91    $form->add_field(
  92                       display_name=>"Name:",
  93                       field_name=>"name",
  94                       length=>15,
  95                       object=>$population,
  96                       getter=>"get_name",
  97                       setter=>"set_name",
  98                       validate => 'string',
  99                       );
 100     $form->add_textarea(
 101                           display_name=>"Description: ",
 102                           field_name=>"description",
 103                           object=>$population,
 104                           getter=>"get_description", setter=>"set_description",
 105                           columns => 40,
 106                           rows =>4,
 107                           );
 108
 109
 110     $form->add_label( display_name=>"Uploaded by: ",
 111                           field_name=>"submitter",
 112                           contents=>$submitter_link,
 113                           );
 114     $form->add_hidden( field_name=>"population_id", contents=>$args{population_id});
 115
 116     $form->add_hidden (
 117                        field_name => "sp_person_id",
 118                        contents   =>$self->get_user()->get_sp_person_id(),
 119                        object     => $population,
 120                        setter     =>"set_sp_person_id",
 121                        );
 122
 123     $form->add_hidden( field_name=>"action", contents=>"store"  );
 124
 125
 126
 127
 128
 129     $self->set_form($form);
 130
 131     if ($self->get_action=~ /view|edit/) {
 132         $self->get_form->from_database();
 133
 134
 135     }elsif ($self->get_action=~ /store/) {
 136         $self->get_form->from_request($self->get_args());
 137
 138  }
 139
 140
 141
 142 }
 143
 144 sub display_page {
 145     my $self = shift;
 146
 147     $self->get_page->add_style( text => <<EOS);
 148
 149 a.abstract_optional_show {
 150   color: blue;
 151   cursor: pointer;
 152   white-space: nowrap;
 153 }
 154 div.abstract_optional_show {
 155   background: #f0f0ff;
 156   border: 1px solid #9F9FC7;
 157   margin: 0.2em 1em 0.2em 1em;
 158   padding: 0.2em 0.5em 0.2em 1em;
 159 }
 160 EOS
 161
 162
 163
 164     my %args = $self->get_args();
 165
 166     my $population = $self->get_object();
 167     my $population_id = $self->get_object_id();
 168     my $population_name = $population->get_name();
 169
 170     my $action = $args{action};
 171     if (!$population_id && $action ne 'new' && $action ne 'store')
 172                      { $self->get_page->message_page("No population exists for this identifier"); }
 173     ################################
 174     #redirecting to the stock page
 175     my $stock_id = $population->get_stock_id;
 176     $c->throw(is_error=>1,
 177               message=>"No population exists for identifier $population_name (id = $population_id)",
 178         ) if !$stock_id;
 179     $self->get_page->client_redirect("/stock/$stock_id/view");
 180     ###############
 181     #used to show certain elements to only the proper users
 182     my $login_user= $self->get_user();
 183     my $login_user_id= $login_user->get_sp_person_id();
 184     my $login_user_type= $login_user->get_user_type();
 185     my $page="../phenome/population.pl?population_id=$population_id";
 186
 187     $self->get_page()->header("SGN Population name: $population_name");
 188
 189     print page_title_html("Population: $population_name \n");
 190
 191     $args{calling_page} = $page;
 192
 193     my $population_html = $self->get_edit_link_html(). "\t[<a href=/phenome/qtl_form.pl>New QTL Population</a>] <br />";
 194
 195     #print all editable form  fields
 196     $population_html .= $self->get_form()->as_table_string();
 197
 198
 199     my ($phenotype, $is_qtl_pop);
 200     my @phenotype;
 201     my $graph_icon = qq |<img src="../documents/img/pop_graph.png"/> |;
 202
 203     my $qtltool = CXGN::Phenome::Qtl::Tools->new();
 204     my @pops = $qtltool->has_qtl_data();
 205
 206     foreach my $pops (@pops)
 207     {
 208         my $pops_id = $pops->get_population_id();
 209         if ($pops_id == $population_id)
 210         {
 211             $is_qtl_pop = 1;
 212         }
 213     }
 214
 215     if ($population->get_web_uploaded()) {
 216         my @traits = $population->get_cvterms();
 217
 218         foreach my $trait (@traits)  {
 219             my $trait_id = $trait->get_user_trait_id();
 220             my $trait_name = $trait->get_name();
 221             my $definition = $trait->get_definition();
 222             my ($min, $max, $avg, $std, $count)= $population->get_pop_data_summary($trait_id);
 223
 224             my $cvterm_obj  = CXGN::Chado::Cvterm::get_cvterm_by_name( $self->get_dbh(), $trait_name);
 225             my $trait_link;
 226             my $cvterm_id = $cvterm_obj->get_cvterm_id();
 227             if ($cvterm_id)
 228             {
 229                 $trait_link = qq |<a href="/cvterm/$cvterm_id/view">$trait_name</a>|;
 230
 231             } else
 232             {
 233                 $trait_link = qq |<a href="/phenome/trait.pl?trait_id=$trait_id">$trait_name</a>|;
 234             }
 235
 236             if ($is_qtl_pop)
 237             {
 238                 if ($definition)
 239                 {
 240                     push  @phenotype,  [map {$_} ( (tooltipped_text($trait_link, $definition)),
 241                                     $min, $max, $avg,
 242                            qq | <a href="/phenome/population_indls.pl?population_id=$population_id&amp;cvterm_id=$trait_id">
 243                                  $count</a>
 244                               |,
 245                            qq | <a href="/phenome/population_indls.pl?population_id=$population_id&amp;cvterm_id=$trait_id">
 246                                   $graph_icon</a>
 247                               | )];
 248                 } else
 249                 {
 250                     push  @phenotype,  [map {$_} ($trait_name, $min, $max, $avg,
 251                           qq | <a href="/phenome/population_indls.pl?population_id=$population_id&amp;cvterm_id=$trait_id">
 252                              $count</a>
 253                              |,
 254                            qq | <a href="/phenome/population_indls.pl?population_id=$population_id&amp;cvterm_id=$trait_id">
 255                                   $graph_icon</a>
 256                               |  )];
 257                 }
 258             } else
 259             {
 260                 if ($definition)
 261                 {
 262                     push  @phenotype,  [map {$_} ( (tooltipped_text( $trait_link, $definition )),
 263                                     $min, $max, $avg, $count )];
 264                 } else
 265                 { push  @phenotype,  [map {$_} ( $trait_name, $min, $max, $avg, $count )];
 266                 }
 267             }
 268         }
 269     }
 270      else {
 271          my @cvterms = $population->get_cvterms();
 272          foreach my $cvterm(@cvterms)
 273          {
 274              my ($min, $max, $avg, $std, $count)= $population->get_pop_data_summary($cvterm->get_cvterm_id());
 275              my $cvterm_id = $cvterm->get_cvterm_id();
 276              my $cvterm_name = $cvterm->get_cvterm_name();
 277
 278              if ($is_qtl_pop)
 279              {
 280                  if ($cvterm->get_definition())
 281                  {
 282                      push  @phenotype,  [map {$_} ( (tooltipped_text( qq|<a href="/cvterm/$cvterm_id/view">
 283                                                                       $cvterm_name</a>
 284                                                                      |,
 285                                     $cvterm->get_definition())), $min, $max, $avg, $count,
 286                           qq | <a href="/phenome/population_indls.pl?population_id=$population_id&amp;cvterm_id=$cvterm_id">
 287                                $graph_icon</a>
 288                              | ) ];
 289                  } else
 290                  { push  @phenotype,  [map {$_} (qq | <a href="/cvterm/$cvterm_id/view">$cvterm_name</a>|,
 291                             $min, $max, $avg, $count,
 292                      qq | <a href="/phenome/population_indls.pl?population_id=$population_id&amp;cvterm_id=$cvterm_id">
 293                           $graph_icon</a>
 294                         |  ) ];
 295                  }
 296              } else
 297              {
 298                  if ($cvterm->get_definition())
 299                  {
 300                      push  @phenotype,  [map {$_} ( (tooltipped_text( qq|<a href="/cvterm/$cvterm_id/view">
 301                                                                       $cvterm_name</a>
 302                                                                      |,
 303                                     $cvterm->get_definition())), $min, $max, $avg, $count) ];
 304                  } else
 305                  {
 306                      push  @phenotype,  [map {$_} (qq | <a href="/cvterm/$cvterm_id/view">$cvterm_name</a>|,
 307                             $min, $max, $avg, $count ) ];
 308                  }
 309              }
 310          }
 311      }
 312
 313     my $accessions_link = qq |<a href="../search/phenotype_search.pl?wee9_population_id=$population_id">
 314                               See all accessions ...</a>
 315                              |;
 316
 317     my ($phenotype_data, $data_view, $data_download);
 318
 319     if (@phenotype)
 320     {
 321         if ($is_qtl_pop) {
 322             $phenotype_data = columnar_table_html(headings => [
 323                                                            'Trait',
 324                                                            'Minimum',
 325                                                            'Maximum',
 326                                                            'Average',
 327                                                            'No. of lines',
 328                                                            'QTL(s)...',
 329                                                            ],
 330                                               data     =>\@phenotype,
 331                                               __alt_freq   =>2,
 332                                               __alt_width  =>1,
 333                                               __alt_offset =>3,
 334                                               __align =>'l',
 335                                               );
 336
 337             $data_download .=  qq { <span><br/><br/>Download:<a href="phenotype_download.pl?population_id=$population_id"><b>\
 338                                 [Phenotype raw data]</b></a> <a href="genotype_download.pl?population_id=$population_id"><b>\
 339                                 [Genotype raw data]</b></a></span>
 340                               };
 341
 342
 343         } else
 344         {
 345             $phenotype_data = columnar_table_html(headings => [
 346                                                            'Trait',
 347                                                            'Minimum',
 348                                                            'Maximum',
 349                                                            'Average',
 350                                                            'No. of lines',
 351                                                            ],
 352                                               data     =>\@phenotype,
 353                                               __alt_freq   =>2,
 354                                               __alt_width  =>1,
 355                                               __alt_offset =>3,
 356                                               __align =>'l',
 357                                               );
 358
 359             $data_download .=  qq { <span><br/><br/>Download:<a href="phenotype_download.pl?population_id=$population_id"><b>\
 360                                 [Phenotype raw data]</b></a></span>
 361                               };
 362
 363         }
 364
 365
 366
 367     }
 368
 369
 370     my $pub_subtitle;
 371     if ($population_name && ($login_user_type eq 'curator' || $login_user_type eq 'submitter')) {
 372         $pub_subtitle .= qq|<a href="../chado/add_publication.pl?type=population&amp;type_id=$population_id&amp;refering_page=$page&amp;action=new">[Associate publication]</a>|;
 373
 374     }
 375
 376     else { $pub_subtitle= qq|<span class=\"ghosted\">[Associate publication]</span>|;
 377
 378     }
 379
 380
 381     my $pubmed;
 382     my $url_pubmed = qq | http://www.ncbi.nlm.nih.gov/pubmed/|;
 383
 384     my @publications = $population->get_population_publications();
 385     my $abstract_view;
 386     my $abstract_count = 0;
 387
 388
 389
 390     foreach my $pub (@publications) {
 391         my ($title, $abstract, $authors, $journal, $pyear,
 392             $volume, $issue, $pages, $obsolete, $pub_id, $accession
 393            );
 394         $abstract_count++;
 395
 396         my @dbxref_objs = $pub->get_dbxrefs();
 397         my $dbxref_obj = shift(@dbxref_objs);
 398
 399         $obsolete = $population->get_population_dbxref($dbxref_obj)->get_obsolete();
 400
 401         if ($obsolete eq 'f') {
 402             $pub_id = $pub->get_pub_id();
 403             $title = $pub->get_title();
 404             $abstract = $pub->get_abstract();
 405             $pyear = $pub->get_pyear();
 406             $volume = $pub->get_volume();
 407             $journal = $pub->get_series_name();
 408             $pages = $pub->get_pages();
 409             $issue = $pub->get_issue();
 410
 411             $accession = $dbxref_obj->get_accession();
 412             my $pub_info = qq|<a href="/publication/$pub_id/view" >PMID:$accession</a>|;
 413
 414             my @authors;
 415             my $authors;
 416             if ($pub_id) {
 417
 418                 my @pubauthors_ids = $pub->get_pubauthors_ids($pub_id);
 419
 420                 foreach my $pubauthor_id (@pubauthors_ids) {
 421                     my  $pubauthor_obj = CXGN::Chado::Pubauthor->new($self->get_dbh, $pubauthor_id);
 422                     my $last_name  = $pubauthor_obj->get_surname();
 423                     my $first_names = $pubauthor_obj->get_givennames();
 424                     my @first_names = split (/,/, $first_names);
 425                     $first_names = shift (@first_names);
 426                     push @authors, ("$first_names" ."  ". "$last_name");
 427                     $authors = join (", ", @authors);
 428                 }
 429             }
 430
 431
 432
 433
 434             $abstract_view = html_optional_show("abstracts$abstract_count",
 435                                'Show/hide abstract',
 436                                qq|$abstract <b> <i>$authors.</i> $journal. $pyear. $volume($issue). $pages.</b>|,
 437                                                  0, #< do not show by default
 438                                                  'abstract_optional_show', #< don't use the default button-like style
 439                                                 );
 440
 441
 442             $pubmed .= qq| <div><a href="$url_pubmed$accession" target="blank">$pub_info</a> $title $abstract_view</div> |;
 443         }
 444     }
 445
 446     print info_section_html(title   => 'Population Details',
 447                             contents => $population_html,
 448                             );
 449
 450     my $is_public = $population->get_privacy_status();
 451     if ( $is_public
 452          || $login_user_type eq 'curator'
 453          || $login_user_id == $population->get_sp_person_id()
 454        )
 455     {
 456         if (-s $population->phenotype_file($c))
 457         {
 458             my $correlation_data = $self->display_correlation();
 459
 460             print info_section_html(title    => 'Phenotype Data and QTLs',
 461                                     contents => $phenotype_data ." ".$data_download
 462                                    );
 463
 464             print info_section_html( title    => 'Pearson Correlation Analysis',
 465                                      contents => $correlation_data,
 466                                    );
 467         }
 468         else
 469         {
 470             print info_section_html(title    => 'Phenotype Data',
 471                                     contents => $accessions_link
 472                                    );
 473         }
 474
 475         my $map_link = $self->genetic_map();
 476         unless (!$map_link)
 477         {
 478             print info_section_html( title    => 'Genetic Map',
 479                                      contents => $map_link
 480                                    );
 481         }
 482
 483     }
 484     else
 485     {
 486         my ($submitter_obj, $submitter_link) = $self->submitter();
 487         my $message = "The QTL data for this population is not public yet.
 488                        If you would like to know more about this data,
 489                        please contact the owner of the data: <b>$submitter_link</b>
 490                        or email to SGN:
 491                        <a href=mailto:sgn-feedback\@sgn.cornell.edu>
 492                        sgn-feedback\@sgn.cornell.edu</a>.\n";
 493
 494         print info_section_html(title   => 'Phenotype Data and QTLs',
 495                                 contents =>$message,
 496                                );
 497
 498     }
 499
 500     print info_section_html(title   => 'Literature Annotation',
 501                             #subtitle => $pub_subtitle,
 502                             contents => $pubmed,
 503                             );
 504
 505
 506
 507 ###################
 508
 509     if ($population_name) {
 510         # change sgn_people.forum_topic.page_type and the CHECK constraint!!
 511         my $page_comment_obj = CXGN::People::PageComment->new($self->get_dbh(), "population", $population_id, $self->get_page()->{request}->uri()."?".$self->get_page()->{request}->args());
 512         print $page_comment_obj->get_html();
 513     }
 514
 515     $self->get_page()->footer();
 516
 517
 518     exit();
 519 }
 520
 521
 522
 523
 524
 525
 526 # override store to check if a locus with the submitted symbol/name already exists in the database
 527
 528 sub store {
 529    my $self = shift;
 530    my $population = $self->get_object();
 531    my $population_id = $self->get_object_id();
 532    my %args = $self->get_args();
 533
 534    $self->SUPER::store(0);
 535
 536  exit();
 537 }
 538
 539
 540 sub submitter {
 541     my $self = shift;
 542     my $population = $self->get_object();
 543     my $sp_person_id= $population->get_sp_person_id();
 544     my $submitter = CXGN::People::Person->new($self->get_dbh(), $population->get_sp_person_id());
 545     my $submitter_name = $submitter->get_first_name()." ".$submitter->get_last_name();
 546     my $submitter_link = qq |<a href="/solpeople/personal-info.pl?sp_person_id=$sp_person_id">$submitter_name</a> |;
 547
 548     return $submitter, $submitter_link;
 549
 550 }
 551
 552 sub genetic_map {
 553     my $self     = shift;
 554     my $mapv_id  = $self->get_object()->mapversion_id();
 555
 556     if ($mapv_id) {
 557         my $map      = CXGN::Map->new( $self->get_dbh(), { map_version_id => $mapv_id } );
 558         my $map_name = $map->get_long_name();
 559         my $map_sh_name = $map->get_short_name();
 560         my $genetic_map =
 561             qq | <a href=/cview/map.pl?map_version_id=$mapv_id>$map_name ($map_sh_name)</a>|;
 562
 563         return $genetic_map;
 564     }
 565     else {
 566         return;
 567     }
 568
 569 }
 570
 571 =head2 analyze_correlation
 572
 573  Usage: my ($heatmap_file, $corre_table_file) = $self->analyze_correlation();
 574  Desc: runs correlation analysis (R) in the cluster system
 575        for all the traits assayed for a population
 576        and returns a heatmap of the correlation coeffients
 577        (documents/tempfiles/correlation/heatmap_file.png)
 578        and a table containing the correlation coeffients
 579        and their p-values ( /data/prod/tmp/r_qtl/corre_table_file.txt).
 580  Ret: heatmap image file  and correlation output text file
 581  Args: None
 582  Side Effects:
 583  Example:
 584
 585 =cut
 586
 587 sub analyze_correlation
 588 {
 589     my $self   = shift;
 590     my $pop    = $self->get_object();
 591     my $pop_id = $self->get_object_id();
 592
 593     my $pheno_file      = $pop->phenotype_file($c);
 594     my $pheno_dir       = $c->config->{solqtl};
 595     my $temp_image_dir  = File::Spec->catfile($pheno_dir, "temp_images");
 596     my $corre_image_dir = File::Spec->catfile($temp_image_dir, "correlation");
 597     my $corre_temp_dir  = File::Spec->catfile($pheno_dir, "tempfiles");
 598     my $pheno_file_dir  = File::Spec->catfile($pheno_dir, "cache");
 599
 600     if (-s $pheno_file) {
 601         foreach my $dir ($corre_image_dir, $corre_temp_dir, $pheno_file_dir)
 602         {
 603             unless (-d $dir)
 604             {
 605                 mkpath ($dir, 0, 0755);
 606             }
 607         }
 608
 609         my (undef, $heatmap_file)     = tempfile( "heatmap_${pop_id}-XXXXXX",
 610                                               DIR      => $corre_temp_dir,
 611                                               SUFFIX   =>'.png',
 612                                               UNLINK   => 1,
 613                                             );
 614
 615         my (undef, $corre_table_file) = tempfile( "corre_table_${pop_id}-XXXXXX",
 616                                               DIR      => $corre_temp_dir,
 617                                               SUFFIX   => '.txt',
 618                                               UNLINK   => 1,
 619                                             );
 620
 621         my ( $corre_commands_temp, $corre_output_temp ) =
 622             map
 623         {
 624             my ( undef, $filename ) =
 625                 tempfile(
 626                     File::Spec->catfile(
 627                         CXGN::Tools::Run->temp_base($corre_temp_dir),
 628                         "corre_pop_${pop_id}-$_-XXXXXX"
 629                     ),
 630                     UNLINK =>0,
 631                 );
 632             $filename
 633         } qw / in out /;
 634
 635         {
 636             my $corre_commands_file = $c->path_to('/cgi-bin/phenome/correlation.r');
 637             copy( $corre_commands_file, $corre_commands_temp )
 638                 or die "could not copy '$corre_commands_file' to '$corre_commands_temp'";
 639         }
 640
 641         my $r_process = CXGN::Tools::Run->run_cluster(
 642             'R', 'CMD', 'BATCH',
 643             '--slave',
 644             "--args $heatmap_file $corre_table_file $pheno_file",
 645             $corre_commands_temp,
 646             $corre_output_temp,
 647             {
 648                 working_dir => $corre_temp_dir,
 649                 max_cluster_jobs => 1_000_000_000,
 650             },
 651             );
 652
 653         sleep 1 while $r_process->alive;
 654
 655         copy( $heatmap_file, $corre_image_dir )
 656             or die "could not copy $heatmap_file to $corre_image_dir";
 657
 658         $heatmap_file = fileparse($heatmap_file);
 659         $heatmap_file  = $c->generated_file_uri("correlation",  $heatmap_file);
 660
 661         return $heatmap_file, $corre_table_file;
 662     }
 663     else {
 664         return undef;
 665     }
 666
 667 }
 668
 669
 670
 671 =head2 display_correlation
 672
 673  Usage: my $corre_data = $self->display_correlation();
 674  Desc: used to display the output of the correlation analysis,
 675        including the heatmap, links for downloading the
 676        correlation coefficients and their p-values and
 677        a key table for the acronyms of the traits used
 678        in the correlation plot
 679  Ret: a scalar variable with what needs to be shown in the
 680       correlation section of the page
 681  Args: None
 682  Side Effects:
 683  Example:
 684
 685 =cut
 686
 687 sub display_correlation {
 688     my $self = shift;
 689     my $pop  = $self->get_object();
 690     my $pop_id = $self->get_object_id();
 691     my $corre_data;
 692
 693     #there seems to be a problem with the phenotype data of one population (pop id = 18),
 694     #causing problem to the R correlation analysis and thus crashing the pop page.
 695     #unitl I identify the problem, displaying the message below  in case the site is updated
 696     #before I identify the problem.
 697
 698     if ($pop_id == 18)
 699     {
 700         $corre_data = qq | Correlation analysis canno't be run for this population. |;
 701     }
 702     else
 703     {
 704         my ($heatmap_file, $corre_table_file) = $self->analyze_correlation();
 705
 706         my $heatmap_image = qq |<img alt="correlation heatmap image" src="$heatmap_file"/> |;
 707
 708         my @traits = $pop->get_cvterms();
 709         my @tr_acronym_table;
 710         my $name;
 711         foreach my $tr (@traits)
 712         {
 713             if ( $pop->get_web_uploaded )
 714             {
 715                 $name = $tr->get_name();
 716             }
 717             else
 718             {
 719             $name = $tr->get_cvterm_name();
 720             }
 721             my $tr_acronym= $pop->cvterm_acronym($name);
 722             push @tr_acronym_table, [ map { $_ } ( $tr_acronym, $name) ];
 723         }
 724
 725         my $acronym_key  = columnar_table_html(
 726                                            headings     => [ 'Acronym',  'Trait'],
 727                                            data         => \@tr_acronym_table,
 728                                            __alt_freq   => 2,
 729                                            __alt_width  => 1,
 730                                            __alt_offset => 3,
 731                                            __align      => 'l',
 732                                           );
 733
 734         my  $acronym_view = html_optional_show("key",
 735                                            'Show/hide acronym key',
 736                                            qq | $acronym_key |,
 737                                            0,
 738                                           );
 739
 740         $corre_data = $heatmap_image .  qq | <span><br/><br/>Download:<a href="correlation_download.pl?population_id=$pop_id&amp;corre_file=$corre_table_file">[Correlation coefficients and p-values table]</a> $acronym_view</span> |;
 741     }
 742     return $corre_data;
 743
 744 }