[Bio] / Sprout / RHLocations.pm Repository:
ViewVC logotype

Annotation of /Sprout/RHLocations.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (view) (download) (as text)

1 : parrello 1.1 #!/usr/bin/perl -w
2 :    
3 :     package RHLocations;
4 :    
5 :     use strict;
6 :     use Tracer;
7 :     use BasicLocation;
8 :     use ERDBObject;
9 :     use POSIX;
10 :     use base 'ResultHelper';
11 :    
12 :     =head1 Location Result Helper
13 :    
14 :     =head2 Introduction
15 :    
16 :     The location result helper is used to display the results of a search that returns
17 :     DNA or protein locations. A DNA location is specified as a location inside a contig.
18 :     A protein location is specified as a location inside a feature.
19 :    
20 :     =cut
21 :    
22 :     =head2 Data Structures
23 :    
24 :     =head3 NEIGHBORHOOD
25 :    
26 :     Maximum distance in nucleotides for two locations to be considered in the same neighborhood.
27 :    
28 :     =cut
29 :    
30 :     use constant { NEIGHBORHOOD => 4000 };
31 :    
32 :     =head2 Public Methods
33 :    
34 :     =head3 new
35 :    
36 : parrello 1.4 my $rhelp = RHLocations->new($shelp);
37 : parrello 1.1
38 :     Construct a new RHLocations object.
39 :    
40 :     =over 4
41 :    
42 :     =item shelp
43 :    
44 :     Parent search helper object for this result helper.
45 :    
46 :     =back
47 :    
48 :     =cut
49 :    
50 :     sub new {
51 :     # Get the parameters.
52 :     my ($class, $shelp) = @_;
53 :     # Create the helper object.
54 :     my $retVal = ResultHelper::new($class, $shelp);
55 :     # Bless and return it.
56 :     bless $retVal, $class;
57 :     return $retVal;
58 :     }
59 :    
60 :     =head3 BuildLocationRecord
61 :    
62 : parrello 1.4 my $erdbObject = RHLocations::BuildLocationRecord($hitLocString);
63 : parrello 1.1
64 :     Build an B<ERDBObject> containing data about a specified location. Unlike most
65 :     result objects, a location does not exist in the Sprout database. This method
66 :     is used to parse the location string into fields and package them as an
67 :     object for use by the column methods.
68 :    
69 :     This method is provided as a static function so that the other methods of
70 :     this object have the privilege of knowing what data is in the B<ERDBObject>
71 :     generated. This is less important for the other result helpers because they
72 :     deal in database objects whose fields can be deduced from the database design.
73 :    
74 :     =over 4
75 :    
76 :     =item hitLocString
77 :    
78 :     A string representation of a hit location, in a standard form that can
79 :     be parsed using the B<BasicLocation> constructor (e.g. C<fig|100226.1.peg.3361_140_10>
80 :     or C<100226.1:NC_003888_3766170+612>).
81 :    
82 :     =item RETURN
83 :    
84 :     Returns an B<ERDBObject> containing all the values parsed out of the hit location.
85 :    
86 :     =back
87 :    
88 :     =cut
89 :    
90 :     sub BuildLocationRecord {
91 :     # Get the parameters.
92 :     my ($hitLocString) = @_;
93 :     # Parse the location string into a location object.
94 :     my $hitLocObject = BasicLocation->new($hitLocString);
95 :     # Compute the genome ID from the Contig. Note that if this is a protein
96 :     # location, the Contig is actually a feature ID. In both cases, however,
97 :     # the genome ID is encoded as part of the ID in clear text.
98 :     my $contig = $hitLocObject->Contig;
99 :     $contig =~ /(\d+\.\d+)/;
100 :     my $genome = $1;
101 :     # Convert the components into data fields in an ERDBObject.
102 :     my $retVal = ERDBObject->new('Location(container)' => [$contig],
103 :     'Location(genome)' => [$genome],
104 :     'Location(begin)' => [$hitLocObject->Begin],
105 :     'Location(dir)' => [$hitLocObject->Dir],
106 :     'Location(length)' => [$hitLocObject->Length],
107 :     'Location(string)' => [$hitLocObject->String]);
108 :     # Return the result.
109 :     return $retVal;
110 :     }
111 :    
112 :     =head3 HitLocation
113 :    
114 : parrello 1.4 my $locString = $rhelp->HitLocation();
115 : parrello 1.1
116 :     Return the hit location string for the current output line.
117 :    
118 :     =cut
119 :    
120 :     sub HitLocation {
121 :     # Get the parameters.
122 :     my ($self) = @_;
123 :     # Get the record.
124 :     my $record = $self->Record;
125 :     # Pull out the location string.
126 :     return $record->PrimaryValue('Location(string)');
127 :     }
128 :    
129 :     =head3 FindNearbyFeature
130 :    
131 : parrello 1.4 my $featureObject = $rhelp->FindNearbyFeature($hitLoc);
132 : parrello 1.1
133 :     Find a nearby feature for this hit location. If the hit location is a protein
134 :     location (i.e. inside a known feature), then the feature is returned without
135 :     preamble. If the hit location is on a contig, the feature chosen will be the
136 : parrello 1.3 one whose midpoint is closest to the location's midpoint.
137 : parrello 1.1
138 :     This method is used by the run-time-value methods, so there will not be
139 :     a copy of the current record available.
140 :    
141 :     =over 4
142 :    
143 :     =item hitLoc
144 :    
145 :     String describing the relevant hit location.
146 :    
147 :     =item RETURN
148 :    
149 :     Returns a record for the nearest feature.
150 :    
151 :     =back
152 :    
153 :     =cut
154 :    
155 :     sub FindNearbyFeature {
156 :     # Get the parameters.
157 :     my ($self, $hitLoc) = @_;
158 :     # Declare the return variable.
159 :     my $retVal;
160 :     # Get a sprout object.
161 :     my $shelp = $self->Parent();
162 :     my $sprout = $shelp->DB();
163 :     # Compute the hit location object and the target object name.
164 :     my $hitLocObj = BasicLocation->new($hitLoc);
165 :     # Get the location's target object.
166 :     my $targetObjectName = $hitLocObj->Contig;
167 :     # Check its type.
168 :     if ($targetObjectName =~ /^fig\|/) {
169 :     # Here the target object is a feature, so we return the feature itself.
170 :     $retVal = $sprout->GetEntity(Feature => $targetObjectName);
171 :     Trace("Feature $targetObjectName chosen as nearby to $hitLoc.") if T(4);
172 :     Trace("Feature object not found.") if T(4) && ! defined $retVal;
173 :     } else {
174 :     # Here it's a contig, so we have to search the hard way. First, we need the
175 :     # neighborhood size.
176 :     my $tuningParms = $shelp->TuningParameters(neighborhood => NEIGHBORHOOD);
177 :     my $neighborhood = $tuningParms->{neighborhood};
178 :     Trace("Neighborhood is $neighborhood.") if T(4);
179 :     # Widen the location by the neighborhood distance on both sides. This requires knowing
180 :     # the contig length.
181 :     my $contigLength = $sprout->ContigLength($targetObjectName);
182 :     my $wideLocObj = BasicLocation->new($hitLocObj);
183 :     $wideLocObj->Widen($neighborhood, $contigLength);
184 :     Trace("Search neighborhood is " . $hitLocObj->String . ".") if T(4);
185 :     # Look for features in the computed region.
186 :     my @features = $sprout->GeneDataInRegion($targetObjectName, $wideLocObj->Left, $wideLocObj->Right);
187 :     # Get the midpoint of the hit location.
188 :     my $hitMidpoint = ($hitLocObj->Begin + $hitLocObj->EndPoint) / 2;
189 : parrello 1.3 # Search for the best choice. This will be a feature whose midpoint is closest to our
190 : parrello 1.1 # mid point.
191 :     my $bestFeature;
192 :     my $bestDistance = INT_MAX;
193 :     for my $feature (@features) {
194 :     # Get this feature's last location.
195 :     my @locList = split /\s*,\s*/, $feature->PrimaryValue('Feature(location-string)');
196 :     for my $featureLoc (@locList) {
197 :     my $currentLoc = BasicLocation->new($featureLoc);
198 : parrello 1.3 my $midPoint = ($currentLoc->Begin + $currentLoc->EndPoint) / 2;
199 :     my $newDistance = abs($midPoint - $hitMidpoint);
200 :     Trace("Distance is $newDistance. Best is $bestDistance.") if T(4);
201 :     # Now we determine whether or not this feature is better than the best one so far.
202 :     my $better = 0;
203 :     if ($newDistance < $bestDistance) {
204 :     # Here it's closer, so it is automatically better.
205 :     $better = 1;
206 :     } elsif ($newDistance == $bestDistance && $currentLoc->Dir eq $hitLocObj->Dir) {
207 :     # If the distances are the same, we break ties in favor of the location on the same strand.
208 :     $better = 1;
209 :     }
210 :     if ($better) {
211 :     $bestFeature = $feature;
212 :     $bestDistance = $newDistance;
213 : parrello 1.1 }
214 :     }
215 :     }
216 :     # Return the feature with the best distance.
217 :     $retVal = $bestFeature;
218 :     }
219 :     # Return the result.
220 :     return $retVal;
221 :     }
222 :    
223 :     =head3 NearbyFeature
224 :    
225 : parrello 1.4 my $featureRecord = $rhelp->NearbyFeature($hitLoc);
226 : parrello 1.1
227 :     Return the nearby feature. If it has already been found, we return it from the
228 :     cache. Otherwise we find it and then cache it on our way out.
229 :    
230 :     =over 4
231 :    
232 :     =item hitLoc
233 :    
234 :     Location string for the current hit.
235 :    
236 :     =item RETURN
237 :    
238 :     Returns an C<ERDBObject> for the desired feature, or C<undef> if no such
239 :     feature exists.
240 :    
241 :     =back
242 :    
243 :     =cut
244 :    
245 :     sub NearbyFeature {
246 :     # Get the parameters.
247 :     my ($self, $hitLoc) = @_;
248 :     # Declare the return variable.
249 :     my $retVal;
250 :     # Check the cache.
251 :     my $cache = $self->Cache;
252 :     if (exists $cache->{nearby}) {
253 :     # Here we've already cached the value.
254 :     $retVal = $cache->{nearby};
255 :     } else {
256 :     # Here we need to find it the hard way.
257 :     $retVal = $self->FindNearbyFeature($hitLoc);
258 :     # Save it for next time.
259 :     $cache->{nearby} = $retVal;
260 :     }
261 :     # Return the result.
262 :     return $retVal;
263 :     }
264 :    
265 :     =head2 Virtual Overrides
266 :    
267 :     =head3 DefaultResultColumns
268 :    
269 : parrello 1.4 my @colNames = $rhelp->DefaultResultColumns();
270 : parrello 1.1
271 :     Return a list of the default columns to be used by searches with this
272 :     type of result. Note that the actual default columns are computed by
273 :     the search helper. This method is only needed if the search helper doesn't
274 :     care.
275 :    
276 :     The columns returned should be in the form of column names, all of which
277 :     must be defined by the result helper class.
278 :    
279 :     =cut
280 :    
281 :     sub DefaultResultColumns {
282 : parrello 1.2 return qw(orgName nextFeature nextFeatureFunction nextFeatureLink compareLink);
283 : parrello 1.1 }
284 :    
285 :     =head2 Column Methods
286 :    
287 :     =head3 compareLink
288 :    
289 : parrello 1.4 my $colDatum = RHLocations::compareLink($type => $rhelp, $key);
290 : parrello 1.1
291 :     This method computes the various things we need to know into order to process
292 :     the compareLink column.
293 :    
294 :     =over 4
295 :    
296 :     =item type
297 :    
298 :     Type of data about the column that is required: C<title> for the column title,
299 :     C<download> for the download flag, and so forth.
300 :    
301 :     =item rhelp
302 :    
303 :     Result helper being used to format the search output.
304 :    
305 :     =item key (optional)
306 :    
307 :     The key to be used to compute a run-time value.
308 :    
309 :     =item RETURN
310 :    
311 :     Returns the desired information about the compareLink column.
312 :    
313 :     =back
314 :    
315 :     =cut
316 :    
317 :     sub compareLink {
318 :     # Get the parameters.
319 :     my ($type, $rhelp, $key) = @_;
320 :     # Declare the return variable.
321 :     my $retVal;
322 :     # Process according to the information requested.
323 :     if ($type eq 'title') {
324 :     # Return the title for this column. Button columns
325 :     # generally don't have titles.
326 :     $retVal = '';
327 :     } elsif ($type eq 'download') {
328 :     # This field should not be included in a download. It relies on the
329 :     # existence of files that may expire soon.
330 :     $retVal = '';
331 :     } elsif ($type eq 'style') {
332 :     # Here the caller wants the style class used to format this column.
333 :     $retVal = 'leftAlign';
334 :     } elsif ($type eq 'value') {
335 :     # This is a run-time value that depends on the hit location.
336 :     my $newKey = $rhelp->HitLocation;
337 :     $retVal = "%%compareLink=$newKey";
338 :     } elsif ($type eq 'runTimeValue') {
339 :     my $feature = $rhelp->NearbyFeature($key);
340 :     if (! defined($feature)) {
341 :     # No nearby feature, so we don't return anything.
342 :     $retVal = "";
343 :     } else {
344 :     # Here we want to create a formlet. We need the session ID
345 :     # and the feature id.
346 :     my $shelp = $rhelp->Parent;
347 :     my $session = $shelp->ID();
348 :     my $fid = $feature->PrimaryValue('Feature(id)');
349 : parrello 1.5 $retVal = $rhelp->FakeButton('Context', "wiki/rest.cgi/NmpdrPlugin/PatScanResult",
350 :     undef, page => 'genome_regions', peg => $fid,
351 :     file => "tmp_$session.cache",
352 :     SPROUT => 1);
353 : parrello 1.1 }
354 :     }
355 :     return $retVal;
356 :     }
357 :    
358 :     =head3 nextFeature
359 :    
360 : parrello 1.4 my $colDatum = RHLocations::nextFeature($type => $rhelp, $key);
361 : parrello 1.1
362 :     This method computes the various things we need to know into order to process
363 :     the nextFeature column.
364 :    
365 :     =over 4
366 :    
367 :     =item type
368 :    
369 :     Type of data about the column that is required: C<title> for the column title,
370 :     C<download> for the download flag, and so forth.
371 :    
372 :     =item rhelp
373 :    
374 :     Result helper being used to format the search output.
375 :    
376 :     =item key (optional)
377 :    
378 :     The key to be used to compute a run-time value.
379 :    
380 :     =item RETURN
381 :    
382 :     Returns the desired information about the nextFeature column.
383 :    
384 :     =back
385 :    
386 :     =cut
387 :    
388 :     sub nextFeature {
389 :     # Get the parameters.
390 :     my ($type, $rhelp, $key) = @_;
391 :     # Declare the return variable.
392 :     my $retVal;
393 :     # Process according to the information requested.
394 :     if ($type eq 'title') {
395 :     # Return the title for this column.
396 :     $retVal = 'Nearest Feature';
397 :     } elsif ($type eq 'download') {
398 :     # This field should be included in a download.
399 :     $retVal = 'text';
400 :     } elsif ($type eq 'style') {
401 :     # Here the caller wants the style class used to format this column.
402 :     $retVal = 'leftAlign';
403 :     } elsif ($type eq 'value') {
404 :     # This is a run-time value that depends on the hit location.
405 :     my $newKey = $rhelp->HitLocation;
406 :     $retVal = "%%nextFeature=$newKey";
407 :     } elsif ($type eq 'runTimeValue') {
408 :     my $feature = $rhelp->NearbyFeature($key);
409 :     if (! defined($feature)) {
410 :     # No nearby feature, so we don't return anything.
411 :     $retVal = "";
412 :     } else {
413 :     # Get the feature's ID.
414 :     $retVal = $rhelp->PreferredID($feature);
415 :     }
416 :     }
417 :     return $retVal;
418 :     }
419 :    
420 :     =head3 nextFeatureFunction
421 :    
422 : parrello 1.4 my $colDatum = RHLocations::nextFeatureFunction($type => $rhelp, $key);
423 : parrello 1.1
424 :     This method computes the various things we need to know into order to process
425 :     the nextFeatureFunction column.
426 :    
427 :     =over 4
428 :    
429 :     =item type
430 :    
431 :     Type of data about the column that is required: C<title> for the column title,
432 :     C<download> for the download flag, and so forth.
433 :    
434 :     =item rhelp
435 :    
436 :     Result helper being used to format the search output.
437 :    
438 :     =item key (optional)
439 :    
440 :     The key to be used to compute a run-time value.
441 :    
442 :     =item RETURN
443 :    
444 :     Returns the desired information about the nextFeatureFunction column.
445 :    
446 :     =back
447 :    
448 :     =cut
449 :    
450 :     sub nextFeatureFunction {
451 :     # Get the parameters.
452 :     my ($type, $rhelp, $key) = @_;
453 :     # Declare the return variable.
454 :     my $retVal;
455 :     # Process according to the information requested.
456 :     if ($type eq 'title') {
457 :     # Return the title for this column.
458 :     $retVal = 'Assignment';
459 :     } elsif ($type eq 'download') {
460 :     # This field should be included in a download.
461 :     $retVal = 'text';
462 :     } elsif ($type eq 'style') {
463 :     # Here the caller wants the style class used to format this column.
464 :     $retVal = 'leftAlign';
465 :     } elsif ($type eq 'value') {
466 :     # This is a run-time value that depends on the hit location.
467 :     my $newKey = $rhelp->HitLocation;
468 :     $retVal = "%%nextFeatureFunction=$newKey";
469 :     } elsif ($type eq 'runTimeValue') {
470 :     my $feature = $rhelp->NearbyFeature($key);
471 :     if (! defined($feature)) {
472 :     # No nearby feature, so we don't return anything.
473 :     $retVal = "";
474 :     } else {
475 :     # Get the feature's assignment.
476 :     $retVal = $feature->PrimaryValue('Feature(assignment)');
477 :     }
478 :     }
479 :     return $retVal;
480 :     }
481 :    
482 :     =head3 nextFeatureLink
483 :    
484 : parrello 1.4 my $colDatum = RHLocations::nextFeatureLink($type => $rhelp, $key);
485 : parrello 1.1
486 :     This method computes the various things we need to know into order to process
487 :     the nextFeatureLink column.
488 :    
489 :     =over 4
490 :    
491 :     =item type
492 :    
493 :     Type of data about the column that is required: C<title> for the column title,
494 :     C<download> for the download flag, and so forth.
495 :    
496 :     =item rhelp
497 :    
498 :     Result helper being used to format the search output.
499 :    
500 :     =item key (optional)
501 :    
502 :     The key to be used to compute a run-time value.
503 :    
504 :     =item RETURN
505 :    
506 :     Returns the desired information about the nextFeatureLink column.
507 :    
508 :     =back
509 :    
510 :     =cut
511 :    
512 :     sub nextFeatureLink {
513 :     # Get the parameters.
514 :     my ($type, $rhelp, $key) = @_;
515 :     # Declare the return variable.
516 :     my $retVal;
517 :     # Process according to the information requested.
518 :     if ($type eq 'title') {
519 : parrello 1.2 # Links don't need a column title.
520 : parrello 1.1 $retVal = '';
521 :     } elsif ($type eq 'download') {
522 :     # This field should be included in a download.
523 :     $retVal = 'link';
524 :     } elsif ($type eq 'style') {
525 :     # Here the caller wants the style class used to format this column.
526 :     $retVal = 'leftAlign';
527 :     } elsif ($type eq 'value') {
528 :     # This is a run-time value that depends on the hit location.
529 :     my $newKey = $rhelp->HitLocation;
530 :     $retVal = "%%nextFeatureLink=$newKey";
531 :     } elsif ($type eq 'runTimeValue') {
532 :     my $feature = $rhelp->NearbyFeature($key);
533 :     if (! defined($feature)) {
534 :     # No nearby feature, so we don't return anything.
535 :     $retVal = "";
536 :     } else {
537 :     # Create a formlet for the feature's page.
538 :     my $fid = $feature->PrimaryValue('Feature(id)');
539 : parrello 1.5 $retVal = $rhelp->FakeButton('NMPDR', "wiki/rest.cgi/NmpdrPlugin/SeedViewer",
540 :     undef, page => 'Annotation', feature => $fid);
541 : parrello 1.1 }
542 :     }
543 :     return $retVal;
544 :     }
545 :    
546 :     =head3 orgName
547 :    
548 : parrello 1.4 my $colDatum = RHLocations::orgName($type => $rhelp, $key);
549 : parrello 1.1
550 :     This method computes the various things we need to know into order to process
551 :     the orgName column.
552 :    
553 :     =over 4
554 :    
555 :     =item type
556 :    
557 :     Type of data about the column that is required: C<title> for the column title,
558 :     C<download> for the download flag, and so forth.
559 :    
560 :     =item rhelp
561 :    
562 :     Result helper being used to format the search output.
563 :    
564 :     =item key (optional)
565 :    
566 :     The key to be used to compute a run-time value.
567 :    
568 :     =item RETURN
569 :    
570 :     Returns the desired information about the orgName column.
571 :    
572 :     =back
573 :    
574 :     =cut
575 :    
576 :     sub orgName {
577 :     # Get the parameters.
578 :     my ($type, $rhelp, $key) = @_;
579 :     # Declare the return variable.
580 :     my $retVal;
581 :     # Process according to the information requested.
582 :     if ($type eq 'title') {
583 :     # Return the title for this column.
584 :     $retVal = 'Organism Name';
585 :     } elsif ($type eq 'download') {
586 :     # This field should be included in a download.
587 :     $retVal = 'text';
588 :     } elsif ($type eq 'style') {
589 :     # Here the caller wants the style class used to format this column.
590 :     $retVal = 'leftAlign';
591 :     } elsif ($type eq 'value') {
592 :     # Get the data record and the parent search helper.
593 :     my $record = $rhelp->Record;
594 :     my $shelp = $rhelp->Parent;
595 :     # Extract the genome ID.
596 :     my $genomeID = $record->PrimaryValue('Location(genome)');
597 :     # Ask the parent for the organism name. This will usually be in a cache.
598 :     $retVal = $shelp->Organism($genomeID);
599 :     } elsif ($type eq 'runTimeValue') {
600 :     # Run-time support is not needed for this column.
601 :     }
602 :     return $retVal;
603 :     }
604 :    
605 :    
606 : parrello 1.2 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3