ボゴソートを応用した数独解答プログラム。

sudoku.pl

#!perl
use v5.12;

use Storable qw/dclone/;
use List::Util qw/shuffle/;
use Set::Intersection;

#my @board = qw(
#0 9 0 3 0 0 0 0 0
#5 0 0 0 0 0 7 0 0
#0 0 6 0 4 0 2 0 0
#0 5 0 0 7 0 1 2 3
#0 0 2 0 1 0 9 0 8
#0 8 3 0 0 6 0 7 4
#9 4 7 1 0 5 6 8 2
#2 0 8 9 0 0 3 0 7
#3 6 5 8 0 0 4 1 9
#);
my @board = qw(
2 9 8 5 3 6 7 1 4
5 0 6 8 0 4 3 0 9
4 3 7 2 1 9 5 6 8
6 4 9 7 2 3 8 5 1
3 0 1 9 0 8 2 0 6
7 8 2 6 5 1 4 9 3
1 7 4 3 6 5 9 8 2
8 0 5 4 0 2 1 0 7
9 2 3 1 8 7 6 4 5
);

my $cnt = 0;
my @seed;
for my $i ( 1 .. 9 ) {
	push @seed, ($i) x (9 - scalar grep {$_ == $i} @board);
}
local $|=1;
while (1) {
  ++$cnt;

  my $b = dclone(\@board);
  solve($b, \@seed);
  #dump_board($b);
  if (verify($b)) {
  	@board = @$b;
  	last;
  }

  print "$cnt\r" if 0 == $cnt % 1000;
}
print "\n";

say "solved after $cnt challenges!";
dump_board(\@board);

sub solve {
  my $board = shift;
	my $seed = shift;

  my @src = shuffle @$seed;
	@$board = map { $_ ? $_ : shift @src } @$board;
}

sub verify {
  my $board = shift;
	my $ans = [1..9];

	# 横1列づつ
	for my $i ( 0 .. 8 ) {
		my $is = get_intersection($ans, [@$board[($i*9)..($i*9+8)]]);
    return 0 if ( $is != 9 );
  }
  
	# 縦1列づつ
  for my $x ( 0 .. 8 ) {
    my $is = get_intersection($ans, [@$board[map {$_*9+$x}0..8]]);
    return 0 if ( $is != 9 );
  }

	# ブロック
  for my $xb ( 0 .. 2 ) {
    for my $yb ( 0 .. 2 ) {
			my $offset = ($yb * 27 + $xb * 3);
      my $is = get_intersection($ans, [@$board[map { $_ + $offset } qw/0 1 2 9 10 11 18 19 20/]]);
      return 0 if ( $is != 9 );
    }
  }

  1;
}

sub dump_board {
  my $b = shift;
  print "===BOARD===\n";
  for my $y ( 0 .. 8 ) {
    for my $x ( 0 .. 8 ) {
      print $b->[$x+$y*9], " ";
    }
    print "\n";
  }
}

# vim:se et nu ts=2 sts=2 sw=2: