123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120 |
- #!/usr/bin/perl
- # Daniel "Trizen" Șuteu
- # License: GPLv3
- # Date: 30 January 2017
- # https://github.com/trizen
- # Recursive brute-force Sudoku solver.
- # See also:
- # https://en.wikipedia.org/wiki/Sudoku
- use 5.016;
- use strict;
- sub check {
- my ($i, $j) = @_;
- use integer;
- my ($id, $im) = ($i / 9, $i % 9);
- my ($jd, $jm) = ($j / 9, $j % 9);
- $jd == $id && return 1;
- $jm == $im && return 1;
- $id / 3 == $jd / 3
- and $jm / 3 == $im / 3;
- }
- my @lookup;
- foreach my $i (0 .. 80) {
- foreach my $j (0 .. 80) {
- $lookup[$i][$j] = check($i, $j);
- }
- }
- sub solve_sudoku {
- my ($callback, @grid) = @_;
- sub {
- foreach my $i (0 .. 80) {
- if (!$grid[$i]) {
- my %t;
- undef @t{@grid[grep { $lookup[$i][$_] } 0 .. 80]};
- foreach my $k (1 .. 9) {
- if (!exists $t{$k}) {
- $grid[$i] = $k;
- __SUB__->();
- $grid[$i] = 0;
- }
- }
- return;
- }
- }
- $callback->(@grid);
- }->();
- }
- #<<<
- my @grid = qw(
- 5 3 0 0 7 0 0 0 0
- 6 0 0 1 9 5 0 0 0
- 0 9 8 0 0 0 0 6 0
- 8 0 0 0 6 0 0 0 3
- 4 0 0 8 0 3 0 0 1
- 7 0 0 0 2 0 0 0 6
- 0 6 0 0 0 0 2 8 0
- 0 0 0 4 1 9 0 0 5
- 0 0 0 0 8 0 0 7 9
- );
- @grid = qw(
- 0 0 0 8 0 1 0 0 0
- 0 0 0 0 0 0 0 4 3
- 5 0 0 0 0 0 0 0 0
- 0 0 0 0 7 0 8 0 0
- 0 0 0 0 0 0 1 0 0
- 0 2 0 0 3 0 0 0 0
- 6 0 0 0 0 0 0 7 5
- 0 0 3 4 0 0 0 0 0
- 0 0 0 2 0 0 6 0 0
- ) if 0;
- @grid = qw(
- 8 0 0 0 0 0 0 0 0
- 0 0 3 6 0 0 0 0 0
- 0 7 0 0 9 0 2 0 0
- 0 5 0 0 0 7 0 0 0
- 0 0 0 0 4 5 7 0 0
- 0 0 0 1 0 0 0 3 0
- 0 0 1 0 0 0 0 6 8
- 0 0 8 5 0 0 0 1 0
- 0 9 0 0 0 0 4 0 0
- ) if 0;
- #>>>
- solve_sudoku(
- sub {
- say "Solution:";
- my (@solution) = @_;
- foreach my $i (0 .. $#solution) {
- print "$solution[$i] ";
- print " " if ($i + 1) % 3 == 0;
- print "\n" if ($i + 1) % 9 == 0;
- print "\n" if ($i + 1) % 27 == 0;
- }
- }, @grid
- );
|