Algorithm-X-DLX

 view release on metacpan or  search on metacpan

examples/langford/Langford.pm  view on Meta::CPAN

    problem_ => Algorithm::X::ExactCoverProblem->new(3 * $n)
  };

  for my $value (1 .. $n) {
    for my $pos (0 .. 2 * $n - $value - 2) {
      next if $value == 1 && $pos + 2 > $n;
      push @{$self->{row_data_}}, { value => $value, left_pos => $pos };
      $self->{problem_}->add_row([$value - 1, $n + $pos, $n + $pos + $value + 1]);
    }
  }
  return bless $self, $class;
}

sub problem {
  my ($self) = @_;
  return $self->{problem_};
}

sub make_solution {
  my ($self, $used_rows) = @_;
  my @solution = (0) x (2 * $self->{n_});

examples/npieces/NPieces.pm  view on Meta::CPAN

use Algorithm::X::DLX;
use Algorithm::X::ExactCoverProblem;
use Carp;

use constant { None => 0, Knight => 1, Queen => 2 };

sub new {
  my ($class, %args) = @_;

  my $self = bless {
    width_    => $args{width}   || 0,
    height_   => $args{height}  || 0,
    knights_  => $args{knights} || 0,
    queens_   => $args{queens}  || 0,
    problem_  => undef,
    row_data_ => [],
    iterator_ => undef
  }, $class;

  return $self->_initialize();

examples/nqueens/NQueens.pm  view on Meta::CPAN

  my $problem = Algorithm::X::ExactCoverProblem->new(6 * $n - 2, undef, 4 * $n - 2);

  for my $y (0 .. $n - 1) {
    for my $x (0 .. $n - 1) {
      push @row_data, { x => $x, y => $y };
      my $d1 = $x + $y;
      my $d2 = $x + $n - $y - 1;
      $problem->add_row([$d1, $D + $d2, $D + $D + $x, $D + $D + $n + $y]);
    } 
  }
  return bless { n_ => $n, problem_ => $problem, row_data_ => \@row_data, }, $class;
} 

sub count_solutions {
  my ($self) = @_;
  my $dlx = Algorithm::X::DLX->new($self->{problem_});
  return $dlx->count_solutions();
} 

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

examples/polyomino/Polyomino.pm  view on Meta::CPAN

  $pieces //= [Shape::pentominoes()];
  $area //= Polyomino::area(10, 6);
  my $self = {
    area_ => $area,
    index_ => [],
    shapes_ => [],
    size_ => Polyomino::get_size($area),
    row_data_ => [],
    problem_ => Algorithm::X::ExactCoverProblem->new(scalar(@$pieces) + Polyomino::get_size($area))
  };
  bless $self, $class;
  foreach my $piece (@$pieces) {
    push @{$self->{shapes_}}, [$piece->variations()];
  }
  my $height = $self->height();
  my $width = $self->width();
  for (my $y = 0, my $i = 0; $y < $height; ++$y) {
    for (my $x = 0; $x < $width; ++$x) {
      if ($self->{area_}[$y][$x]) {
        $self->{index_}[$y][$x] = $i++;
      }

examples/polyomino/Shape.pm  view on Meta::CPAN

use strict;
use warnings;

use List::Util qw(reduce);
use Carp;

sub new {
  my ($class, $name, $bits) = @_;
  # Handle different constructor calls 
  if (!defined $name) {
    #return bless { name => '#', bits => [], width => 0, height => 0 }, $class;
    $name = '#';
    $bits = [];
  } elsif (ref($name) eq 'ARRAY') {
    #return bless { name => '#', bits => $name, width => @{$name ? $name->[0] : []}, height => scalar @$name }, $class;
    $bits = $name;
    $name = '#';
  }
  my $self = {
    name => $name,
    bits => $bits,
    width => (@$bits ? scalar @{$bits->[0]} : 0),
    height => scalar @$bits,
  };
  # Assert that all rows have the same width
  $self->{content} = '';
  for my $row (@$bits) {
    croak "Row width mismatch" unless @$row == $self->{width};
    $self->{content} .= join('', @$row) . ',';
  }
  return bless $self, $class;
}

sub pentominoes {
  return (
    Shape->new('I', [[1, 1, 1, 1, 1]]),
    Shape->new('N', [[1, 1, 1, 0], [0, 0, 1, 1]]),
    Shape->new('L', [[1, 1, 1, 1], [1, 0, 0, 0]]),
    Shape->new('Y', [[1, 1, 1, 1], [0, 1, 0, 0]]),
    Shape->new('P', [[1, 1, 1], [1, 1, 0]]),
    Shape->new('C', [[1, 1, 1], [1, 0, 1]]),

examples/sudoku/Sudoku.pm  view on Meta::CPAN

  
  foreach my $arg (@_) {
    if (ref($arg) eq 'SudokuType') {
      $self->{type_} = $arg;
    } elsif (ref($arg) eq 'ARRAY') {
      $self->{values_} = [@$arg];
    } elsif (defined $arg && !ref($arg)) {
      croak "Got empty string" unless length $arg;
      $string = $arg;
    } else {
      die "Unknown blessed parameter.\n";
    }
  }

  if (! $self->{type_} && $string ) {
   $self->{type_} = SudokuType::guess($string);
  }

  if (! $self->{values_} && $string ) {
   $self->{values_} = SudokuFormat::get_values($string);
  }
  
  $self->{type_}   ||= SudokuType->new();
  $self->{values_} ||= [(0) x $self->{type_}->size()];

  return bless $self, $class;
}

sub type {
  my ($self) = @_;
  return $self->{type_};
}

sub size {
  my ($self) = @_;
  return $self->{type_}->size();

examples/sudoku/SudokuFormat.pm  view on Meta::CPAN

    foreach my $c (split //, $self->{template}) {
        if (is_cell($c, $self)) {
            $cells++;
        }
    }
    
    if ($cells != $self->{type}->size()) {
        croak "Invalid number of cells";
    }

    bless $self, $class;
    return $self;
}

sub compact {
    my ($class, $type) = @_;

    my $line = '.' x $type->n() . "\n";
    my $result = '';
    for (my $y = 0; $y < $type->n(); ++$y) {
        $result .= $line;
    }
    
    my $self = { type => $type, template => $result, labels => choose_labels($result) };
    weaken($self->{type});

    return bless $self, $class;
}

sub oneline {
    my ($class, $type) = @_;

    my $result = '.' x $type->size() . "\n";
    my $self = { type => $type, template => $result, labels => choose_labels($result) };
    weaken($self->{type});

    return bless $self, $class;
}

sub with_labels {
    my ($self, $str) = @_;
    my @labels = choose_labels_n($str, scalar split //, $self->{type}->n());
    
    my %new_self = %{$self};
    @new_self{qw(labels)} = @labels; 
   
    return bless \%new_self, ref($self);
}

sub count_cells {
    my $str = shift() or return 0;
    my $count = 0;

    foreach my $c (split //, $str) {
        if (is_valid_label($c) || is_empty($c)) {
            ++$count;
        }

examples/sudoku/SudokuGenerator.pm  view on Meta::CPAN

use SudokuSolver;
use Sudoku;

sub new {
  my $class = shift;
  my $self = {
#    engine => Math::Random::MT::Auto->new(
#      seed => int(time() ^ ($$ + ($$ << 15)))
#    )
  };
  bless $self, $class;
  return $self;
}

sub generate {
  my ($self, $type) = @_;
  my $sudoku = SudokuSolver::random_solution(Sudoku->new($type));

  my @yxs = (0 .. $type->size() - 1);
  while (1) {
    @yxs = shuffle(@yxs);

examples/sudoku/SudokuType.pm  view on Meta::CPAN

  } elsif (@args == 1) {
    my $n = $args[0];
    # NxN version of the 9x9.
    return new($class, isqrt($n), isqrt($n));
  } elsif (@args == 2) {
    # Sudoku with rectangle-shaped regions.
    return new($class, box_regions($args[0], $args[1]));
  } else {
    croak "Invalid arguments";
  }
  bless $type, $class;
  if ($type->n() < 1) {
    croak "Sudoku must have non-zero size";
  }
  return $type;
}

sub from_size {
    my ($size) = @_;
    return new(__PACKAGE__, isqrt($size));
}

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

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};
}

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

require 5.06.0;

use Carp;

# Constructor with width and secondary_columns
sub new {
  my ($class, $width, $rows_ref, $secondary_columns) = @_;
  $width             = 0 unless defined $width;
  $secondary_columns = 0 unless defined $secondary_columns;

  my $self = bless {
    rows_               => [],
    width_              => $width,
    secondary_columns_  => $secondary_columns,
  }, $class;
  
  if ($secondary_columns > $width) {
    croak("secondary_columns > width");
  }
  
  if (defined $rows_ref) {

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

use Algorithm::X::ExactCoverProblem;

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

  my $self = {
    col_ids => [],
    sizes   => [(0) x $problem->width()],
    nodes   => [],
  };
  bless $self, $class;

  my $root = $self->create_node(~0, ~0);
  croak "Root ID mismatch" unless $root == $self->root_id();

  for my $x (0 .. $problem->width() - 1) {
    my $id = $self->create_node($x, ~0);
    $self->{col_ids}[$x] = $id;
    if ($x >= $problem->secondary_columns()) {
      $self->{nodes}[$id]{r} = $root;
      $self->{nodes}[$id]{l} = $self->L($root);