view release on metacpan or  search on metacpan

lib/Algorithm/DLX.pm  view on Meta::CPAN

package Algorithm::DLX;

use strict;
use warnings;

our $VERSION = 0.03;

# Node structure for DLX
package DLX::Node;
sub new {
    my ($class, $row, $col) = @_;
    my $self = {
        row     => $row,
        col     => $col,
        left    => undef,
        right   => undef,
        up      => undef,
        down    => undef,
        column  => undef,
    };
    bless $self, $class;
    return $self;
}

# Column structure for DLX
package DLX::Column;
use base 'DLX::Node';
sub new {
    my ($class, $col) = @_;
    my $self = $class->SUPER::new(undef, $col);
    $self->{size}   = 0;
    $self->{name}   = $col;
    $self->{column} = $self;
    bless $self, $class;
    return $self;
}

# Main DLX package
package Algorithm::DLX;

sub new {
    my ($class) = @_;
    my $self = {
        header      => DLX::Column->new('header'),
        solution    => [],
        solutions   => [],
    };

    # Initialize header links
    $self->{header}->{left}     = $self->{header};
    $self->{header}->{right}    = $self->{header};
    bless $self, $class;

    return $self;
}

sub add_column {
    my ($self, $col_name) = @_;
    my $col = DLX::Column->new($col_name);

    $col->{left}    = $self->{header}->{left};
    $col->{right}   = $self->{header};
    $self->{header}->{left}->{right} = $col;
    $self->{header}->{left} = $col;
    $col->{up}      = $col;
    $col->{down}    = $col;

    return $col;
}

sub add_row {
    my ($self, $row, @cols) = @_;
    my $first;

    for my $col (@cols) {
        my $node = DLX::Node->new($row, $col->{name});
        $node->{column}     = $col;
        $col->{size}++;
        $node->{up}         = $col->{up};
        $node->{down}       = $col;
        $col->{up}->{down}  = $node;
        $col->{up}          = $node;
        if ($first) {
            $node->{left}   = $first->{left};
            $node->{right}  = $first;
            $first->{left}->{right} = $node;
            $first->{left}  = $node;
        } else {
            $first = $node;
            $node->{left}   = $node;