Algorithm-X-DLX

 view release on metacpan or  search on metacpan

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

      ++$row_taken[&$pack($y, $d)];
      ++$region_taken[&$pack($type->region_xy($x, $y), $d)];
    }
  }

  my @matrix;
  
  for my $i (0 .. $n - 1) {
    for my $j (0 .. $n - 1) {
      push @matrix, [&$id_cell($i, $j)]   if ($cell_taken[&$pack($i, $j)]);
      push @matrix, [&$id_col($i, $j)]    if ($col_taken[&$pack($i, $j)]);
      push @matrix, [&$id_row($i, $j)]    if ($row_taken[&$pack($i, $j)]);
      push @matrix, [&$id_region($i, $j)] if ($region_taken[&$pack($i, $j)]);
    }
  }

  my %row_position;
  my %row_digit;

  for my $y (0 .. $n - 1) {
    for my $x (0 .. $n - 1) {
      for my $d (0 .. $n - 1) {
        if ($cell_taken[&$pack($x, $y)]
          || $col_taken[&$pack($x, $d)]
          || $row_taken[&$pack($y, $d)]
          || $region_taken[&$pack($type->region_xy($x, $y), $d)]) {
          next;
        }
        my $row_index = scalar(@matrix);
        # Store the position and digit for later use
        $row_position{$row_index} = ($y * $n + $x);
        $row_digit{$row_index} = $d;
        push @matrix, [
          &$id_cell($x, $y),
          &$id_col($x, $d),
          &$id_row($y, $d),
          &$id_region($type->region_xy($x, $y), $d)
        ];
      }
    }
  }

  my $dlx_options = Algorithm::X::DLX::Options();
  if ($randomized) {
    #static std::random_device rd;
    #static auto engine = std::mt19937(rd());
    #options.choose_random_column = randomized;
    #options.random_engine = &engine;
    $dlx_options->{choose_random_column} = 1;
  }
  $dlx_options->{max_solutions} = $dlx_options->{choose_random_column} ? 1 : 2;

  my $problem = Algorithm::X::ExactCoverProblem->new(4 * $type->size(), \@matrix);
  my $dlx = Algorithm::X::DLX->new($problem);
  my ($dlx_result) = $dlx->search($dlx_options)->{solutions};

  # Collect solutions
  my @solutions;
  
  foreach my $rows (@$dlx_result) {
    my @solved = @{$sudoku->{values_}}; # Copy original sudoku
    foreach my $i (@$rows) {
      if (exists($row_position{$i})) {
        $solved[$row_position{$i}] = $row_digit{$i} + 1;
      }
    }
    push @solutions, Sudoku->new($sudoku->type, \@solved); # Store solved sudoku
  }

  if (!@solutions) {
    croak "No solution";
  }
  
  if (@solutions > 1) {
    croak "Multiple solutions";
  }

  return shift @solutions; # Return the first solution
}

1;



( run in 0.546 second using v1.01-cache-2.11-cpan-524268b4103 )