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

Annotation of /Sprout/RHLocations.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.6 - (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.6 my $erdbObject = $rhelp->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 : parrello 1.6 my ($self, $hitLocString) = @_;
93 : parrello 1.1 # 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 : parrello 1.6 my $retVal = ERDBObject->new($self->DB(), 'Location', {
103 :     container => $contig,
104 :     genome => $genome,
105 :     begin => $hitLocObject->Begin,
106 :     dir => $hitLocObject->Dir,
107 :     length => $hitLocObject->Length,
108 :     string => $hitLocObject->String
109 :     });
110 : parrello 1.1 # Return the result.
111 :     return $retVal;
112 :     }
113 :    
114 :     =head3 HitLocation
115 :    
116 : parrello 1.4 my $locString = $rhelp->HitLocation();
117 : parrello 1.1
118 :     Return the hit location string for the current output line.
119 :    
120 :     =cut
121 :    
122 :     sub HitLocation {
123 :     # Get the parameters.
124 :     my ($self) = @_;
125 :     # Get the record.
126 :     my $record = $self->Record;
127 :     # Pull out the location string.
128 :     return $record->PrimaryValue('Location(string)');
129 :     }
130 :    
131 :     =head3 FindNearbyFeature
132 :    
133 : parrello 1.4 my $featureObject = $rhelp->FindNearbyFeature($hitLoc);
134 : parrello 1.1
135 :     Find a nearby feature for this hit location. If the hit location is a protein
136 :     location (i.e. inside a known feature), then the feature is returned without
137 :     preamble. If the hit location is on a contig, the feature chosen will be the
138 : parrello 1.3 one whose midpoint is closest to the location's midpoint.
139 : parrello 1.1
140 :     This method is used by the run-time-value methods, so there will not be
141 :     a copy of the current record available.
142 :    
143 :     =over 4
144 :    
145 :     =item hitLoc
146 :    
147 :     String describing the relevant hit location.
148 :    
149 :     =item RETURN
150 :    
151 :     Returns a record for the nearest feature.
152 :    
153 :     =back
154 :    
155 :     =cut
156 :    
157 :     sub FindNearbyFeature {
158 :     # Get the parameters.
159 :     my ($self, $hitLoc) = @_;
160 :     # Declare the return variable.
161 :     my $retVal;
162 :     # Get a sprout object.
163 :     my $shelp = $self->Parent();
164 :     my $sprout = $shelp->DB();
165 :     # Compute the hit location object and the target object name.
166 :     my $hitLocObj = BasicLocation->new($hitLoc);
167 :     # Get the location's target object.
168 :     my $targetObjectName = $hitLocObj->Contig;
169 :     # Check its type.
170 :     if ($targetObjectName =~ /^fig\|/) {
171 :     # Here the target object is a feature, so we return the feature itself.
172 :     $retVal = $sprout->GetEntity(Feature => $targetObjectName);
173 :     Trace("Feature $targetObjectName chosen as nearby to $hitLoc.") if T(4);
174 :     Trace("Feature object not found.") if T(4) && ! defined $retVal;
175 :     } else {
176 :     # Here it's a contig, so we have to search the hard way. First, we need the
177 :     # neighborhood size.
178 :     my $tuningParms = $shelp->TuningParameters(neighborhood => NEIGHBORHOOD);
179 :     my $neighborhood = $tuningParms->{neighborhood};
180 :     Trace("Neighborhood is $neighborhood.") if T(4);
181 :     # Widen the location by the neighborhood distance on both sides. This requires knowing
182 :     # the contig length.
183 :     my $contigLength = $sprout->ContigLength($targetObjectName);
184 :     my $wideLocObj = BasicLocation->new($hitLocObj);
185 :     $wideLocObj->Widen($neighborhood, $contigLength);
186 :     Trace("Search neighborhood is " . $hitLocObj->String . ".") if T(4);
187 :     # Look for features in the computed region.
188 :     my @features = $sprout->GeneDataInRegion($targetObjectName, $wideLocObj->Left, $wideLocObj->Right);
189 :     # Get the midpoint of the hit location.
190 :     my $hitMidpoint = ($hitLocObj->Begin + $hitLocObj->EndPoint) / 2;
191 : parrello 1.3 # Search for the best choice. This will be a feature whose midpoint is closest to our
192 : parrello 1.1 # mid point.
193 :     my $bestFeature;
194 :     my $bestDistance = INT_MAX;
195 :     for my $feature (@features) {
196 :     # Get this feature's last location.
197 :     my @locList = split /\s*,\s*/, $feature->PrimaryValue('Feature(location-string)');
198 :     for my $featureLoc (@locList) {
199 :     my $currentLoc = BasicLocation->new($featureLoc);
200 : parrello 1.3 my $midPoint = ($currentLoc->Begin + $currentLoc->EndPoint) / 2;
201 :     my $newDistance = abs($midPoint - $hitMidpoint);
202 :     Trace("Distance is $newDistance. Best is $bestDistance.") if T(4);
203 :     # Now we determine whether or not this feature is better than the best one so far.
204 :     my $better = 0;
205 :     if ($newDistance < $bestDistance) {
206 :     # Here it's closer, so it is automatically better.
207 :     $better = 1;
208 :     } elsif ($newDistance == $bestDistance && $currentLoc->Dir eq $hitLocObj->Dir) {
209 :     # If the distances are the same, we break ties in favor of the location on the same strand.
210 :     $better = 1;
211 :     }
212 :     if ($better) {
213 :     $bestFeature = $feature;
214 :     $bestDistance = $newDistance;
215 : parrello 1.1 }
216 :     }
217 :     }
218 :     # Return the feature with the best distance.
219 :     $retVal = $bestFeature;
220 :     }
221 :     # Return the result.
222 :     return $retVal;
223 :     }
224 :    
225 :     =head3 NearbyFeature
226 :    
227 : parrello 1.4 my $featureRecord = $rhelp->NearbyFeature($hitLoc);
228 : parrello 1.1
229 :     Return the nearby feature. If it has already been found, we return it from the
230 :     cache. Otherwise we find it and then cache it on our way out.
231 :    
232 :     =over 4
233 :    
234 :     =item hitLoc
235 :    
236 :     Location string for the current hit.
237 :    
238 :     =item RETURN
239 :    
240 :     Returns an C<ERDBObject> for the desired feature, or C<undef> if no such
241 :     feature exists.
242 :    
243 :     =back
244 :    
245 :     =cut
246 :    
247 :     sub NearbyFeature {
248 :     # Get the parameters.
249 :     my ($self, $hitLoc) = @_;
250 :     # Declare the return variable.
251 :     my $retVal;
252 :     # Check the cache.
253 :     my $cache = $self->Cache;
254 :     if (exists $cache->{nearby}) {
255 :     # Here we've already cached the value.
256 :     $retVal = $cache->{nearby};
257 :     } else {
258 :     # Here we need to find it the hard way.
259 :     $retVal = $self->FindNearbyFeature($hitLoc);
260 :     # Save it for next time.
261 :     $cache->{nearby} = $retVal;
262 :     }
263 :     # Return the result.
264 :     return $retVal;
265 :     }
266 :    
267 :     =head2 Virtual Overrides
268 :    
269 :     =head3 DefaultResultColumns
270 :    
271 : parrello 1.4 my @colNames = $rhelp->DefaultResultColumns();
272 : parrello 1.1
273 :     Return a list of the default columns to be used by searches with this
274 :     type of result. Note that the actual default columns are computed by
275 :     the search helper. This method is only needed if the search helper doesn't
276 :     care.
277 :    
278 :     The columns returned should be in the form of column names, all of which
279 :     must be defined by the result helper class.
280 :    
281 :     =cut
282 :    
283 :     sub DefaultResultColumns {
284 : parrello 1.2 return qw(orgName nextFeature nextFeatureFunction nextFeatureLink compareLink);
285 : parrello 1.1 }
286 :    
287 : parrello 1.6 =head3 GetColumnNameList
288 :    
289 :     my @names = $rhelp->GetColumnNameList();
290 :    
291 :     Return a complete list of the names of columns available for this result
292 :     helper. This is considerably smaller than the complete list, because not all
293 :     of the columns are available when we're in the Seed Viewer.
294 :    
295 :     =cut
296 :    
297 :     sub GetColumnNameList {
298 :     # Get the parameters.
299 :     my ($self) = @_;
300 :     # Return the result.
301 :     return qw(orgName nextFeature);
302 :     }
303 :    
304 :     =head3 Permanent
305 :    
306 :     my $flag = $rhelp->Permanent($colName);
307 :    
308 :     Return TRUE if the specified column should be permanent when used in a
309 :     Seed Viewer table, else FALSE.
310 :    
311 :     =over 4
312 :    
313 :     =item colName
314 :    
315 :     Name of the column to check.
316 :    
317 :     =item RETURN
318 :    
319 :     Returns TRUE if the column should be permanent, else FALSE.
320 :    
321 :     =back
322 :    
323 :     =cut
324 :    
325 :     sub Permanent {
326 :     # Get the parameters.
327 :     my ($self, $colName) = @_;
328 :     # Declare the return variable.
329 :     my $retVal = ($colName eq 'orgName' || $colName eq 'nextFeature');
330 :     # Return the result.
331 :     return $retVal;
332 :     }
333 :    
334 : parrello 1.1 =head2 Column Methods
335 :    
336 :     =head3 compareLink
337 :    
338 : parrello 1.4 my $colDatum = RHLocations::compareLink($type => $rhelp, $key);
339 : parrello 1.1
340 :     This method computes the various things we need to know into order to process
341 :     the compareLink column.
342 :    
343 :     =over 4
344 :    
345 :     =item type
346 :    
347 :     Type of data about the column that is required: C<title> for the column title,
348 :     C<download> for the download flag, and so forth.
349 :    
350 :     =item rhelp
351 :    
352 :     Result helper being used to format the search output.
353 :    
354 :     =item key (optional)
355 :    
356 :     The key to be used to compute a run-time value.
357 :    
358 :     =item RETURN
359 :    
360 :     Returns the desired information about the compareLink column.
361 :    
362 :     =back
363 :    
364 :     =cut
365 :    
366 :     sub compareLink {
367 :     # Get the parameters.
368 :     my ($type, $rhelp, $key) = @_;
369 :     # Declare the return variable.
370 :     my $retVal;
371 :     # Process according to the information requested.
372 :     if ($type eq 'title') {
373 :     # Return the title for this column. Button columns
374 :     # generally don't have titles.
375 :     $retVal = '';
376 :     } elsif ($type eq 'download') {
377 :     # This field should not be included in a download. It relies on the
378 :     # existence of files that may expire soon.
379 :     $retVal = '';
380 :     } elsif ($type eq 'style') {
381 :     # Here the caller wants the style class used to format this column.
382 :     $retVal = 'leftAlign';
383 :     } elsif ($type eq 'value') {
384 :     # This is a run-time value that depends on the hit location.
385 :     my $newKey = $rhelp->HitLocation;
386 :     $retVal = "%%compareLink=$newKey";
387 :     } elsif ($type eq 'runTimeValue') {
388 :     my $feature = $rhelp->NearbyFeature($key);
389 :     if (! defined($feature)) {
390 :     # No nearby feature, so we don't return anything.
391 :     $retVal = "";
392 :     } else {
393 :     # Here we want to create a formlet. We need the session ID
394 :     # and the feature id.
395 :     my $shelp = $rhelp->Parent;
396 :     my $session = $shelp->ID();
397 :     my $fid = $feature->PrimaryValue('Feature(id)');
398 : parrello 1.5 $retVal = $rhelp->FakeButton('Context', "wiki/rest.cgi/NmpdrPlugin/PatScanResult",
399 :     undef, page => 'genome_regions', peg => $fid,
400 :     file => "tmp_$session.cache",
401 :     SPROUT => 1);
402 : parrello 1.1 }
403 :     }
404 :     return $retVal;
405 :     }
406 :    
407 :     =head3 nextFeature
408 :    
409 : parrello 1.4 my $colDatum = RHLocations::nextFeature($type => $rhelp, $key);
410 : parrello 1.1
411 :     This method computes the various things we need to know into order to process
412 :     the nextFeature column.
413 :    
414 :     =over 4
415 :    
416 :     =item type
417 :    
418 :     Type of data about the column that is required: C<title> for the column title,
419 :     C<download> for the download flag, and so forth.
420 :    
421 :     =item rhelp
422 :    
423 :     Result helper being used to format the search output.
424 :    
425 :     =item key (optional)
426 :    
427 :     The key to be used to compute a run-time value.
428 :    
429 :     =item RETURN
430 :    
431 :     Returns the desired information about the nextFeature column.
432 :    
433 :     =back
434 :    
435 :     =cut
436 :    
437 :     sub nextFeature {
438 :     # Get the parameters.
439 :     my ($type, $rhelp, $key) = @_;
440 :     # Declare the return variable.
441 :     my $retVal;
442 :     # Process according to the information requested.
443 :     if ($type eq 'title') {
444 :     # Return the title for this column.
445 :     $retVal = 'Nearest Feature';
446 :     } elsif ($type eq 'download') {
447 :     # This field should be included in a download.
448 :     $retVal = 'text';
449 :     } elsif ($type eq 'style') {
450 :     # Here the caller wants the style class used to format this column.
451 :     $retVal = 'leftAlign';
452 :     } elsif ($type eq 'value') {
453 :     # This is a run-time value that depends on the hit location.
454 :     my $newKey = $rhelp->HitLocation;
455 :     $retVal = "%%nextFeature=$newKey";
456 : parrello 1.6 } elsif ($type eq 'runTimeValue' || $type eq 'valueFromKey') {
457 : parrello 1.1 my $feature = $rhelp->NearbyFeature($key);
458 :     if (! defined($feature)) {
459 :     # No nearby feature, so we don't return anything.
460 :     $retVal = "";
461 :     } else {
462 :     # Get the feature's ID.
463 :     $retVal = $rhelp->PreferredID($feature);
464 :     }
465 :     }
466 :     return $retVal;
467 :     }
468 :    
469 :     =head3 nextFeatureFunction
470 :    
471 : parrello 1.4 my $colDatum = RHLocations::nextFeatureFunction($type => $rhelp, $key);
472 : parrello 1.1
473 :     This method computes the various things we need to know into order to process
474 :     the nextFeatureFunction column.
475 :    
476 :     =over 4
477 :    
478 :     =item type
479 :    
480 :     Type of data about the column that is required: C<title> for the column title,
481 :     C<download> for the download flag, and so forth.
482 :    
483 :     =item rhelp
484 :    
485 :     Result helper being used to format the search output.
486 :    
487 :     =item key (optional)
488 :    
489 :     The key to be used to compute a run-time value.
490 :    
491 :     =item RETURN
492 :    
493 :     Returns the desired information about the nextFeatureFunction column.
494 :    
495 :     =back
496 :    
497 :     =cut
498 :    
499 :     sub nextFeatureFunction {
500 :     # Get the parameters.
501 :     my ($type, $rhelp, $key) = @_;
502 :     # Declare the return variable.
503 :     my $retVal;
504 :     # Process according to the information requested.
505 :     if ($type eq 'title') {
506 :     # Return the title for this column.
507 :     $retVal = 'Assignment';
508 :     } elsif ($type eq 'download') {
509 :     # This field should be included in a download.
510 :     $retVal = 'text';
511 :     } elsif ($type eq 'style') {
512 :     # Here the caller wants the style class used to format this column.
513 :     $retVal = 'leftAlign';
514 :     } elsif ($type eq 'value') {
515 :     # This is a run-time value that depends on the hit location.
516 :     my $newKey = $rhelp->HitLocation;
517 :     $retVal = "%%nextFeatureFunction=$newKey";
518 :     } elsif ($type eq 'runTimeValue') {
519 :     my $feature = $rhelp->NearbyFeature($key);
520 :     if (! defined($feature)) {
521 :     # No nearby feature, so we don't return anything.
522 :     $retVal = "";
523 :     } else {
524 :     # Get the feature's assignment.
525 :     $retVal = $feature->PrimaryValue('Feature(assignment)');
526 :     }
527 :     }
528 :     return $retVal;
529 :     }
530 :    
531 :     =head3 nextFeatureLink
532 :    
533 : parrello 1.4 my $colDatum = RHLocations::nextFeatureLink($type => $rhelp, $key);
534 : parrello 1.1
535 :     This method computes the various things we need to know into order to process
536 :     the nextFeatureLink column.
537 :    
538 :     =over 4
539 :    
540 :     =item type
541 :    
542 :     Type of data about the column that is required: C<title> for the column title,
543 :     C<download> for the download flag, and so forth.
544 :    
545 :     =item rhelp
546 :    
547 :     Result helper being used to format the search output.
548 :    
549 :     =item key (optional)
550 :    
551 :     The key to be used to compute a run-time value.
552 :    
553 :     =item RETURN
554 :    
555 :     Returns the desired information about the nextFeatureLink column.
556 :    
557 :     =back
558 :    
559 :     =cut
560 :    
561 :     sub nextFeatureLink {
562 :     # Get the parameters.
563 :     my ($type, $rhelp, $key) = @_;
564 :     # Declare the return variable.
565 :     my $retVal;
566 :     # Process according to the information requested.
567 :     if ($type eq 'title') {
568 : parrello 1.2 # Links don't need a column title.
569 : parrello 1.1 $retVal = '';
570 :     } elsif ($type eq 'download') {
571 :     # This field should be included in a download.
572 :     $retVal = 'link';
573 :     } elsif ($type eq 'style') {
574 :     # Here the caller wants the style class used to format this column.
575 :     $retVal = 'leftAlign';
576 :     } elsif ($type eq 'value') {
577 :     # This is a run-time value that depends on the hit location.
578 :     my $newKey = $rhelp->HitLocation;
579 :     $retVal = "%%nextFeatureLink=$newKey";
580 :     } elsif ($type eq 'runTimeValue') {
581 :     my $feature = $rhelp->NearbyFeature($key);
582 :     if (! defined($feature)) {
583 :     # No nearby feature, so we don't return anything.
584 :     $retVal = "";
585 :     } else {
586 :     # Create a formlet for the feature's page.
587 :     my $fid = $feature->PrimaryValue('Feature(id)');
588 : parrello 1.6 $retVal = $rhelp->FakeButton('Viewer', "wiki/rest.cgi/NmpdrPlugin/SeedViewer",
589 : parrello 1.5 undef, page => 'Annotation', feature => $fid);
590 : parrello 1.1 }
591 :     }
592 :     return $retVal;
593 :     }
594 :    
595 :     =head3 orgName
596 :    
597 : parrello 1.4 my $colDatum = RHLocations::orgName($type => $rhelp, $key);
598 : parrello 1.1
599 :     This method computes the various things we need to know into order to process
600 :     the orgName column.
601 :    
602 :     =over 4
603 :    
604 :     =item type
605 :    
606 :     Type of data about the column that is required: C<title> for the column title,
607 :     C<download> for the download flag, and so forth.
608 :    
609 :     =item rhelp
610 :    
611 :     Result helper being used to format the search output.
612 :    
613 :     =item key (optional)
614 :    
615 :     The key to be used to compute a run-time value.
616 :    
617 :     =item RETURN
618 :    
619 :     Returns the desired information about the orgName column.
620 :    
621 :     =back
622 :    
623 :     =cut
624 :    
625 :     sub orgName {
626 :     # Get the parameters.
627 :     my ($type, $rhelp, $key) = @_;
628 :     # Declare the return variable.
629 :     my $retVal;
630 :     # Process according to the information requested.
631 :     if ($type eq 'title') {
632 :     # Return the title for this column.
633 :     $retVal = 'Organism Name';
634 :     } elsif ($type eq 'download') {
635 :     # This field should be included in a download.
636 :     $retVal = 'text';
637 :     } elsif ($type eq 'style') {
638 :     # Here the caller wants the style class used to format this column.
639 :     $retVal = 'leftAlign';
640 :     } elsif ($type eq 'value') {
641 :     # Get the data record and the parent search helper.
642 :     my $record = $rhelp->Record;
643 :     my $shelp = $rhelp->Parent;
644 :     # Extract the genome ID.
645 :     my $genomeID = $record->PrimaryValue('Location(genome)');
646 :     # Ask the parent for the organism name. This will usually be in a cache.
647 :     $retVal = $shelp->Organism($genomeID);
648 :     } elsif ($type eq 'runTimeValue') {
649 :     # Run-time support is not needed for this column.
650 : parrello 1.6 } elsif ($type eq 'valueFromKey') {
651 :     # The key is the hit location string. It starts with the genome ID.
652 :     my $shelp = $rhelp->Parent;
653 :     my ($genomeID) = split /:/, $key, 2;
654 :     $retVal = $shelp->Organism($genomeID);
655 : parrello 1.1 }
656 :     return $retVal;
657 :     }
658 :    
659 :    
660 : parrello 1.2 1;

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3