Permalink
Browse files

combine split-ness with Location role

  • Loading branch information...
1 parent b3ac00c commit a384c7c93214b66f781928f5b7e8ebd13876f483 Chris Fields committed Nov 22, 2011
@@ -18,8 +18,8 @@ $LOCREG = qr{
# make global for now, allow for abstraction later
our $SIMPLE_CLASS = 'Biome::Location::Simple';
-#our $SPLIT_CLASS = 'Biome::Location::Split';
-
+# TODO: refactor to a default attribute that lazily loads the class (I have code
+# for that somewhere, let's see, where did I put that......)
sub BUILD {
my ($self) = @_;
$self->load_modules($SIMPLE_CLASS);
@@ -31,6 +31,8 @@ sub from_string {
# run on first pass only
# Note : These location types are now deprecated in GenBank (Oct. 2006)
+
+ # TODO: deprecate support for these?
if (!defined($op)) {
# convert all (X.Y) to [X.Y]
$locstr =~ s{\((\d+\.\d+)\)}{\[$1\]}g;
@@ -2,6 +2,7 @@ package Biome::Role::Location::Locatable;
use Biome::Role;
use namespace::clean -except => 'meta';
+use List::Util qw(max min);
requires qw(start end strand from_string to_string);
@@ -10,7 +11,8 @@ requires qw(start end strand from_string to_string);
has 'seq_id' => (
is => 'rw',
- isa => 'Str'
+ isa => 'Str',
+ predicate => 'has_seq_id',
);
# returns true if strands are equal and non-zero
@@ -132,15 +134,10 @@ sub union {
$self->_eval_ranges(@$given);
- my @start = sort {$a <=> $b} map { $_->start() } ($self, @$given);
- my @end = sort {$a <=> $b} map { $_->end() } ($self, @$given);
+ my $id = $self->seq_id;
- my $start = shift @start;
- while( !$start ) {
- $start = shift @start;
- }
-
- my $end = pop @end;
+ my $start = min map { $_->start() } ($self, @$given);
+ my $end = max map { $_->end() } ($self, @$given);
my $union_strand = $self->strand; # Strand for the union range object.
@@ -33,17 +33,17 @@ role {
my $p = shift;
my ($class, $singular, $plural) = ($p->class, $p->short_name, $p->plural);
-
+
$class ||= 'Biome::Role::Location::Simple'; # any location consumer
-
+
if ($p->layered) {
$singular = "sub$singular";
$plural = "sub$plural";
}
-
+
has $singular => (
is => 'ro',
- isa => 'ArrayRef[Biome::Role::Location::Simple]', # needs a subtype or role type
+ isa => "ArrayRef[$class]", # needs a subtype or role type
traits => ['Array'],
default => sub {[]},
handles => {
@@ -53,7 +53,7 @@ role {
"remove_$plural" => 'clear'
}
);
-
+
# implementing class must provide this, is implementation-specific
requires "add_$singular";
};
@@ -72,15 +72,15 @@ container.
=head1 SYNOPSIS
package Foo;
-
+
use Biome;
with 'Biome::Role::Location::LocationContainer' =>
{ class => 'Biome::SeqFeature::Generic',
abbrev => 'Feature'};
-
+
# Foo now can contain an array of Biome::SeqFeature::Generic. Adding
- # a new
-
+ # a new
+
=head1 DESCRIPTION
Simple parameterizable role for anything that has one or more Locations
@@ -99,7 +99,7 @@ A method to add new Locations; as this is implementation-specific,
this is required for anything consuming this class. For instance, a consumer
-=back
+=back
=head1 SUBROUTINES/METHODS
@@ -158,12 +158,12 @@ BioPerl mailing lists. Your participation is much appreciated.
Patches are always welcome.
-=head2 Support
-
+=head2 Support
+
Please direct usage questions or support issues to the mailing list:
-
+
L<bioperl-l@bioperl.org>
-
+
rather than to the module maintainer directly. Many experienced and reponsive
experts will be able look at the problem and quickly address it. Please include
a thorough description of the problem with code and data examples if at all
@@ -258,4 +258,4 @@ followed by whatever licence you wish to release it under.
For Perl code that is often just:
This module is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself. See L<perlartistic>.
+modify it under the same terms as Perl itself. See L<perlartistic>.
@@ -2,10 +2,13 @@ package Biome::Role::Location::Simple;
use 5.010;
use Biome::Role;
-use namespace::clean -except => 'meta';
+use namespace::autoclean -except => 'meta';
-use Biome::Type::Location qw(Location_Type Location_Symbol
- Location_Pos_Type Location_Pos_Symbol);
+use Biome::Type::Location qw(Location_Type
+ Split_Location_Type
+ Location_Symbol
+ Location_Pos_Type
+ Location_Pos_Symbol);
with 'Biome::Role::Location::Stranded';
@@ -166,6 +169,33 @@ sub valid_Location {
sub to_string {
my ($self) = @_;
+ my $type = $self->location_type;
+
+ if (is_Split_Location_Type($type)) {
+ my @segs = $self->sub_Locations;
+ my $str = lc($type).'('.join(',', map {$_->to_string} @segs).')';
+ if ($self->strand && $self->strand < 0) {
+ $str = "complement($str)";
+ }
+ return $str;
+ }
+
+# # JOIN assumes specific order, ORDER does not, BOND ?
+# my $type = $self->location_type;
+# if ($self->resolve_Locations) {
+# my $substrand = $self->sub_Location_strand;
+# if ($substrand && $substrand < 0) {
+# $self->flip_strand();
+# $self->strand(-1);
+# }
+# }
+# my @segs = $self->sub_Locations;
+# my $str = lc($type).'('.join(',', map {$_->to_string} @segs).')';
+# if ($self->strand && $self->strand < 0) {
+# $str = "complement($str)";
+# }
+# $str;
+
my %data;
for (qw(
start end
@@ -2,7 +2,7 @@ package Biome::Role::Location::Split;
use 5.010;
use Biome::Role;
-use Biome::Type::Location qw(ArrayRef_of_Locatable);
+use Biome::Type::Location qw(Split_Location_Type ArrayRef_of_Locatable);
use Biome::Type::Sequence qw(Maybe_Sequence_Strand);
use List::Util qw(reduce);
use namespace::clean -except => 'meta';
@@ -28,22 +28,40 @@ has 'locations' => (
default => sub { [] }
);
-
+has 'auto_expand' => (
+ isa => 'Bool',
+ is => 'ro',
+ default => 1
+);
sub add_sub_Location {
my ($self, $loc) = @_;
- # TODO : deal with remote locations, offsets
- # TODO : make expansion optional
-
- #if ($self->auto_expand) {
- my ($start,$end,$strand) = $self->union($loc);
- $self->debug("$start-$end:$strand\n");
- $self->start($start);
- $self->end($end);
- $self->strand($strand);
- #}
- $self->push_sub_Location($loc);
+ if (!is_Split_Location_Type($self->location_type)) {
+ $self->throw("Type ".$self->location_type." does not allow sub locations, change location_type");
+ }
+
+ my $locs = $self->locations;
+
+ if ($self->auto_expand) {
+ if (@$locs) {
+ if (!$loc->is_remote) {
+ my ($start,$end,$strand) = $self->union($loc);
+ $self->strand($strand);
+ $self->start($start);
+ $self->end($end);
+ }
+ } else {
+ $self->start($loc->start);
+ $self->end($loc->end);
+ $self->strand($loc->strand);
+ $self->seq_id($loc->seq_id) if $loc->seq_id;
+ }
+ }
+
+ push @$locs, $loc;
+
+ 1;
}
#has 'location_type' => (
View
@@ -13,6 +13,8 @@ use MooseX::Types -declare => [qw(
Location_Pos_Type
Location_Symbol
Location_Type
+ Simple_Location_Type
+ Split_Location_Type
Locatable
ArrayRef_of_Locatable
@@ -45,16 +47,22 @@ my %SYMBOL_TYPE = (
my %TYPE_SYMBOL = map {$SYMBOL_TYPE{$_} => $_} keys %SYMBOL_TYPE;
+# TODO: convert these to enums
+my %VALID_SPLIT_TYPE = map {$_ => 1}
+ qw(JOIN ORDER BOND);
+
+my %VALID_SIMPLE_TYPE = map {$_ => 1}
+ qw(EXACT IN-BETWEEN WITHIN);
+
# WITHIN here is very rare but does occur, ex (122.144)
my %VALID_LOCATION_TYPE = map {$_ => 1}
- qw(EXACT IN-BETWEEN WITHIN JOIN ORDER BOND);
+ (keys(%VALID_SIMPLE_TYPE), keys(%VALID_SPLIT_TYPE));
my %VALID_LOCATION_POS_TYPE = map {$_ => 1}
qw(EXACT BEFORE AFTER WITHIN UNCERTAIN);
# TODO: some of these could probably be redef. as enums, but it makes coercion
# easier, needs checking
-
subtype Location_Symbol,
as Str,
where {exists $VALID_LOCATION_SYMBOL{$_}},
@@ -65,6 +73,16 @@ subtype Location_Type,
where {exists $VALID_LOCATION_TYPE{$_}},
message {"Unknown Location type $_"};
+subtype Split_Location_Type,
+ as Str,
+ where {exists $VALID_SPLIT_TYPE{uc $_}},
+ message {"Unknown Split Location type $_"};
+
+subtype Simple_Location_Type,
+ as Str,
+ where {exists $VALID_SIMPLE_TYPE{uc $_}},
+ message {"Unknown Split Location type $_"};
+
subtype Location_Pos_Symbol,
as Str,
where {exists $VALID_LOCATION_POS_SYMBOL{$_}},
@@ -91,14 +109,6 @@ coerce Location_Type,
from Location_Symbol,
via {$TYPE_SYMBOL{$_}};
-#my %VALID_SPLIT_TYPE = map {$_ => 1}
-# qw(JOIN ORDER BOND);
-
-#subtype Split_Location_Type,
-# as Str,
-# where {exists $VALID_SPLIT_TYPE{uc $_}},
-# message {"Unknown Split Location type $_"};
-
role_type Locatable, { role => 'Biome::Role::Location::Locatable' };
subtype ArrayRef_of_Locatable,
Oops, something went wrong.

0 comments on commit a384c7c

Please sign in to comment.