lib/CXGN/Sunshine/Browser.pm

   1
   2 =head1 NAME
   3
   4 CXGN::Sunshine::Browser - a class that implements a network browser for SGN loci.
   5
   6 =head1 DESCRIPTION
   7
   8 =head1 AUTHOR(S)
   9
  10 Lukas Mueller <lam87@cornell.edu>
  11
  12 =head1 METHODS
  13
  14 This class implements the following methods:
  15
  16 =cut
  17
  18
  19
  20 use strict;
  21
  22 package CXGN::Sunshine::Browser;
  23
  24 use GD;
  25 use JSON;
  26 use Graph;
  27 use CXGN::DB::Object;
  28 use CXGN::Sunshine::Node;
  29 use CXGN::Phenome::Locus;
  30 #use CXGN::Phenome::Locus2Locus;
  31
  32
  33 use base qw | CXGN::DB::Object |;
  34
  35
  36 our $PI=3.1415692;
  37
  38 =head2 include_on_page
  39
  40  Usage:        CXGN::Sunshine::Browser->include_on_page("locus", $id)
  41  Desc:         includes the browser on the respective page
  42                by including its javascript code
  43  Ret:          nothing
  44  Args:         the type of object, and an object id
  45  Side Effects: prints the browser code to STDOUT
  46  Example:
  47
  48 =cut
  49
  50 sub include_on_page {
  51
  52
  53     my $type = shift;
  54     my $name = shift;
  55
  56
  57 return <<JAVASCRIPT;
  58
  59 <table><tr><td height="450" width="450"><div id=\"network_browser\" >\[loading...\]</div></td><td width="250"><div id="relationships_legend">[Legend]</div><br /><div id="level_selector">[Levels]</div></td></tr></table>
  60
  61     <script language="javascript" type="text/javascript">
  62
  63 //    document.write('HELLO FROM JAVASCRIPT');
  64
  65     var nb = new CXGN.Sunshine.NetworkBrowser();
  66
  67     nb.setLevel(2);
  68     nb.setType('$type');
  69     nb.setName('$name');
  70     nb.fetchRelationships();
  71     //nb.setHiddenRelationshipTypes('');
  72     nb.initialize();
  73
  74
  75
  76 //document.write("....ANOTHER HELLO FROM JS");
  77
  78
  79
  80 </script>
  81
  82 JAVASCRIPT
  83
  84 }
  85
  86
  87
  88 =head2 new
  89
  90  Usage:        my $browser = CXGN::Sunshine::Browser->new($dbh)
  91  Desc:         constructor
  92  Ret:          a CXGN::Sunshine::Browser object
  93  Args:         a database handle
  94  Side Effects: connects to the database
  95  Example:
  96
  97 =cut
  98
  99 sub new {
 100     my $class = shift;
 101     my $dbh = shift;
 102     my $self = $class->SUPER::new($dbh);
 103
 104     # set a standard image size
 105     #
 106     $self->set_image_width(400);
 107     $self->set_image_height(400);
 108     $self->set_level_depth(1);
 109
 110     $self->set_hide_relationships( () ) ;
 111
 112     $self->fetch_relationships();
 113
 114     $self->set_image(GD::Image->new($self->get_image_width(), $self->get_image_height(), 1));
 115
 116     $self->get_image()->filledRectangle(0, 0, $self->get_image_width(), $self->get_image_height(), $self->get_image()->colorAllocate(255, 255, 255));
 117
 118
 119
 120     return $self;
 121 }
 122
 123 =head2 accessors get_graph, set_graph
 124
 125  Usage:        $b->set_graph($graph)
 126  Desc:         The Graph object that this instance should
 127                work with.
 128  Property      a L<Graph> object
 129  Side Effects:
 130  Example:
 131
 132 =cut
 133
 134 sub get_graph {
 135   my $self = shift;
 136   return $self->{graph};
 137 }
 138
 139 sub set_graph {
 140   my $self = shift;
 141   $self->{graph} = shift;
 142 }
 143
 144
 145 =head2 build_graph
 146
 147  Usage:        $b->build_graph($ref_node_name, $ref_node_type, $graph)
 148  Desc:         builds the graph $graph for node ref_node_name, and the
 149                type $type.
 150  Ret:          nothing
 151  Args:
 152  Side Effects: the graph $graph is modified and database access is possible
 153                for certain types.
 154  Example:
 155
 156 =cut
 157
 158 sub build_graph {
 159     my $self = shift;
 160     my $ref_node_name = $self->get_ref_node_name();
 161     my $ref_node_type = $self->get_ref_node_type();
 162
 163     my $graph = Graph::Undirected->new();
 164
 165     # recursively get all the connection to the reference node.
 166
 167     $self->d("TYPE IS $ref_node_type. NAME IS $ref_node_name.\n");
 168     if ($ref_node_type eq "test") {
 169 #       $self->d("Getting test data...\n");
 170         $self->get_test_graph($graph);
 171     }
 172     elsif ($ref_node_type eq "locus") {
 173         $self->d("GETTING LOCUS INFORMATION...\n");
 174         $self->get_locus_graph($ref_node_name, $graph, $self->get_level_depth());
 175     }
 176     $self->set_graph($graph);
 177 }
 178
 179
 180 =head2 get_locus_graph
 181
 182  Usage:        called by build_graph() if graph type is 'locus'.
 183  Desc:         builds a graph in the Graph object (a Perl class).
 184  Ret:          nothing, but changes the datastructure in graph.
 185  Args:         a locus_id [int], a graph [Graph], and level [int]
 186                the level will determine how 'deep' the graph will be.
 187  Side Effects:
 188  Example:
 189
 190 =cut
 191
 192 sub get_locus_graph {
 193     my $self = shift;
 194     my $locus_id = shift;
 195     my $graph = shift;
 196     my $max_level = shift;
 197
 198     my $reference_locus = CXGN::Phenome::Locus->new($self->get_dbh(), $locus_id);
 199     my $reference_node = CXGN::Sunshine::Node->new($locus_id);
 200
 201     $reference_node->set_name($reference_locus->get_locus_symbol());
 202     $reference_node->set_unique_id($locus_id);
 203
 204     $self->add_node_list($reference_node);
 205
 206
 207     my (@loci) = ($locus_id);
 208     my (@related_loci);
 209     my %already_processed = ( );
 210     my %loci_cache = ();
 211 #    my %associations = ();
 212     my @loci_list = ();
 213     my %relationship_cache = ();
 214
 215     my $level = 1;
 216
 217     my %loci_list = ();
 218     my $continue = 1;
 219 #    foreach my $l (1..($level)) {
 220 #       $self->d("PROCESSING LEVEL $l...\n");
 221     while ($continue) {
 222
 223         foreach my $r (@loci) {
 224             %loci_list =();
 225             #$self->d("...processing locus $r\n");
 226
 227             if (exists($already_processed{$r})) { # ||
 228                 #( $r == $reference_node && $level ==1)) {
 229                 $self->d("......this locus was already processed. Skipping.\n");
 230                 next;
 231             }
 232
 233             if (! exists($loci_cache{$r})) {
 234                 $loci_cache{$r}  = CXGN::Phenome::Locus->new($self->get_dbh(), $r);
 235             }
 236
 237
 238             #######my @object_loci = $loci_cache{$r}->get_object_locus2locus_objects();
 239             my @locus_groups= $loci_cache{$r}->get_locusgroups();
 240
 241 #           print STDERR "HIDDEN RELTYPES: ".(join ", ", ($self->get_hide_relationships()));
 242 #           print STDERR "\n";
 243
 244
 245             # go through all loci and build a list with some meta information
 246             #
 247
 248             my %all_groups=();
 249
 250             foreach my $group (@locus_groups) {
 251                 if (!$self->relationship_hidden($group->get_relationship_id())) {
 252                     my @members=$group->get_locusgroup_members();
 253                     $all_groups{ $group->get_locusgroup_id() } =  $group;
 254                     foreach my $member(@members) {
 255                         my $member_id = $member->get_column('locus_id');
 256                         my $member_locus=CXGN::Phenome::Locus->new($self->get_dbh(), $member_id);
 257                         my @member_groups = $member_locus->get_locusgroups();
 258                         foreach my $mg (@member_groups) {
 259                             if (!defined $all_groups{ $mg->get_locusgroup_id() } ) {
 260                                 $all_groups{ $mg->get_locusgroup_id } = $mg;
 261                             }
 262                         }
 263                     }
 264                 }else {
 265                     $self->d("Relationship ".($group->get_relationship_id())." currently hidden!\n");
 266                 }
 267             }
 268             foreach my $locusgroup_id( keys %all_groups ) {
 269                 my $group= $all_groups{$locusgroup_id};
 270                 if (!$self->relationship_hidden($group->get_relationship_id())) {
 271
 272                     my @members=$group->get_locusgroup_members();
 273                     foreach my $member (@members) {
 274                         my $member_id = $member->get_column('locus_id');
 275                         if ($member_id == $locus_id) { next() ; }
 276                         my @list = ($member->get_column('locus_id'), $group->get_relationship_id());
 277                         $loci_list{ join "-", @list } = \@list;
 278                     }
 279                 }
 280             }
 281
 282             foreach my $a (values %loci_list) {
 283
 284
 285                 if (!exists($loci_cache{$a->[0]})) {
 286                     $loci_cache{$a->[0]} = CXGN::Phenome::Locus->new($self->get_dbh(), $a->[0]);
 287
 288                 }
 289
 290                 if (!defined($loci_cache{$a->[0]}->get_locus_id())) {
 291                     #    die "The locus (".($a->[0]).") is not defined... Skipping.\n";
 292                     next();
 293                 }
 294
 295                 my $node = CXGN::Sunshine::Node->new($loci_cache{$a->[0]}->get_locus_id());
 296
 297                 $node->set_level($level);
 298                 $node->set_name($loci_cache{$a->[0]}->get_locus_symbol());
 299                 $self->add_node_list($node);
 300
 301                 $node->set_unique_id($loci_cache{$a->[0]}->get_locus_id());
 302
 303
 304
 305                 $graph->add_vertex($loci_cache{$a->[0]}->get_locus_id());
 306
 307                 if (!exists($loci_cache{$r}) || !defined($loci_cache{$r}->get_locus_id())) {
 308                     die  "Locus $r does not exist... \n";
 309                     #next();
 310                 }
 311
 312                 # check if either of the nodes fall outside of the currently viewable levels
 313                 #
 314                 if ($level <= ($max_level) || $self->get_node($loci_cache{$a->[0]}->get_locus_id())->get_level() <=$max_level) {
 315                     $self->d("Generating the edge from ".($loci_cache{$a->[0]}->get_locus_symbol())." and ".($loci_cache{$r}->get_locus_symbol())."\n");
 316                     $graph->add_edge($loci_cache{$r}->get_locus_id(), $loci_cache{$a->[0]}->get_locus_id());
 317                     $graph->set_edge_attribute($loci_cache{$r}->get_locus_id(), $loci_cache{$a->[0]}->get_locus_id(), "relationship_type", $a->[1]);
 318                 }
 319             }
 320             $already_processed{$r}=1;
 321         }
 322
 323         $continue = @loci != values(%loci_list);
 324         $level++;
 325
 326         @loci =  map { $_->[0] } values(%loci_list) ;
 327     }
 328 }
 329
 330 =head2 fetch_relationships
 331
 332  Usage: my $json = $b->fetch_relationships()
 333  Desc:         retrieves all relationship ids from the database (cvterms)
 334                and returns them as a json string.
 335  Ret:
 336  Args: none
 337  Side Effects:
 338  Example:
 339
 340 =cut
 341
 342
 343 sub fetch_relationships {
 344     my $self = shift;
 345     my $q = "SELECT distinct(cvterm_id), locusgroup.locusgroup_id FROM phenome.locusgroup JOIN cvterm on(locusgroup.relationship_id=cvterm_id)";
 346     my $h = $self->get_dbh()->prepare($q);
 347     $h->execute();
 348
 349     while (my ($cvterm_id, $lg_id) = $h->fetchrow_array()) {
 350         $self->{relationship_ids}->{$lg_id}= CXGN::Chado::Cvterm->new($self->get_dbh(), $cvterm_id);
 351     }
 352 }
 353
 354
 355 =head2 get_relationship_menu_info
 356
 357  Usage:
 358  Desc:
 359  Ret:
 360  Args:
 361  Side Effects:
 362  Example:
 363
 364 =cut
 365
 366 sub get_relationship_menu_info {
 367     my $self = shift;
 368     my $q = "SELECT DISTINCT(relationship_id), cvterm_id FROM phenome.locusgroup JOIN public.cvterm on (locusgroup.relationship_id=cvterm_id)";
 369     my $h = $self->get_dbh()->prepare($q);
 370     $h->execute();
 371     my @relationship_menu_info = ();
 372     while (my ($relationship_id, $cvterm_id) = $h->fetchrow_array()) {
 373         my $cvterm = CXGN::Chado::Cvterm->new($self->get_dbh(), $cvterm_id);
 374         push @relationship_menu_info, {"id"=>$relationship_id, "name"=>$cvterm->get_cvterm_name(), "color"=>join(",",$self->get_relationshiptype_color($relationship_id))};
 375     }
 376
 377
 378     my $json = JSON->new();
 379     my $jobj = $json->objToJson(\@relationship_menu_info);
 380     return $jobj;
 381 }
 382
 383 =head2 relationship_hidden
 384
 385  Usage:        my $hidden = $b->relationship_hidden($relationship_id)
 386  Desc:         returns true if the relationship with relationship_id
 387                $relationship_id is hidden, false otherwise.
 388  Ret:
 389  Args:
 390  Side Effects:
 391  Example:
 392
 393 =cut
 394
 395 sub relationship_hidden {
 396     my $self = shift;
 397     my $id = shift;
 398     foreach my $r ($self->get_hide_relationships()) {
 399         if ($r == $id) {
 400             return 1;
 401         }
 402     }
 403     return 0;
 404 }
 405
 406
 407 =head2 accessors get_hide_relationships, set_hide_relationships
 408
 409  Usage:        $b->set_hide_relationships($relationship_id1, ... )
 410  Desc:         the relationships with $relationship_id1 and other
 411                listed relationships will not be shown on the browser.
 412  Property
 413  Side Effects: the specified list of relationship types will be
 414                hidden in the browser. The list of relationship types
 415                will have the corresponding relationships unchecked.
 416  Example:
 417
 418 =cut
 419
 420 sub get_hide_relationships {
 421   my $self = shift;
 422   return @{$self->{hide_relationships}};
 423 }
 424
 425 sub set_hide_relationships {
 426   my $self = shift;
 427   @{$self->{hide_relationships}} = @_;
 428 }
 429
 430 sub get_pathway_graph {
 431     my $self = shift;
 432     my $graph = shift;
 433
 434     open (F, "data/lycocyc_dump.txt");
 435
 436     while (<F>) {
 437         chomp;
 438         my ($pathway, $ec, $reaction, $unigene) = split /\t/;
 439
 440     }
 441
 442 }
 443
 444
 445 sub get_test_graph {
 446     my $self = shift;
 447     my $graph = shift;
 448
 449     my @connections = ();
 450
 451     my $center = CXGN::Sunshine::Node->new("0");
 452     $self->add_node_list($center);
 453     for my $i (1..5) {
 454         $connections[$i] = CXGN::Sunshine::Node->new($i);
 455
 456         $self->add_node_list($connections[$i]);
 457         $graph->add_vertex($i);
 458
 459         $graph->add_edge($i, $center->get_unique_id());
 460         if ($i>1)  { $graph->add_edge($i, $i-1);}
 461     }
 462
 463     for my $i (6..10) {
 464         $connections[$i] = CXGN::Sunshine::Node->new($i);
 465         $self->add_node_list($connections[$i]);
 466         $graph->add_vertex($i);
 467         $graph->add_edge($i, $i-5);
 468     }
 469 }
 470
 471 # =head2 get_locus2locus_connections
 472
 473 #  Usage:
 474 #  Desc:
 475 #  Ret:
 476 #  Args:
 477 #  Side Effects:
 478 #  Example:
 479
 480 # =cut
 481
 482 # sub get_locus2locus_connections {
 483 #     my $self = shift;
 484 #     my $graph = shift;
 485 #     my $node = shift;
 486 #     my @connections = $node->get_associated_loci();
 487 #     $graph->add_vertex($node->get_locus_id());
 488 #     $self->add_node_list($node);
 489
 490 #     my @more_connections = ();
 491 #     foreach my $c (@connections) {
 492 #        @more_connections = $self->get_locus2locus_connections($graph, $c);
 493 #     }
 494 #     @connections = (@connections, @more_connections);
 495 #     return @connections;
 496 # }
 497
 498 =head2 add_node_list
 499
 500  Usage:
 501  Desc:
 502  Ret:
 503  Args:
 504  Side Effects:
 505  Example:
 506
 507 =cut
 508
 509 sub add_node_list {
 510     my $self = shift;
 511     my $node = shift;
 512     if (exists($self->{nodes}->{$node->get_unique_id()})) {
 513         #warn "Node named ".$node->get_unique_id()." already exists!";
 514         return 1;
 515     }
 516     $self->{nodes}->{$node->get_unique_id()}=$node;
 517 }
 518
 519 =head2 get_node_list
 520
 521  Usage:
 522  Desc:
 523  Ret:
 524  Args:
 525  Side Effects:
 526  Example:
 527
 528 =cut
 529
 530
 531 sub get_node_list {
 532     my $self = shift;
 533     return values(%{$self->{nodes}});
 534 }
 535
 536 =head2 get_node
 537
 538  Usage:
 539  Desc:
 540  Ret:
 541  Args:
 542  Side Effects:
 543  Example:
 544
 545 =cut
 546
 547 sub get_node {
 548     my $self  =shift;
 549     my $id = shift;
 550     return $self->{nodes}->{$id};
 551 }
 552
 553
 554 =head2 get_level_depth, set_level_depth
 555
 556  Usage:
 557  Desc:
 558  Ret:
 559  Args:
 560  Side Effects:
 561  Example:
 562
 563 =cut
 564
 565 sub get_level_depth {
 566   my $self=shift;
 567   return $self->{level_depth};
 568
 569 }
 570
 571 sub set_level_depth {
 572   my $self=shift;
 573   $self->{level_depth}=shift;
 574 }
 575
 576 =head2 accessors get_reference_object, set_reference_object
 577
 578  Usage:
 579  Desc:
 580  Property
 581  Side Effects:
 582  Example:
 583
 584 =cut
 585
 586 sub get_reference_object {
 587   my $self = shift;
 588   return ($self->{reference_object_id}, $self->{reference_object_type});
 589 }
 590
 591 sub set_reference_object {
 592   my $self = shift;
 593   my $id = shift;
 594   my $type = shift;
 595   $self->{reference_object_id} = $id;
 596   $self->{reference_object_type} = $type;
 597 }
 598
 599
 600 =head2 accessors get_reference_node, set_reference_node
 601
 602  Usage:
 603  Desc:
 604  Property
 605  Side Effects:
 606  Example:
 607
 608 =cut
 609
 610 sub get_reference_node {
 611   my $self = shift;
 612   return $self->{reference_node};
 613 }
 614
 615 sub set_reference_node {
 616   my $self = shift;
 617   my $node = shift;
 618
 619   # return an error if the node is not part of the graph
 620   if (!exists($self->{nodes}->{$node->get_unique_id()})) {
 621       return 1;
 622   }
 623   $self->{reference_node} = $node;
 624
 625 }
 626
 627
 628
 629 =head2 generate_page
 630
 631  Usage:
 632  Desc:
 633  Ret:
 634  Args:
 635  Side Effects:
 636  Example:
 637
 638 =cut
 639
 640 sub generate_page {
 641     my $self = shift;
 642     my $image = shift;
 643
 644
 645 }
 646
 647 =head2 layout
 648
 649  Usage:        $b->layout()
 650  Desc:         lays out the graph
 651  Ret:          nothing
 652  Args:         none
 653
 654 =cut
 655
 656 sub layout {
 657     my $self = shift;
 658
 659     # get the smaller dimension
 660     my $dimension = $self->get_image_height();
 661     if ($self->get_image_width() < $self->get_image_height()) {
 662         $dimension = $self->get_image_width();
 663     }
 664
 665     # define the positions of all the other nodes.
 666     my $radius = $dimension / $self->get_level_depth() / 2.5;
 667     $self->set_radius($radius);
 668     my @n = $self->get_graph()->neighbours($self->get_reference_node()->get_unique_id());
 669
 670     $self->d("Checking graph...\n");
 671     foreach my $n (@n) {
 672         $self->d("Retrieved neighbour $n\n");
 673         if ($n eq $self->get_reference_node()->get_unique_id()) {
 674             die "The reference node is among the linked nodes, you fool!\n";
 675         }
 676     }
 677
 678     $self->calculate_nodes_by_level();
 679
 680     # define the position of the reference node
 681     #
 682     $self->get_reference_node()->set_X(int($self->get_image_width()/2));
 683     $self->get_reference_node()->set_Y(int($self->get_image_height()/2));
 684
 685     # deal with the nodes on the other levels
 686     #
 687     foreach my $level (0..$self->get_level_depth()) {
 688
 689         my @n = $self->get_nodes_by_level($level);
 690
 691         #print STDERR "Layout: level $level, laying out nodes ".(join " ", @n)."\n";
 692
 693         for (my $i=0; $i<@n; $i++) {
 694
 695             # calculate the angle as the circumference of the circle divided by n,
 696             # and adding a little offset to each level so that we don't get
 697             # exact alignments on the same grid (lines cross too much and make
 698             # the whole picture less clear)
 699             #
 700             my $angle = (2 * $PI * $i + $level * $level * 0.1 * $PI )/ scalar(@n); #
 701             my ($x, $y) = $self->deg2coords($radius * $level, $angle);
 702
 703             $self->get_node($n[$i])->set_X($x + int($self->get_image_width()/2));
 704             $self->get_node($n[$i])->set_Y($y + int($self->get_image_height()/2));
 705             #print STDERR "Node $i:\n";
 706             #print STDERR "X: ".$self->get_node($n[$i])->get_X()."\n";
 707             #print STDERR "Y: ".$self->get_node($n[$i])->get_Y()."\n";
 708         }
 709     }
 710 }
 711
 712
 713 =head2 calculate_nodes_by_level
 714
 715  Usage:        $b->calculate_nodes_by_level()
 716  Desc:         calculates which nodes are on which level
 717                the levels are defined as containing loci with
 718                direct relationships to the previous level. Level 0
 719                is the reference entity.
 720                The nodes on each level calculated here can be
 721                retrieved using get_nodes_by_level() (see below).
 722  Ret:          nothing
 723  Args:         none
 724  Side Effects:
 725  Example:
 726
 727 =cut
 728
 729 sub calculate_nodes_by_level {
 730     my $self = shift;
 731
 732     my $level = $self->get_level_depth();
 733
 734     my $ref = $self->get_reference_node()->get_unique_id();
 735
 736     my %previous_level_nodes = ($ref => 1);
 737
 738     my @level_nodes = (); # an array for each level, containing a hash for the elements
 739
 740     $level_nodes[0]->{$ref} =1;
 741
 742     foreach my $l (1..$level) {
 743         #print STDERR "Generating the unique nodes for level $l...\n";
 744
 745         foreach my $n (keys (%{$level_nodes[$l-1]})) {
 746             foreach my $neighbor ($self->get_graph()->neighbours($n)) {
 747                 #print STDERR "NEIGHBOR of $n is $neighbor\n";
 748                 $level_nodes[$l]->{$neighbor}=1;
 749             }
 750         }
 751
 752         # remove the nodes that occur in the previous levels
 753         foreach my $k (keys %previous_level_nodes) {
 754             if (exists($level_nodes[$l]->{$k})) {
 755                 delete($level_nodes[$l]->{$k});
 756             }
 757         }
 758
 759 #       # add this level to the previous level nodes
 760 #       # to exclude relationships in the next iteration
 761         foreach my $k (keys(%{$level_nodes[$l]})) {
 762             $previous_level_nodes{$k}=1;
 763         }
 764
 765     }
 766     $self->{nodes_by_level} = \@level_nodes;
 767     %{$self->{all_nodes}} = %previous_level_nodes;
 768
 769     # reorder the current level of the graph such that nodes with
 770     # connections to nodes of the previous level are close the those
 771     # nodes
 772     #
 773
 774    #  foreach my $l (0..$level-1) {
 775 #       #foreach my $x (1..2) {
 776 #       if ($l>=1) {
 777 #           for(my $m=0; $m<@{$nodes->[$l]}; $m++) {
 778 #               for (my $n=0; $n<@{$nodes->[$l]}; $n++) {
 779 #                   if ($self->get_graph()->has_edge($nodes->[$l]->[$m],
 780 #                                                    $nodes->[$l+1]->[$n]
 781 #                                                    && ($n !=$m ))) {
 782 #                       print STDERR "Swapping nodes $nodes->[$l]->[$m] and $nodes->[$l]->[$n]...\n";
 783 #                       ($nodes->[$l]->[$n], $nodes->[$l]->[$m]) =
 784 #                           ($nodes->[$l]->[$m], $nodes->[$l]->[$n]);
 785
 786 #                   }
 787 #               }
 788 #               @{$self->{nodes_by_level}->[$l]}=@{$nodes->[$l]};
 789 #           }
 790
 791 #       }
 792 #     }
 793 }
 794
 795
 796 =head2 get_nodes_by_level
 797
 798  Usage:        my @nodes = $b->get_nodes_by_level($level)
 799  Desc:         returns the nodes that belong to level $level.
 800  Ret:          a list of CXGN::Sunshine::Node objects
 801  Args:         a level [int]
 802
 803 =cut
 804
 805
 806
 807 sub get_nodes_by_level {
 808     my $self = shift;
 809     my $level = shift;
 810     if (!exists($self->{nodes_by_level}->[$level])) {
 811         $self->{nodes_by_level}->[$level] = {};
 812     }
 813     return keys %{$self->{nodes_by_level}->[$level]};
 814 }
 815
 816 =head2 accessors get_previously_clicked_nodes, set_previously_clicked_nodes
 817
 818  Usage:         [not yet implemented]
 819  Desc:
 820  Property
 821  Side Effects:
 822  Example:
 823
 824 =cut
 825
 826 sub get_previously_clicked_nodes {
 827   my $self = shift;
 828   return @{$self->{previously_clicked_nodes}};
 829 }
 830
 831 sub set_previously_clicked_nodes {
 832   my $self = shift;
 833   @{$self->{previously_clicked_nodes}} = @_;
 834 }
 835
 836 =head2 accessors get_hilited_nodes, set_hilited_nodes
 837
 838  Usage:        [ not yet implemented]
 839  Desc:
 840  Property
 841  Side Effects:
 842  Example:
 843
 844 =cut
 845
 846 sub get_hilited_nodes {
 847   my $self = shift;
 848   return $self->{hilited_nodes};
 849 }
 850
 851 sub set_hilited_nodes {
 852   my $self = shift;
 853   $self->{hilited_nodes} = shift;
 854 }
 855
 856 =head2 function get_relationshiptype_color()
 857
 858  Usage:        ($r, $g, $b) = $b->get_relationshiptype_color($rel)
 859  Desc:         returns the color in red, green and blue components
 860                used for the relationshiptype given by $rel.
 861  Ret:          three values defining a color
 862  Args:         the relationshiptype_id [int]
 863
 864 =cut
 865
 866 sub get_relationshiptype_color {
 867     my $self = shift;
 868     my $relationship_id = shift;
 869
 870
 871     my %color = ( 39638 => [ 255, 0, 0 ],
 872                   39639 => [ 0, 255, 0 ],
 873                   39640 => [ 0, 0, 255 ],
 874                   39642 => [ 255, 255, 0 ],
 875                   39649 => [ 0, 255, 255 ],
 876                   39650 => [ 255, 0, 255 ],
 877                   );
 878     if (!defined($color{$relationship_id})) { return (0, 0, 0); }
 879     return @{$color{$relationship_id}};
 880 }
 881
 882
 883
 884 =head2 function render()
 885
 886  Usage:
 887  Desc:
 888  Ret:
 889  Args:
 890  Side Effects:
 891  Example:
 892
 893 =cut
 894
 895 sub render {
 896     my $self = shift;
 897
 898     my $reference_node = $self->get_reference_node();
 899     $reference_node->render($self->get_image());
 900
 901     my $gray = $self->get_image()->colorAllocate(200,200,200);
 902     my $black = $self->get_image()->colorAllocate(0, 0, 0);
 903     my $blue = $self->get_image()->colorAllocate(0, 0, 255);
 904
 905     my @include_nodes = ();
 906     foreach my $level (0..$self->get_level_depth()) {
 907         my @nodes = $self->get_nodes_by_level($level);
 908     }
 909
 910     my @edges = $self->get_graph()->edges();
 911     foreach my $c (@edges) {
 912
 913         my ($start, $end) = ($c->[0], $c->[1]);
 914
 915         my $start_node = $self->get_node($start);
 916         my $end_node = $self->get_node($end);
 917
 918         if (!$start_node || !$end_node) {
 919             die "$start and /or  $end don't exist!\n";
 920
 921         }
 922         my $relationship_id = $self->get_graph()->get_edge_attribute($start_node->get_unique_id(), $end_node->get_unique_id(), "relationship_type");
 923         #print STDERR "RELATIONSHIP_ID = $relationship_id\n";
 924
 925
 926
 927         my $color = $self->get_image()->colorAllocate($self->get_relationshiptype_color($relationship_id ));
 928         $self->get_image()->setAntiAliased($color);
 929         $self->get_image()->line($start_node->get_X(),
 930                                  $start_node->get_Y(),
 931                                  $end_node->get_X(),
 932                                  $end_node->get_Y(),
 933                                  gdAntiAliased);
 934
 935     }
 936
 937     foreach my $level (0..$self->get_level_depth()) {
 938         #print STDERR "Rendering level $level...\n";
 939
 940
 941         $self->get_image->arc($self->get_reference_node()->get_X(),
 942                               $self->get_reference_node()->get_Y(),
 943                               2 * $level * $self->get_radius(),
 944                               2 * $level * $self->get_radius(),
 945                               0,
 946                               360,
 947                               $gray
 948
 949                 );
 950
 951         foreach my $n ($self->get_nodes_by_level($level)) {
 952             my $node = $self->get_node($n);
 953             my $unique_id = $node->get_unique_id();
 954             my $ref_node_type = $self->get_ref_node_type();
 955             my $show_levels = $self->get_level_depth();
 956             my $hidden_relationships = join ", ", $self->get_hide_relationships();
 957             if (!$hidden_relationships) { $hidden_relationships=0; }
 958             $node->set_url("javascript:nb.getImage($unique_id, '$ref_node_type' , $show_levels, $hidden_relationships)");
 959             #print STDERR " [$level]: node node\n";
 960             $node->render($self->get_image());
 961         }
 962
 963     }
 964
 965 }
 966
 967
 968 sub get_image_map {
 969     my $self = shift;
 970     my $map_name = shift;
 971
 972     my $map = qq { <map name="$map_name" > };
 973     foreach my $n ($self->get_node_list()) {
 974         $map .= $n->get_image_map() ."\n";
 975     }
 976     $map .= qq { </map>\n };
 977     return $map;
 978 }
 979
 980 sub render_string {
 981     my $self =shift;
 982     $self->render();
 983
 984     return $self->get_image()->png();
 985 }
 986
 987 sub render_png {
 988     my $self = shift;
 989     my $filename = shift;
 990
 991     $self->render();
 992     my $png = $self->get_image->png();
 993
 994     open (my $F, ">$filename") || die "Can't open $filename";
 995     print F $png;
 996     close(F);
 997 }
 998
 999 =head2 accessors get_radius, set_radius
1000
1001  Usage:
1002  Desc:
1003  Property
1004  Side Effects:
1005  Example:
1006
1007 =cut
1008
1009 sub get_radius {
1010   my $self = shift;
1011   return $self->{radius};
1012 }
1013
1014 sub set_radius {
1015   my $self = shift;
1016   $self->{radius} = shift;
1017 }
1018
1019 =head2 accessors get_image_width, set_image_width
1020
1021  Usage:
1022  Desc:
1023  Property
1024  Side Effects:
1025  Example:
1026
1027 =cut
1028
1029 sub get_image_width {
1030   my $self = shift;
1031   return $self->{image_width};
1032 }
1033
1034 sub set_image_width {
1035   my $self = shift;
1036   $self->{image_width} = shift;
1037 }
1038
1039 =head2 accessors get_image_height, set_image_height
1040
1041  Usage:
1042  Desc:
1043  Property
1044  Side Effects:
1045  Example:
1046
1047 =cut
1048
1049 sub get_image_height {
1050   my $self = shift;
1051   return $self->{image_heigth};
1052 }
1053
1054 sub set_image_height {
1055   my $self = shift;
1056   $self->{image_heigth} = shift;
1057 }
1058
1059
1060 =head2 accessors get_image, set_image
1061
1062  Usage:
1063  Desc:
1064  Property
1065  Side Effects:
1066  Example:
1067
1068 =cut
1069
1070 sub get_image {
1071   my $self = shift;
1072   return $self->{image};
1073 }
1074
1075 sub set_image {
1076   my $self = shift;
1077   $self->{image} = shift;
1078 }
1079
1080 =head2 deg2coords
1081
1082  Usage:
1083  Desc:
1084  Ret:
1085  Args:
1086  Side Effects:
1087  Example:
1088
1089 =cut
1090
1091 sub deg2coords {
1092     my $self = shift;
1093     my $radius = shift;
1094     my $degrees = shift;
1095
1096     my $x = sin($degrees)* $radius;
1097     my $y = cos($degrees)* $radius;
1098
1099     return ($x, $y);
1100
1101 }
1102
1103 =head2 accessors get_ref_node_name, set_ref_node_name
1104
1105  Usage:
1106  Desc:
1107  Property
1108  Side Effects:
1109  Example:
1110
1111 =cut
1112
1113 sub get_ref_node_name {
1114   my $self = shift;
1115   return $self->{ref_node_name};
1116 }
1117
1118 sub set_ref_node_name {
1119   my $self = shift;
1120   $self->{ref_node_name} = shift;
1121 }
1122
1123 =head2 accessors get_ref_node_type, set_ref_node_type
1124
1125  Usage:
1126  Desc:
1127  Property
1128  Side Effects:
1129  Example:
1130
1131 =cut
1132
1133 sub get_ref_node_type {
1134   my $self = shift;
1135   return $self->{ref_node_type};
1136 }
1137
1138 sub set_ref_node_type {
1139   my $self = shift;
1140   $self->{ref_node_type} = shift;
1141 }
1142
1143
1144 return 1;