File Coverage

blib/lib/Algorithm/X/DLX.pm

Criterion	Covered	Total	%
statement	45	87	51.7
branch	8	32	25.0
condition	4	12	33.3
subroutine	11	18	61.1
pod	0	14	0.0
total	68	163	41.7

package Algorithm::X::DLX;

use strict;
use warnings;

our $VERSION = '0.03';

require 5.06.0;

use Algorithm::X::LinkedMatrix;

sub new {
  my ($class, $problem) = @_;
  return bless { A_ => Algorithm::X::LinkedMatrix->new($problem), iterator => undef }, $class;
}

sub count_solutions {
  my $self = shift;

  my $options = Options();
  $options->{get_solutions} = 0;

  return $self->search($options)->{number_of_solutions};
}

sub find_solutions {
  my ($self, $max) = @_;

  my $options = Options();
  $options->{max_solutions} = $max if defined $max;

  return $self->search($options)->{solutions};
}

sub search {
  my ($self, $options) = @_;
  $options ||= Options();

  if ($options->{random_engine}) {
    die "The option to select a random engine has been removed in Perl";
  }

  my $result = { profile => [], number_of_solutions => 0, solutions => [] };
  $self->{iterator} ||= $self->get_solver($options->{choose_random_column}, $result->{profile});

  while (my $solution = $self->{iterator}() ) {
    $result->{number_of_solutions}++;
    if ($options->{get_solutions}) {
      push @{$result->{solutions}}, $solution;
    }
    last if $result->{number_of_solutions} >= $options->{max_solutions};
  }

  return $result;
}

sub next_solution {
  my $self = shift;

  return $self->{iterator}();
}

sub get_solver {
  my ($self, $random_column, $profile) = @_;

  my $h = $self->{A_}->root_id();
  my @placed = ();
  my $level = 0;
  my @state_stack = ([undef, undef]);

  return sub {
    # brought back on track by by Antti Ajanki, Tom Boothby at https://github.com/sagemath/sage/blob/develop/src/sage/combinat/dlx.py

    while ( $level >= 0 ) {
      my ($c, $r) = @{$state_stack[$level]};

      if ( not $c ) {
        ++$profile->[ @placed ] if $profile;

        if ($self->R($h) == $h) {
          # base case ( no columns left )
          $level--;
          return [ @placed ];

        } else {
          # fetch remaining columns that share the same, lowest node count at present
          my @cs = ();
          for (my $j = $self->R($h); $j != $h; $j = $self->R($j)) {
            if (@cs && $self->S($j) < $self->S($cs[0])) {
              @cs = ();
            }
            push @cs, $j if !@cs || $self->S($j) == $self->S($cs[0]);
          }

          die "No columns found" if !@cs;

          if ($self->S($cs[0]) < 1) {
            $level--;
            next;
          }

          $c = $random_column ? ($cs[int rand @cs]) : $cs[0];

          $self->cover_column($c);
          $state_stack[$level] = [$c, $c];
        }

      } elsif ($self->D($r) != $c) {

        if ($c != $r) {
          pop @placed;
          for (my $j = $self->L($r); $j != $r; $j = $self->L($j) ) {
            $self->uncover_column($j);
          }
        }

        $r = $self->D($r);
        $placed[$level] = $self->Y($r);
        for (my $j = $self->R($r); $j != $r; $j = $self->R($j)) {
          $self->cover_column($j);
        }

        $state_stack[$level] = [$c, $r];
        $level++;

        if (@state_stack == $level) {
          push @state_stack, [undef, undef];
        } else {
          $state_stack[$level] = [undef, undef];
        }

      } else {
        if ($c != $r) {
          pop @placed;

          for (my $j = $self->L($r); $j != $r; $j = $self->L($j) ) {
            $self->uncover_column($j);
          }
        }
        $self->uncover_column($c);
        $level--;
      }
    }
  };
}

sub Options {
  return  {
    choose_random_column => 0,
    get_solutions => 1,
    max_solutions => ~0,
  #  random_engine => undef,
  }
}

# acquire some matrix methods
sub cover_column   { return shift()->{A_}->cover_column(@_) }
sub uncover_column { return shift()->{A_}->uncover_column(@_) }
sub Y { return shift()->{A_}->Y(@_) }
sub S { return shift()->{A_}->S(@_) }
sub R { return shift()->{A_}->R(@_) }
sub L { return shift()->{A_}->L(@_) }
sub D { return shift()->{A_}->D(@_) }

1;

__END__