[Bio] / FigKernelPackages / display_related_genomes.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/display_related_genomes.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2, Sun Aug 15 20:10:00 2010 UTC revision 1.3, Tue Sep 22 22:34:56 2015 UTC
# Line 19  Line 19 
19  my $breakwidth = 3;  my $breakwidth = 3;
20    
21  #===============================================================================  #===============================================================================
22    #  display_related_genomes::display()
23    #
24    #  index  id  len | type  index  id | ...
25    #
26    #  $html = display_related_genomes( $contig_entries, $headings, $options )
27    #
28    #     contig_entries  = [ contig_entry, ... ]
29    #     contig_entry    = [ peg_entry, ... ]
30    #     peg_entry       = [ contig, index, id, len, mouseover, related_entries ]
31    #     related_engties = [ related_entry, ... ]
32    #     related_entry   = [ type, index, id, identity, mouseover ]
33    #     type            = <-> | -> | -    (bbh, best hit, or no hit)
34    #     mouseover       = [ pop_up_title_html, pop_up_body_html, href_url ];
35    #
36    #     headings        = [ heading, ... ] = column heading information
37    #     heading         = [ pop_up_title_html, pop_up_body_html, href_url ]
38    #
39    #  Options:
40    #
41    #     breakcolor =>  $html_color #  Color of genome separator (D = #dddddd)
42    #     breakwidth =>  $points     #  Width of genome separator (D = 3)
43    #     id_link    => \&function   #  Function that coverts an id to an html link
44    #     page       =>  $boolean    #  0 for invoking from CGI; 1 gives HTML page
45    #
46    #===============================================================================
47    sub display
48    {
49        my ( $contig_entries, $headings, $options ) = @_;
50        $contig_entries && ref ( $contig_entries ) eq 'ARRAY' && $headings && ref( $headings ) eq 'ARRAY'
51            or print STDERR "display_related_genomes requires contig_entries and headings\n"
52                and return '';
53        $options ||= {};
54    
55        $breakcolor  = $options->{ breakcolor } if $options->{ breakcolor };
56        $breakwidth  = $options->{ breakwidth } if $options->{ breakwidth };
57        my $color_by = $options->{ color_by } || 'identity';
58        my $page     = $options->{ page }     || 0;
59    
60        #  Genome names
61    
62        my ( $genome1, @genomes ) = map { $_->[0] } @$headings;
63    
64        my $gen_sep = "<TH BgColor=$breakcolor Width=$breakwidth></TH>";
65        my @genome_header = ( "  <TR>",
66                              join( "\n    $gen_sep\n", map { genome_column_head( $_ ) } @$headings ),
67                              "  </TR>"
68                            );
69    
70        #  Look at the data contig-by-contig:
71    
72        my @contigs;
73        my %n_genes;
74        foreach ( @$contig_entries )
75        {
76            my $contig = $_->[0]->[0];
77            push @contigs, $contig;
78            $n_genes{ $contig } = @$_;
79        }
80    
81        #  Build the contig navigation menu:
82    
83        my $contig_menu = join( '<BR />',
84                                "<B>Go to contig:</B>",
85                                map { "<A Href=\"#$_\">$_</A> - $n_genes{$_} genes" }
86                                    @contigs
87                              );
88    
89        my $contig_mouseover = mouseover( 'Contig navigation', 'Click for menu', $contig_menu, '', '' );
90    
91        #  Start writing the html:
92    
93        my @html;
94        if ($page)
95        {
96            push @html, "<HTML>",
97                        "<HEAD>",
98                        "<TITLE>$headings->[0]->[0] Genome comparisons</TITLE>",
99                        "</HEAD>",
100                        "",
101                        "<BODY>";
102        }
103        push @html, mouseover_JavaScript();
104    
105        my $tbl_cols = 4 * @$headings + 3;
106        push @html, "<TABLE Cols=$tbl_cols>\n";
107    
108        my $contig_entry;
109        foreach $contig_entry ( @$contig_entries )
110        {
111            my $contig = $contig_entry->[0]->[0];
112    
113            my ( $peg_entry, $genome_data );
114    
115            #  Genome names
116    
117            push @html, @genome_header;
118    
119            #  Column headers
120    
121            push @html, "  <TR>",
122                        "    <TH><A Name=$contig $contig_mouseover>Index</A></TH>",
123                        "    <TH>Id</TH>",
124                        "    <TH>Length</TH>";
125    
126            my $genome2;
127            foreach $genome2 ( @genomes )
128            {
129                push @html, "    <TH BgColor=$breakcolor></TH>",
130                            "    <TH>Match<BR />type</TH>",
131                            "    <TH>Index</TH>",
132                            "    <TH>Id</TH>";
133            }
134            push @html, "  </TR>\n";
135    
136            #  Contig data
137    
138            foreach $peg_entry ( @$contig_entry )  # per gene information
139            {
140                #  Write the HTML for each gene in the contig:
141    
142                my ( $g1, $id1, $len1, $mouseover, $genome_data ) = @$peg_entry;
143    
144                push @html, "  <TR Align=center>",
145                            "    <TD>$g1</TD>",
146                            linked_datum( $id1, undef, $mouseover ),
147                            "    <TD>$len1</TD>";
148    
149                my @g2 = @genomes;
150                my $genome2;
151                foreach my $info2 ( @$genome_data )
152                {
153                    my ( $t2, $g2, $id2, $f_id, $mouseover ) = @$info2;
154                    $genome2 = shift @g2;
155    
156                    if ( $g2 )
157                    {
158                        my $color;
159                        # Hue goes red, green, blue, red over the inverval 0 - 1
160                        # We want 0.003 -> 0.01 -> 0.03 -> 0.10 -> 0.3 -> 1
161                        # log( $diff ) / log( 10 ) is log10( $diff ); it starts at
162                        #     -3 for identity to 0 at 100% different.
163                        # -log( $diff ) / log( 10 ) starts at 3 and becomes 0 at 100% diff.
164                        # 2/9 of that takes the hue from blue to red at diff goes from 0 to 1.
165    
166                        my $diff = 1 - $f_id + 0.001;
167    
168                        $color = gjocolorlib::rgb2html(
169                                      gjocolorlib::hsb2rgb( -2/9 * log( $diff ) / log( 10 ), # hue
170                                                            $t2 eq '<->' ? 0.4 : 0.2,        # saturation
171                                                            1.0                              # brightness
172                                                          )
173                                                      );
174    
175                        push @html, $gen_sep,
176                                    "    <TD BgColor=$color>$t2</TD>",
177                                    "    <TD BgColor=$color>$g2</TD>",
178                                    linked_datum( $id2, $color, $mouseover );
179                    }
180                    else
181                    {
182                        push @html, $gen_sep,
183                                    "    <TD>$t2</TD>",
184                                    "    <TD>&nbsp;</TD>",
185                                    "    <TD>&nbsp;</TD>";
186                    }
187                }
188                push @html, "  </TR>";
189            }
190        }
191    
192        push @html, "</TABLE>";
193        if ($page)
194        {
195            push @html,"</BODY>","</HTML>";
196        }
197        return join( "\n", @html );
198    }
199    
200    
201    #===============================================================================
202  #  display_related_genomes  #  display_related_genomes
203  #  #
204  #  $html = display_related_genomes( $contig_entries, $headings, $options )  #  $html = display_related_genomes( $contig_entries, $headings, $options )
# Line 243  Line 423 
423  sub genome_column_head  sub genome_column_head
424  {  {
425      my ( $abbrev, $text, $link ) = @{ $_[0] };      my ( $abbrev, $text, $link ) = @{ $_[0] };
426      $link = $link ? " HRef=\"$link\" Target=\"$abbrev\""  : '';      $link = $link ? qq( HRef="$link" Target="$abbrev")  : '';
427      my $mouse = $text ? mouseover( $abbrev, $text )       : '';      my $mouse = $text ? mouseover( $abbrev, $text )       : '';
428      $abbrev = "<A$link>$abbrev</A>" if $link;      $abbrev = qq(<A$link>$abbrev</A>) if $link;
429      return "    <TH ColSpan=3$mouse>$abbrev</TH>";      qq(    <TH ColSpan=3$mouse>$abbrev</TH>);
430  }  }
431    
432    
# Line 261  Line 441 
441      my ( $datum, $color, $mouse ) = @_;      my ( $datum, $color, $mouse ) = @_;
442      my ( $id, $text, $link ) = ( $mouse && ref( $mouse ) eq 'ARRAY' ) ? @$mouse : ();      my ( $id, $text, $link ) = ( $mouse && ref( $mouse ) eq 'ARRAY' ) ? @$mouse : ();
443      $mouse = $text  ? mouseover( $id, $text || '&nbsp;' ) : '';      $mouse = $text  ? mouseover( $id, $text || '&nbsp;' ) : '';
444      $link  = $link  ? " HRef=$link Target='$id'"          : '';      $link  = $link  ? qq( HRef="$link" Target="$id")      : '';
445      $color = $color ? " BgColor=$color"                   : '';      $color = $color ? qq( BgColor=$color)                 : '';
446      $datum = "<A$link>$datum</A>" if $link;      $datum = qq(<A$link>$datum</A>) if $link;
447      return "    <TD$color$mouse>$datum</TD>";      qq(    <TD$color$mouse>$datum</TD>);
448  }  }
449    
450    

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3