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

Diff of /FigWebServices/SimBlockDisplay.cgi

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

revision 1.1, Wed May 4 03:17:43 2005 UTC revision 1.2, Thu Jun 9 05:53:14 2005 UTC
# Line 58  Line 58 
58  my %varHash = ( script => $script, DebugData => $traceFields );  my %varHash = ( script => $script, DebugData => $traceFields );
59  # Next we get the list of genomes in each set. These come from the radio  # Next we get the list of genomes in each set. These come from the radio
60  # buttons on the incoming form. Basically, we look for any option whose value  # buttons on the incoming form. Basically, we look for any option whose value
61  # is "set1" or "set2", and put it in the appropriate list. To make this process  # is "set0" or "set1", and put it in the appropriate list. To make this process
62  # simpler, we set up a hash to contain the results.  # simpler, we set up a hash to contain the results.
63  my %sets = ( set1 => [], set2 => [] );  my %sets = ( set0 => [], set1 => [] );
64  my @params = $query->param;  my @params = $query->param;
65  for my $param (@params) {  for my $param (@params) {
66      my $parmValue = $query->param($param);      my $parmValue = $query->param($param);
# Line 68  Line 68 
68          push @{$sets{$parmValue}}, "$param";          push @{$sets{$parmValue}}, "$param";
69      }      }
70  }  }
71    # Set up the attribute for the blocks with snip differences.
72    my $snipAttribute = { class => 'snippy' };
73  # The genome IDs are converted to list options in the upper list boxes.  # The genome IDs are converted to list options in the upper list boxes.
74  for my $setID (keys %sets) {  for my $setID (keys %sets) {
75      # Get the list of values for this set.      # Get the list of values for this set.
# Line 79  Line 81 
81      if ($valueCount < 2) {      if ($valueCount < 2) {
82          $valueCount = 2;          $valueCount = 2;
83      }      }
84      # Build a multi-selection scrolling list big enough to show all the genome IDs.      # Build a multi-selection scrolling list big enough to show all the genome IDs. Note
85        # that we pre-select every element.
86      $varHash{"${setID}GenomeIDs"} = $query->scrolling_list("${setID}Genomes", $valueList,      $varHash{"${setID}GenomeIDs"} = $query->scrolling_list("${setID}Genomes", $valueList,
87                                                             undef, $valueCount, 1);                                                             $valueList, $valueCount, 1);
88  }  }
89  # Now we create the similarity block object.  # Now we create the similarity block object.
90  my $simBlocks = SimBlocks->new();  my $simBlocks = SimBlocks->new();
91    Trace("Comparing genome sets.") if T(1);
92  # Get a comparison of the genome sets.  # Get a comparison of the genome sets.
93  my %blocks;  my %blocks;
94  ($blocks{set1}, $blocks{set2}, $blocks{both}) = $simBlocks->CompareGenomes($sets{set1},  ($blocks{set0}, $blocks{set1}, $blocks{both}) = $simBlocks->CompareGenomes($sets{set0},
95                                                                             $sets{set2});                                                                             $sets{set1});
96    Trace("Formatting lists.") if T(1);
97  # Use the results to generate the scrolling lists for the similarity blocks. Our approach  # Use the results to generate the scrolling lists for the similarity blocks. Our approach
98  # here is very much like what we did earlier for the genome IDs, but we put a maximum of  # here is very much like what we did earlier for the genome IDs, but we put a maximum of
99  # 50 on the display size of each list.  # 50 on the display size of each list.
# Line 96  Line 101 
101      # Get the list of blocks for this set.      # Get the list of blocks for this set.
102      my $valueHash = $blocks{$setID};      my $valueHash = $blocks{$setID};
103      my @valueList = sort keys %{$valueHash};      my @valueList = sort keys %{$valueHash};
104      # Compute the desired list height.      # Compute the number of blocks.
105      my $valueCount = @valueList;      my $valueCount = @valueList;
106        $varHash{"${setID}Count"} = $valueCount;
107        # Constrain it to compute the list height.
108      if ($valueCount > 50) {      if ($valueCount > 50) {
109          $valueCount = 50;          $valueCount = 50;
110      } elsif ($valueCount < 2) {      } elsif ($valueCount < 2) {
111          $valueCount = 2;          $valueCount = 2;
112      }      }
113      # Build a single-selection scrolling list for this set of blocks.      # Create a hash to map block IDs to their descriptive names.
114      $varHash{"${setID}BlockIDs"} = $query->scrolling_list("${setID}Blocks",      my %labelMap = ();
115                                                            \@valueList, undef,      # Create a hash for the list box attributes. This hash will be empty for
116                                                            $valueCount);      # everything but the both-list.
117        my %attributes = ();
118        # Loop through the blocks, counting snip differences and associating labels.
119        my $snipCount = 0;
120        for my $blockID (@valueList) {
121            # If this is the both-list, we need to count the snip differences.
122            if ($setID eq "both") {
123                # Get the snip differences.
124                my %snipHash = $simBlocks->SnipScan($blockID, $sets{set0}, $sets{set1});
125                my $snipDelta = (keys %snipHash);
126                # If snip differences were found, we need to record the fact.
127                if ($snipDelta > 0) {
128                    # Count the new snips.
129                    $snipCount += $snipDelta;
130                    # Highlight the block.
131                    $attributes{$blockID} = $snipAttribute;
132                }
133            }
134            # Regardless of which list it is, we need to store the label.
135            ($labelMap{$blockID}) = $valueHash->{$blockID}->Value('GroupBlock(description)');
136        }
137        # If this is the both-list, save the snip count.
138        if ($setID eq "both") {
139            $varHash{snipCount} = $snipCount;
140  }  }
141        # Build a single-selection scrolling list for this set of blocks.
142        $varHash{"${setID}BlockIDs"} =
143            $query->scrolling_list(-name => "${setID}Blocks",
144                                   -values => \@valueList,
145                                   -size => $valueCount,
146                                   -labels => \%labelMap,
147                                   -attributes => \%attributes);
148    }
149    # Now we need to build the alignment. First, we read the alignment table row fragment.
150    Trace("Building alignment.") if T(1);
151    my $alignmentRow = Tracer::GetFile("Html/AlignmentRow.html");
152    # Next, we need to create an alignment hash from the similarities.
153    my @genomes = sort @{$sets{set1}}, @{$sets{set0}};
154    my @blocks = (keys %{$blocks{both}});
155    my %alignment = $simBlocks->GetAlignment(\@blocks, \@genomes);
156    # Loop through the alignment, building the rows.
157    my $alignmentHTML = "";
158    for my $genome (@genomes) {
159        # Get this genome's set number.
160        my $setNumber = SimBlocks::SetNumber($genome, $sets{set0}, $sets{set1});
161        # Produce the alignment row.
162        $alignmentHTML .= PageBuilder::Build($alignmentRow, { genomeID => $genome,
163                                                              setNumber => $setNumber,
164                                                              dna => $alignment{$genome} },
165                                             "Html");
166    }
167    # Put the alignment in the variable hash.
168    $varHash{alignment} = $alignmentHTML;
169    # Now we need to create the distance matrix.
170    Trace("Computing distances.") if T(1);
171    my %distanceMatrix = SimBlocks::DistanceMatrix(\%alignment);
172    # Get the maximum distance.
173    my $max = 0;
174    for my $dist (values %distanceMatrix) {
175        if ($dist > $max) {
176            $max = $dist;
177        }
178    }
179    # Clean up the formatting of the distances.
180    for my $distanceKey (keys %distanceMatrix) {
181        my $distance = $distanceMatrix{$distanceKey};
182        # Compute the color of the distance.
183        my $intensity = int(($max - $distance) * 200 / $max) + 55;
184        my $color = sprintf("%02X", $intensity);
185        $color = "#$color$color" . "FF";
186        my $distanceString;
187        if ($distance == 0) {
188            $distanceString = "0.00000";
189        } elsif ($distance == 1) {
190            $distanceString = "1.00000";
191        } elsif ($distance >= 0.00001) {
192            $distanceString = sprintf("%.5f", $distance);
193            $distanceString .= "0" x (7 - length $distanceString);
194        } else {
195            $distanceString = sprintf("%E", $distance);
196        }
197        $distanceMatrix{$distanceKey} =
198            "<td align=\"right\" bgcolor=\"$color\">$distanceString</td>";;
199    }
200    # Format it into a table.
201    my $thString = "<th align=\"center\" scope=\"col\">";
202    my $tdString = "<td align=\"right\">";
203    my $distanceHTML = "<tr><td>&nbsp;</td>$thString" .
204        join("</th><th align=\"center\">", @genomes) . "</th></tr>\n";
205    for my $genome1 (@genomes) {
206        my $row = "<tr><th scope=\"row\">$genome1</th>";
207        $row .= join("", map { $distanceMatrix{"$genome1/$_"} } @genomes);
208        $row .= "</tr>\n";
209        $distanceHTML .= $row;
210    }
211    # Add it to the variable hash.
212    $varHash{distanceMatrix} = $distanceHTML;
213    Trace("Building web page.") if T(1);
214  # Flush the trace messages.  # Flush the trace messages.
215  $varHash{TraceMessages} = QTrace('html');  $varHash{TraceMessages} = QTrace('html');
216  # Generate the web page.  # Generate the web page.

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

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3