Algorithm-X-DLX

 view release on metacpan or  search on metacpan

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

  my $self = {};
  my $string = '';
  
  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);
  }

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

    my ($c, $self) = @_;
    
    my $pos = index($self->{labels}, $c);
    
    return ($pos == -1) ? 0 : ($pos + 1);
}

sub label {
    my ($i, $self) = @_;

    croak "Index out of bounds" if ($i > length($self->{labels}));
    
    return ($i == 0) ? '.' : substr($self->{labels}, $i - 1, 1);
}

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

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

            if ($type->region_xy($x, $y) != $type->region_xy($x, $y + 1)) {
                for my $dx (0 .. 2) {
                    $set->(2 * $x + $dx, 2 * $y + 2, '-');
                }
            }
        }
    }

    # Step 4: collapse uninteresting rows and columns
    my @keep_row = (0) x @lines;
    my @keep_col = (0) x length($lines[0]);

    for my $y (0 .. $#lines) {
        for my $x (0 .. length($lines[0]) - 1) {
            my $c = substr($lines[$y], $x, 1);
            if ($c ne ' ' && $c ne '|') {
                $keep_row[$y] = 1;
            }
            if ($c ne ' ' && $c ne '-') {
                $keep_col[$x] = 1;
            }
        }
    }

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

    $line .= $c;
  }
  push @lines, $line;
  my @region;
  my $next_id = 1;

  my $find_region;
  $find_region = sub {
    my ($id, $x, $y) = @_;

    return 0 if $x < 0 || $y < 0 || $y >= scalar(@lines) || $x >= length($lines[$y]);

    $region[$y][$x] = 0 unless defined $region[$y][$x];
    return 0 if $region[$y][$x] != 0;

    my $c = substr($lines[$y], $x, 1);
    return 0 if !SudokuFormat::is_valid_cell($c) && $c ne ' ';

    $region[$y][$x] = $id;
    my $region_size = 1;
    $region_size += $find_region->($id, $x, $y - 1);
    $region_size += $find_region->($id, $x, $y + 1);
    $region_size += $find_region->($id, $x - 1, $y);
    $region_size += $find_region->($id, $x + 1, $y);
    return $region_size;
  };

  for my $y (0 .. $#lines) {
    for my $x (0 .. length($lines[$y]) - 1) {
      if (!SudokuFormat::is_valid_cell(substr($lines[$y], $x, 1))) {
        next;
      }
      my $region_size = $find_region->($next_id, $x, $y);
      $next_id++ if $region_size > 0;
    }
  }

  my %region_size;
  my @final_regions;
  my $total_size = 0;

  for my $y (0 .. $#lines) {
    for my $x (0 .. length($lines[$y]) - 1) {
      if (SudokuFormat::is_valid_cell(substr($lines[$y], $x, 1))) {
        $total_size++;
        $region_size{$region[$y][$x]}++;
        push @final_regions, $region[$y][$x];
      }
    }
  }
#print "\%region_size = ", Dumper(\%region_size);
#print "guess(): \$total_size = $total_size, \$size = $size\n";
  croak "Total size mismatch" if $total_size != $size;

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

sub is_equal {
  my ($self, $other) = @_;
  return $self->{n_} == $other->{n_} && $self->{region_} eq $other->{region_};
}

sub box_regions {
  my ($w, $h) = @_;
  my @regions;
  my $n = $w * $h;

  # Creates an array of length size(), holding zero based region indexes (0-8) for the standard 3x3 box regions.
  for my $y (0 .. $n - 1) {
    for my $x (0 .. $n - 1) {
        push @regions, floor($y / $h) * $h + floor($x / $w);
    }
  }
  return \@regions;
}

# This function renumerates the given region values in ascending order, beginning with 0.
sub normalize_regions {

examples/sudoku/sudoku.pl  view on Meta::CPAN

  $input = '';
}

sub print_side_by_side {
  my ($left, $right) = @_;

  my @ls = split("\n", $left);
  my @rs = split("\n", $right);
  my $max_left = 0;
  foreach my $l (@ls) {
    $max_left = length($l) if length($l) > $max_left;
  }

  my $max_lines = scalar(@ls) > scalar(@rs) ? scalar(@ls) : scalar(@rs);
  for (my $y = 0; $y < $max_lines; $y++) {
    my $pos = 0;
    if ($y < scalar(@ls)) {
      print $ls[$y];
      $pos = length($ls[$y]);
    }
    if ($y < scalar(@rs)) {
      print ' ' x (4 + $max_left - $pos);
      print $rs[$y];
    }
    print "\n";
  }
}

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

  
  if (!@$bit_rows_ref) {
    return $class->new(0, undef, $secondary_columns);
  }

  my $width = scalar @{$bit_rows_ref->[0]};
  my $problem = $class->new($width, undef, $secondary_columns);

  foreach my $bits (@$bit_rows_ref) {
    if (scalar @$bits != $width) {
      croak("rows have different lengths");
    }
    
    my @row;
    for (my $i = 0; $i < @$bits; ++$i) {
      if ($bits->[$i] != 0 && $bits->[$i] != 1) {
        croak("dense matrix must contain only 0s and 1s");
      }
      push @row, $i if $bits->[$i];
    }
    $problem->add_row(\@row);

t/02-exactcoverproblem.t  view on Meta::CPAN

  throws_ok { Algorithm::X::ExactCoverProblem->new(5, [[5]]) }    qr/column out of range/i, 'size mismatch';
  throws_ok { Algorithm::X::ExactCoverProblem->new(1, [[0, 0]]) } qr/duplicate columns/i, 'duplicate columns';

  lives_ok { Algorithm::X::ExactCoverProblem->new(1, [[0]]) } 'size matches';
  lives_ok { Algorithm::X::ExactCoverProblem->new(2, [[1]]) } 'size matches';
  lives_ok { Algorithm::X::ExactCoverProblem->new(6, [[5]]) } 'size matches';
};

subtest 'dense matrix' => sub {
  plan tests => 9;
  throws_ok { Algorithm::X::ExactCoverProblem->dense([[0], []]) }    qr/rows have different lengths/i, 'row size mismatch';
  throws_ok { Algorithm::X::ExactCoverProblem->dense([[2]]) }    qr/dense matrix must contain only 0s and 1s/i, 'non boolean content';
  throws_ok { Algorithm::X::ExactCoverProblem->dense([[0], 2]) }    qr/Can't use string \("2"\) as an ARRAY ref/i, 'corrupted matrix';

  lives_ok { Algorithm::X::ExactCoverProblem->dense([]) } 'size matches';
  lives_ok { Algorithm::X::ExactCoverProblem->dense([[], []]) } 'size matches';
  lives_ok { Algorithm::X::ExactCoverProblem->dense([[0], [1]]) } 'size matches';
  lives_ok { Algorithm::X::ExactCoverProblem->dense([[0]], 1) } 'size matches';

  is 0, Algorithm::X::ExactCoverProblem->dense([[]])->width(), 'empty matrix width';
  is 2, Algorithm::X::ExactCoverProblem->dense([[0, 0]])->width(), 'column count';