File Coverage

blib/lib/Set/Window.pm

Criterion	Covered	Total	%
statement	84	84	100.0
branch	41	42	97.6
condition			n/a
subroutine	19	19	100.0
pod	16	16	100.0
total	160	161	99.3

# Copyright 1996-2002 by Steven McDougall.
# This module is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.

package Set::Window;

use 5.6.0;
use strict;
use vars qw($VERSION @ISA);

require Exporter;

@ISA     = qw(Exporter);
$VERSION = '1.01';


sub new_lr
{
    my($class, $left, $right) = @_;
    $right < $left and return empty $class;
    bless [$left, $right], $class
}


sub new_ll
{
    my($class, $left, $length) = @_;
    $length  < 1 and return empty $class;
    bless [$left, $left+$length-1], $class
}


sub left
{
    my $window = shift;
    my($left, $right) = @$window;
    $right < $left and return undef;
    $left
}


sub right
{
    my $window = shift;
    my($left, $right) = @$window;
    $right < $left and return undef;
    $right
}


sub size
{
    my $window = shift;
    my($left, $right) = @$window;
    $right - $left + 1
}

*length = \&size;	#deprecated


sub elements
{
    my $window = shift;
    my($left, $right) = @$window;
    my @elements = ($left .. $right);
    wantarray ? @elements : \@elements
}


sub bounds
{
    my $window = shift;
    my($left, $right) = @$window;
    $right < $left and return undef;
    my @bounds = ($left, $right);
    wantarray ? @bounds : \@bounds
}


sub empty
{
    my $arg = shift;
    my $ref = ref $arg;

    $ref ?
	$arg->[1] < $arg->[0] :
	bless [0, -1], $arg
}


sub equal
{
    my($w1, $w2) = @_;
    $w1->[0]==$w2->[0] and $w1->[1]==$w2->[1]
}


sub equivalent
{
    my($w1, $w2) = @_;
    $w1->[1] - $w1->[0] == $w2->[1] - $w2->[0]
}


sub copy
{
    my $window = shift;
    bless [ @$window ], ref $window
}


sub offset
{
    my($window, $offset) = @_;
    $window = copy $window;
    empty $window and return $window;

    $window->[0] += $offset;
    $window->[1] += $offset;
    $window
}


sub inset
{
    my($window, $inset) = @_;
    $window = copy $window;
    empty $window and return $window;

    $window->[0] += $inset;
    $window->[1] -= $inset;

    empty $window and return empty (ref $window);

    $window
}


sub cover
{
    my(@windows) = grep { not empty $_ } @_;

    @windows or return empty Set::Window;

    my $window = shift @windows;
    my $cover  = copy  $window;

    for $window (@windows)
    {
	$cover->[0] > $window->[0] and $cover->[0] = $window->[0];
	$cover->[1] < $window->[1] and $cover->[1] = $window->[1];
    }

    $cover
}


sub intersect
{
    my(@windows) = @_;

    grep { empty $_ } @windows and return empty Set::Window;

    my $window = shift @windows;
    my $core   = copy  $window;

    for $window (@windows)
    {
	$core->[0] < $window->[0] and $core->[0] = $window->[0];
	$core->[1] > $window->[1] and $core->[1] = $window->[1];
    }

    empty $core and return empty Set::Window;
    $core
}


sub series
{
    my($window, $length) = @_;
    $length < 1 and return undef;

    my($left, $right) = @$window;
    my @left   = $left .. $right + 1 - $length;
    my $class  = ref $window;
    my @series = map { $class->new_ll($_, $length) } @left;
    wantarray ? @series : \@series
}

1

__END__