From 15abec4e7d8138adc597d93010159a19750f3de7 Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Wed, 9 Nov 2011 15:34:08 +0000 Subject: overlapping ranges also, use inifinites instead of magic undefs --- .../lib/Data/TagsAndRanges/Exceptions.pm | 19 ++++ .../lib/Data/TagsAndRanges/RangeContainer.pm | 114 ++++++++++++++++----- Data-TagsAndRanges/t/overlapping-ranges.t | 48 +++++++++ 3 files changed, 155 insertions(+), 26 deletions(-) create mode 100644 Data-TagsAndRanges/t/overlapping-ranges.t diff --git a/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm b/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm index c28824b..def6108 100644 --- a/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm +++ b/Data-TagsAndRanges/lib/Data/TagsAndRanges/Exceptions.pm @@ -33,6 +33,25 @@ extends 'Data::TagsAndRanges::Exceptions::NotFound'; has '+message' => ( default => 'no range found for value ', ); +} +package Data::TagsAndRanges::Exceptions::BadRange;{ +use Moose; +extends 'Throwable::Error'; + +has ['from','to'] => ( is => 'ro', required => 1 ); +has '+message' => ( + default => 'invalid range: ', +); + +sub as_string { + my ($self) = @_; + + my $str = $self->message . $self->from . ', ' . $self->to; + $str .= "\n\n" . $self->stack_trace->as_string; + + return $str; +} + } 1; diff --git a/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm b/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm index 5f3653a..e93805e 100644 --- a/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm +++ b/Data-TagsAndRanges/lib/Data/TagsAndRanges/RangeContainer.pm @@ -9,8 +9,8 @@ has _storage => ( is => 'rw', isa => ArrayRef[ Dict[ - from => Num|Undef, - to => Num|Undef, + from => Num, + to => Num, value => Any, ], ], @@ -21,7 +21,7 @@ has _storage => ( sub get { my ($self,$args) = @_; - my $at = $args->{at}; + my $at = $args->{at} // 0-'inf'; my ($range) = $self->_get_slot_at($at); @@ -34,42 +34,55 @@ sub get { return $range; } -sub _cmp_less { - return if !defined $_[0]; - return 1 if !defined $_[1]; - return $_[0] <= $_[1]; -} -sub _cmp_more { - return if !defined $_[0]; - return 1 if !defined $_[1]; - return $_[0] > $_[1]; -} -sub _cmp_eq { - return 1 if !defined($_[0]) && !defined($_[1]); - return if defined($_[0]) xor defined($_[1]); - return $_[0] == $_[1]; -} - sub _get_slot_at { my ($self,$at) = @_; for my $slot (@{$self->_storage}) { - next if _cmp_less($slot->{to},$at); - last if _cmp_more($slot->{from},$at); + next if $slot->{to} <= $at; + last if $slot->{from} > $at; return $slot; } return; } +sub _partition_slots { + my ($self,$from,$to) = @_; + + my (@before,@overlap,@after); + my $st=$self->_storage; + + keys @$st; + + while (my ($idx,$slot) = each @$st) { + my ($sf,$st) = @$slot{'from','to'}; + + if ($st<$from) { + push @before,$idx; + } + elsif ($sf>=$to) { + push @after,$idx; + } + else { + push @overlap,$idx; + } + } + return \@before,\@overlap,\@after; +} + sub set_or_create { my ($self,$args) = @_; - my $from = $args->{from}; - my $to = $args->{to}; + my $from = $args->{from} // 0-'inf'; + my $to = $args->{to} // 0+'inf'; + + Data::TagsAndRanges::Exceptions::BadRange->({ + from => $from, + to => $to, + }) if $from > $to; my ($range) = $self->_get_slot_at($from); - if ($range && _cmp_eq($range->{from},$from) && _cmp_eq($range->{to},$to)) { + if ($range && $range->{from}==$from && $range->{to}==$to) { return $range; } @@ -80,12 +93,61 @@ sub set_or_create { sub _create_slot { my ($self,$from,$to) = @_; - push @{$self->_storage},{ + my $new = { from => $from, to => $to, value => undef, }; - return $self->_storage->[-1]; + + if (!@{$self->_storage}) { # empty + push @{$self->_storage},$new; + return $new; + } + + my ($before,$overlap,$after) = $self->_partition_slots($from,$to); + + if (!@$before && !@$overlap) { + unshift @{$self->_storage},$new; + return $new; + } + if (!@$after && !@$overlap) { + push @{$self->_storage},$new; + return $new; + } + + # by costruction, the first and the last may have to be split, all + # others must be removed + my $first_to_replace = $overlap->[0], + my $last_to_replace = $overlap->[-1], + my $how_many = @$overlap; + + my @replacement = ($new); + + if ($how_many > 0) { # we have to splice + my $first = $self->_storage->[$first_to_replace]; + my $last = $self->_storage->[$last_to_replace]; + + if ($first->{from} < $from && $first->{to} >= $from) { + unshift @replacement, { + from => $first->{from}, + to => $from, + value => $first->{value}, + } + } + if ($last->{from} < $to && $last->{to} >= $to) { + push @replacement, { + from => $to, + to => $last->{to}, + value => $last->{value}, + } + } + } + + splice @{$self->_storage}, + $first_to_replace,$how_many, + @replacement; + + return $new; } 1; diff --git a/Data-TagsAndRanges/t/overlapping-ranges.t b/Data-TagsAndRanges/t/overlapping-ranges.t new file mode 100644 index 0000000..55355ef --- /dev/null +++ b/Data-TagsAndRanges/t/overlapping-ranges.t @@ -0,0 +1,48 @@ +#!perl +use strict; +use warnings; +use Test::Most 'die'; +use Data::Printer; +use Data::TagsAndRanges; + +my $obj = Data::TagsAndRanges->new(); +ok($obj,'constructor works'); + +$obj->set({ + from=>10, + to=>20, + value=>1, +}); +$obj->set({ + from=>15, + to => 30, + value => 2, +}); + +my %points = ( + 10,1, + 12,1, + 13,1, + 14,1, + 15,2, + 17,2, + 19,2, + 20,2, + 25,2, + 29,2, +); +while (my ($at,$v) = each %points) { + cmp_ok($obj->get({at=>$at}), + '==', + $v, + "value at $at"); +} + +dies_ok { + $obj->get({at=>30}) +} 'far end'; +dies_ok { + $obj->get({at=>9}) +} 'far end'; + +done_testing(); -- cgit v1.2.3