view release on metacpan or  search on metacpan

SetCovering.pm  view on Meta::CPAN

package Algorithm::SetCovering;

use strict;
use warnings;
use Log::Log4perl qw(:easy);

our $VERSION = '0.05';

##################################################
sub new {
##################################################
    my($class, @options) = @_;

    my %options = @options;

    die "No value given for mandatory parameter 'columns'"
        unless exists $options{columns};

    my $self = {
        mode     => "greedy",
        @options,
        rows     => [],
        prepared => 0,
        combos   => [],
    };

    bless $self, $class;
}

##############################################
sub add_row {
##############################################
    my($self, @columns) = @_;

    if($self->{columns} != scalar @columns) {
        die "add_row expects $self->{columns} columns" .
            "but received " . scalar @columns . "\n";
    }
  
    DEBUG "Adding row @columns";

    push @{$self->{rows}}, [@columns];

    $self->{prepared} = 0;
}

##############################################
sub row {
##############################################
    my($self, $idx) = @_;

    return @{$self->{rows}->[$idx]};
}

##############################################
sub min_row_set {
##############################################
    my($self, @columns_to_cover) = @_;

    if($self->{mode} eq "brute_force") {
        return brute_force_run(@_);
    } elsif($self->{mode} eq "greedy") {
        return greedy_run(@_);
    } else {
        die "$self->{mode} not implemented\n";
    }
}

##############################################
sub brute_force_run {
##############################################
    my($self, @columns_to_cover) = @_;

    $self->brute_force_prepare() unless $self->{prepared};

    COMBO:
    for my $combo (@{$self->{combos}}) {

        for(my $idx = 0; $idx < @columns_to_cover; $idx++) {
            # Check if the combo covers it, [0] is a ref
            # to a hash for quick lookups.
            next unless $columns_to_cover[$idx];
            next COMBO unless $combo->[0]->[$idx];
        }
            # We found a minimal set, return all of its elements 
            # (which are idx numbers into the @rows array)
        return @{$combo->[1]};