File Coverage

blib/lib/String/Cluster/Hobohm.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	7	8	87.5
condition	2	2	100.0
subroutine	9	9	100.0
pod	1	1	100.0
total	58	59	98.3

package String::Cluster::Hobohm;
$String::Cluster::Hobohm::VERSION = '0.141020';
# ABSTRACT: Cluster strings using the Hobohm algorithm

use strict;
use warnings;

use Mouse;
use String::Cluster::Hobohm::Types 'Quotient';
use Carp 'croak';
use Text::LevenshteinXS;

# accept a list of strings or a closure that returns, stepwise, the
# strings (this prevents loading everything into memory in the case that
# the dataset is too big)

# Return, for now, a structure with the indices
# {
#    index1 => [ index2, index3, index4 ]
#    ...
# }

has similarity => ( is => 'ro', default => 0.62, isa => Quotient );

sub cluster {
    my ($self, $sequences) = @_;
    defined $sequences or croak "Need sequences as argument";

    my @clusters;

    foreach my $sequence (@$sequences) {

        my $cluster_id = $self->_is_similar( $sequence, \@clusters );

        if ( defined $cluster_id ) {
            push @{ $clusters[ $cluster_id ] }, \$sequence;
        }
        else {
            push @clusters, [ \$sequence ]
        }
    }

    return \@clusters;
}

sub _is_similar {
    my ($self, $sequence, $clusters ) = @_;

    foreach my $i (0 .. $#$clusters) {
        my $similarity = $self->_similarity(\$sequence, $clusters->[$i][0]);

        return $i if $similarity >= $self->similarity;
    }

    return;
}

sub _similarity {
    my $self = shift;

    my @seqs = map { $$_ } @_;

    my $distance = Text::LevenshteinXS::distance(@seqs);
    defined $distance or croak "unable to compute distance";

    return 1 - $distance / (length( $seqs[0] ) || 1);
}

__PACKAGE__->meta->make_immutable;

__END__