[Bio] / FigWebServices / SimBlockDisplay.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/SimBlockDisplay.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (view) (download)

1 : parrello 1.1 #!/usr/bin/perl -w
2 : olson 1.3 #
3 :     # Copyright (c) 2003-2006 University of Chicago and Fellowship
4 :     # for Interpretations of Genomes. All Rights Reserved.
5 :     #
6 :     # This file is part of the SEED Toolkit.
7 : parrello 1.4 #
8 : olson 1.3 # The SEED Toolkit is free software. You can redistribute
9 :     # it and/or modify it under the terms of the SEED Toolkit
10 : parrello 1.4 # Public License.
11 : olson 1.3 #
12 :     # You should have received a copy of the SEED Toolkit Public License
13 :     # along with this program; if not write to the University of Chicago
14 :     # at info@ci.uchicago.edu or the Fellowship for Interpretation of
15 :     # Genomes at veronika@thefig.info or download a copy from
16 :     # http://www.theseed.org/LICENSE.TXT.
17 :     #
18 :    
19 : parrello 1.1
20 :     BEGIN {
21 :     # Print the HTML header.
22 :     print "CONTENT-TYPE: text/html\n\n";
23 :     }
24 :    
25 :     =head1 Similarity Block Display
26 :    
27 :     This script processes input from the C<SimBlockForm.cgi> script's web page and
28 :     produces lists of which genomes are in set 1 or set 2 and which blocks are in
29 :     set 1, set 2, or both genome sets. The user can select a particular block in
30 :     one of the columns and click the appropriate button to generate an alignment
31 :     display in the embedded frame below the block lists.
32 :    
33 : parrello 1.4 Common blocks will be displayed in red if they have snip differences. A I<snip
34 :     difference> is a column in which the contents for set 0 are different from the
35 :     contents for set 1. So, for example, if column 6 is always A or G for set 0 and
36 :     always T for set 1, there is a snip difference. The snip difference is therefore
37 :     a much stronger condition than merely having different values in a column. If
38 :     column 6 contained A and G in set 0 and only A in set 1, it would not be a snip
39 :     difference, because A occurs in both sets.
40 :    
41 :     When a block is selected for display in the lower part of the form, the snip
42 :     differences are shown in a table. Therefore, that table will be empty unless
43 :     the block name is displayed in red.
44 :    
45 :     At the bottom of the page, an alignment of the snips in the common blocks
46 :     is displayed. If this alignment is sufficiently large, it will not show up
47 :     properly in Firefox.
48 :    
49 : parrello 1.1 For debugging purposes, you can specify the B<Trace> parameter to
50 : parrello 1.4 set the tracing level. So, for example,
51 : parrello 1.1
52 : parrello 1.6 http://myseedurl/CGI/SimBlockDisplay.cgi?Trace=3
53 : parrello 1.1
54 :     runs the standard processing script at a trace level of 3. Normally, only the
55 :     script itself and B<Tracer> tracing is active; however, you can activate other tracing modules
56 :     by appending them to the trace level. Thus,
57 :    
58 : parrello 1.6 http://myseedurl/CGI/SimBlockDisplay.cgi?Trace=3%20SimBlocks%20ERDBObject
59 : parrello 1.1
60 :     activates tracing for the similarity block module (C<SimBlocks.pm>) and the data
61 : parrello 1.5 base object (C<ERDBObject.pm>).
62 : parrello 1.1
63 :     =cut
64 :    
65 :     use strict;
66 :     use CGI;
67 :     use Tracer;
68 :     use PageBuilder;
69 :     use SimBlocks;
70 :    
71 :     # Get the CGI parameters.
72 : parrello 1.4 my ($query, $varHash) = ScriptSetup();
73 :     # Do this next part safely.
74 :     eval {
75 :     # Next we get the list of genomes in each set. These come from the radio
76 :     # buttons on the incoming form. Basically, we look for any option whose value
77 :     # is "set0" or "set1", and put it in the appropriate list. To make this process
78 :     # simpler, we set up a hash to contain the results.
79 :     my %sets = ( set0 => [], set1 => [] );
80 :     my @params = $query->param;
81 :     for my $param (@params) {
82 :     my $parmValue = $query->param($param);
83 :     if (exists $sets{$parmValue}) {
84 :     push @{$sets{$parmValue}}, "$param";
85 :     }
86 : parrello 1.1 }
87 : parrello 1.4 # Set up the attribute for the blocks with snip differences.
88 :     my $snipAttribute = { class => 'snippy' };
89 :     # The genome IDs are converted to list options in the upper list boxes.
90 :     for my $setID (keys %sets) {
91 :     # Get the list of values for this set.
92 :     my $valueList = $sets{$setID};
93 :     # Get its length.
94 :     my $valueCount = @{$valueList};
95 :     # Make sure the length is at least 2. Otherwise, the scrolling list becomes a
96 :     # combo box.
97 :     if ($valueCount < 2) {
98 :     $valueCount = 2;
99 :     }
100 :     # Build a multi-selection scrolling list big enough to show all the genome IDs. Note
101 :     # that we pre-select every element.
102 :     $varHash->{"${setID}GenomeIDs"} = $query->scrolling_list("${setID}Genomes", $valueList,
103 :     $valueList, $valueCount, 1);
104 :     }
105 :     # Now we create the similarity block object.
106 :     my $simBlocks = SimBlocks->new();
107 :     Trace("Comparing genome sets.") if T(1);
108 :     # Get a comparison of the genome sets.
109 :     my %blocks;
110 :     ($blocks{set0}, $blocks{set1}, $blocks{both}) = $simBlocks->CompareGenomes($sets{set0},
111 :     $sets{set1});
112 :     Trace("Formatting lists.") if T(1);
113 :     # Use the results to generate the scrolling lists for the similarity blocks. Our approach
114 :     # here is very much like what we did earlier for the genome IDs, but we put a maximum of
115 :     # 50 on the display size of each list.
116 :     for my $setID (keys %blocks) {
117 :     # Get the list of blocks for this set.
118 :     my $valueHash = $blocks{$setID};
119 :     my @valueList = sort keys %{$valueHash};
120 :     # Compute the number of blocks.
121 :     my $valueCount = @valueList;
122 :     $varHash->{"${setID}Count"} = $valueCount;
123 :     # Constrain it to compute the list height.
124 :     if ($valueCount > 50) {
125 :     $valueCount = 50;
126 :     } elsif ($valueCount < 2) {
127 :     $valueCount = 2;
128 :     }
129 :     # Create a hash to map block IDs to their descriptive names.
130 :     my %labelMap = ();
131 :     # Create a hash for the list box attributes. This hash will be empty for
132 :     # everything but the both-list.
133 :     my %attributes = ();
134 :     # Loop through the blocks, counting snip differences and associating labels.
135 :     my $snipCount = 0;
136 :     for my $blockID (@valueList) {
137 :     # If this is the both-list, we need to count the snip differences.
138 :     if ($setID eq "both") {
139 :     # Get the snip differences.
140 :     my %snipHash = $simBlocks->SnipScan($blockID, $sets{set0}, $sets{set1});
141 :     my $snipDelta = (keys %snipHash);
142 :     # If snip differences were found, we need to record the fact.
143 :     if ($snipDelta > 0) {
144 :     # Count the new snips.
145 :     $snipCount += $snipDelta;
146 :     # Highlight the block.
147 :     $attributes{$blockID} = $snipAttribute;
148 :     }
149 :     }
150 :     # Regardless of which list it is, we need to store the label.
151 :     ($labelMap{$blockID}) = $valueHash->{$blockID}->Value('GroupBlock(description)');
152 :     }
153 :     # If this is the both-list, save the snip count.
154 : parrello 1.2 if ($setID eq "both") {
155 : parrello 1.4 $varHash->{snipCount} = $snipCount;
156 :     }
157 :     # Build a single-selection scrolling list for this set of blocks.
158 :     $varHash->{"${setID}BlockIDs"} =
159 :     $query->scrolling_list(-name => "${setID}Blocks",
160 :     -values => \@valueList,
161 :     -size => $valueCount,
162 :     -labels => \%labelMap,
163 :     -attributes => \%attributes);
164 :     }
165 :     # Now we need to build the alignment. First, we read the alignment table row fragment.
166 :     Trace("Building alignment.") if T(1);
167 :     my $alignmentRow = Tracer::GetFile("Html/AlignmentRow.html");
168 :     # Next, we need to create an alignment hash from the similarities.
169 :     my @genomes = sort @{$sets{set1}}, @{$sets{set0}};
170 :     my @blocks = (keys %{$blocks{both}});
171 :     my %alignment = $simBlocks->GetAlignment(\@blocks, \@genomes);
172 :     # Loop through the alignment, building the rows.
173 :     my $alignmentHTML = "";
174 :     for my $genome (@genomes) {
175 :     # Get this genome's set number.
176 :     my $setNumber = SimBlocks::SetNumber($genome, $sets{set0}, $sets{set1});
177 :     # Produce the alignment row.
178 :     $alignmentHTML .= PageBuilder::Build($alignmentRow, { genomeID => $genome,
179 :     setNumber => $setNumber,
180 :     dna => $alignment{$genome} },
181 :     "Html");
182 :     }
183 :     # Put the alignment in the variable hash.
184 :     $varHash->{alignment} = $alignmentHTML;
185 :     # Now we need to create the distance matrix.
186 :     Trace("Computing distances.") if T(1);
187 :     my %distanceMatrix = SimBlocks::DistanceMatrix(\%alignment);
188 :     # Get the maximum distance.
189 :     my $max = 0;
190 :     for my $dist (values %distanceMatrix) {
191 :     if ($dist > $max) {
192 :     $max = $dist;
193 : parrello 1.2 }
194 :     }
195 : parrello 1.4 # Clean up the formatting of the distances.
196 :     for my $distanceKey (keys %distanceMatrix) {
197 :     my $distance = $distanceMatrix{$distanceKey};
198 :     # Compute the color of the distance.
199 :     my $intensity = int(($max - $distance) * 200 / $max) + 55;
200 :     my $color = sprintf("%02X", $intensity);
201 :     $color = "#$color$color" . "FF";
202 :     my $distanceString;
203 :     if ($distance == 0) {
204 :     $distanceString = "0.00000";
205 :     } elsif ($distance == 1) {
206 :     $distanceString = "1.00000";
207 :     } elsif ($distance >= 0.00001) {
208 :     $distanceString = sprintf("%.5f", $distance);
209 :     $distanceString .= "0" x (7 - length $distanceString);
210 :     } else {
211 :     $distanceString = sprintf("%E", $distance);
212 :     }
213 :     $distanceMatrix{$distanceKey} =
214 :     "<td align=\"right\" bgcolor=\"$color\">$distanceString</td>";;
215 : parrello 1.2 }
216 : parrello 1.4 # Format it into a table.
217 :     my $thString = "<th align=\"center\" scope=\"col\">";
218 :     my $tdString = "<td align=\"right\">";
219 :     my $distanceHTML = "<tr><td>&nbsp;</td>$thString" .
220 :     join("</th><th align=\"center\">", @genomes) . "</th></tr>\n";
221 :     for my $genome1 (@genomes) {
222 :     my $row = "<tr><th scope=\"row\">$genome1</th>";
223 :     $row .= join("", map { $distanceMatrix{"$genome1/$_"} } @genomes);
224 :     $row .= "</tr>\n";
225 :     $distanceHTML .= $row;
226 :     }
227 :     # Add it to the variable hash.
228 :     $varHash->{distanceMatrix} = $distanceHTML;
229 :     };
230 :     # Check for an error from the EVAL.
231 :     if ($@) {
232 :     Trace("Script error: $@") if T(0);
233 : parrello 1.2 }
234 : parrello 1.4 # Display the web page.
235 :     ScriptFinish("Html/SimBlockDisplay.html", $varHash);
236 : parrello 1.1
237 : parrello 1.6 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3