File Coverage

blib/lib/Array/OverlapFinder.pm

Criterion	Covered	Total	%
statement	58	58	100.0
branch	15	16	93.7
condition	3	3	100.0
subroutine	7	7	100.0
pod	2	2	100.0
total	85	86	98.8

package Array::OverlapFinder;

our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
our $DATE = '2021-01-02'; # DATE
our $DIST = 'Array-OverlapFinder'; # DIST
our $VERSION = '0.004'; # VERSION

use 5.010001;
use strict;
use warnings;

use Exporter qw(import);
our @EXPORT_OK = qw(find_overlap combine_overlap);

sub _find_or_combine_overlap {
    my $action = shift;
    my $opts = ref($_[0]) eq 'HASH' ? shift : {};
    my $detail = $opts->{detail};
    @_ >= 2 or die "Please supply at least two sequences";

    my @detail_res;
    my @all_overlap_items;

    my $seq1 = shift;
    my $num_seqs = 1;
  SEQ:
    while (@_) {
        my $seq2 = shift;
        $num_seqs++;

        my @overlap_items;
        my $index_at_seq1;

      L1:
        for my $i (0 .. $#{$seq1}) {
            my $j = $i;
            while ($j <= $#{$seq1} && ($j-$i) <= $#{$seq2}) {
                if ($seq1->[$j] ne $seq2->[$j - $i]) {
                    next L1;
                }
                $j++;
            }
            @overlap_items = @{$seq1}[$i .. $#{$seq1}];
            $index_at_seq1 = $i;
        last L1;
        }

        my @combined;
        if (defined $index_at_seq1) {
            @combined = (@$seq1, @{$seq2}[ ($#{$seq1} - $index_at_seq1 + 1) .. $#{$seq2} ]);
        } else {
            @combined = (@$seq1, @$seq2);
        }
        $seq1 = \@combined;

        push @detail_res, \@overlap_items, $index_at_seq1;
        push @all_overlap_items, \@overlap_items;
    } # SEQ

    if ($action eq 'find') {
        if ($detail) {
            return @detail_res;
        } else {
            if ($num_seqs > 2) {
                return @all_overlap_items;
            } else {
                return @{ $all_overlap_items[0] };
            }
        }
    } else {
        # combine
        if ($detail) {
            return ($seq1, @detail_res);
        } else {
            return @$seq1;
        }
    }
}

sub find_overlap    { _find_or_combine_overlap('find', @_) }

sub combine_overlap { _find_or_combine_overlap('combine', @_) }

1;
# ABSTRACT: Find/remove overlapping items among ordered sequences

__END__