view release on metacpan or  search on metacpan

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

package Algorithm::X::LinkedMatrix;

use strict;
use warnings;

require 5.06.0;

use Carp;
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);
      $self->{nodes}[$self->L($root)]->{r} = $id;
      $self->{nodes}[$root]->{l} = $id;
    }
  }

  for my $y (0 .. $#{$problem->rows()}) {
    $self->add_row($y, $problem->rows()->[$y]);
  }

  return $self;
}

sub add_row {
  my ($self, $y, $xs) = @_;

  my $first_id = 0;

  for my $x (@$xs) {
    my $id = $self->create_node($x, $y);
    $self->{nodes}[$id]{d} = $self->C($id);
    $self->{nodes}[$id]{u} = $self->U($self->C($id));
    $self->{nodes}[$self->U($self->C($id))]->{d} = $id;
    $self->{nodes}[$self->C($id)]->{u} = $id;
    $self->{sizes}[$x]++;

    if ($first_id == 0) {
      $first_id = $id;

    } else {
      $self->{nodes}[$id]{r} = $first_id;
      $self->{nodes}[$id]{l} = $self->L($first_id);
      $self->{nodes}[$self->L($first_id)]->{r} = $id;
      $self->{nodes}[$first_id]->{l} = $id;
    }
  }
}

sub cover_column {
  my ($self, $c) = @_;
  $c = $self->C($c);

  $self->{nodes}[$self->L($c)]->{r} = $self->R($c);
  $self->{nodes}[$self->R($c)]->{l} = $self->L($c);
  
  for (my $i = $self->D($c); $i != $c; $i = $self->D($i)) {
    for (my $j = $self->R($i); $j != $i; $j = $self->R($j)) {
      $self->{nodes}[$self->U($j)]->{d} = $self->D($j);
      $self->{nodes}[$self->D($j)]->{u} = $self->U($j);
      $self->{sizes}[$self->X($j)]--;
    }
  }
}

sub uncover_column {
  my ($self, $c) = @_;
  $c = $self->C($c);
  
  for (my $i = $self->U($c); $i != $c; $i = $self->U($i)) {