File Coverage

blib/lib/Bio/DNA/Incomplete.pm

Criterion	Covered	Total	%
statement	38	38	100.0
branch	6	6	100.0
condition	1	2	50.0
subroutine	9	9	100.0
pod	4	4	100.0
total	58	59	98.3

package Bio::DNA::Incomplete;
{
  $Bio::DNA::Incomplete::VERSION = '0.004';
}
use strict;
use warnings;

use Carp 'croak';
use Sub::Exporter::Progressive -setup => { exports => [qw/pattern_to_regex pattern_to_regex_string match_pattern all_possibilities/], groups => { default => [qw/pattern_to_regex pattern_to_regex_string match_pattern all_possibilities/]} };

my %simple = map { ( $_ => $_ ) } qw/A C G T/;

my %meaning_of = (
	R => 'AG',
	Y => 'CT',
	W => 'AT',
	S => 'CG',
	M => 'AC',
	K => 'GT',
	H => 'ACT',
	B => 'CGT',
	V => 'ACG',
	D => 'AGT',
	N => 'ACGT',
);
my %pattern_for = %meaning_of;
$_ = "[$_]" for values %pattern_for;
my ($invalid) = map { qr/[^$_]/ } join '', keys %simple, keys %pattern_for;
my %bases_for = (%meaning_of, %simple);
$_ = [ split // ] for values %bases_for;

sub pattern_to_regex_string {
	my $pattern = uc shift;
	croak 'Invalid pattern' if $pattern =~ /$invalid/;

	$pattern =~ s/([^ATCG])/$pattern_for{$1}/g;
	return "(?i:$pattern)";
}

sub pattern_to_regex {
	my $pattern = uc shift;
	my $string = pattern_to_regex_string($pattern);
	return qr/$string/;
};

sub match_pattern {
	my ($pattern, @args) = @_;
	my $regex = pattern_to_regex($pattern);
	return grep { $_ =~ /\A $regex \z/xms } @args;
}

sub _all_possibilities {
	my ($current, @rest) = @_;
	if (@rest) {
		my @ret;
		my $pretail = _all_possibilities(@rest);
		# Chunks longer than 1 are always /[ACTG]+/, so always match themselves
		for my $head (length $current == 1 ? @{ $bases_for{$current} } : $current) {
			for my $tail (@{$pretail}) {
				push @ret, $head.$tail;
			}
		}
		return \@ret;
	}
	else {
		return $bases_for{$current} || [ $current ];
	}
}

sub all_possibilities {
	my $pattern = uc shift;
	my @bases = $pattern =~ m/[ACTG]+|[^ACGT]/g;
	return @{ _all_possibilities(@bases) };
}

1;

#ABSTRACT: Match incompletely specified bases in nucleic acid sequences

__END__