view release on metacpan or  search on metacpan

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

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 ) {