|
  
- 帖子
- 3151
- 积分
- 6455
- 技术
- 317
- 捐助
- 70
- 注册时间
- 2008-8-3
|
本帖最后由 523066680 于 2017-9-5 18:46 编辑
=info
523066680 2017-09
首行9个数字随机顺序
剩下行逐行调用递归函数生成
=cut
use IO::Handle;
STDOUT->autoflush(1);
my $main = 0;
my $bad = 0;
AGAIN:
our %hash;
grep { $hash{$_} = 1 } (1..9);
@nums = (1..9);
our $mat =
[
#首行，9个数字随机顺序
[map { splice @nums, int(rand($#nums+1)), 1 } (1..9)],
[],[],[],[],[],[],[],[]
];
my $nextline;
for my $line ( 1 .. 8 )
{
$nextline = undef;
func( $line, 0, \$nextline );
if ( not defined $nextline )
{
$bad++;
print "not ok\n";
}
$mat->[$line] = [ split("", $nextline) ];
}
for my $idx ( 0..$#$mat )
{
printf "%s\n", join(",", @{$mat->[$idx]} );
}
print "\n";
goto AGAIN if ($main++ < 1000);
printf "bad: %d\n", $bad;
sub func
{
our @all;
our $mat;
our %hash;
my ( $curr, $lv, $ref ) = @_;
if ($lv > 8)
{
#如果当前行是第五行或者第八行，预判下一行是否无解
if ( $curr == 4 or $curr == 7)
{
if ( try_next_line( $curr ) == 0 )
{
return 0;
}
else
{
$$ref = join("", @{$mat->[$curr]});
return 1;
}
}
else
{
$$ref = join("", @{$mat->[$curr]});
return 1;
}
}
my @out;
my %dupl;
if ( $curr % 3 == 1 ) # 1 2 4 5 7 8
{
if ( $lv < 3 ) { @out = @{$mat->[$curr-1]}[0..2]; }
elsif ( $lv < 6 ) { @out = @{$mat->[$curr-1]}[3..5]; }
else { @out = @{$mat->[$curr-1]}[6..8]; }
}
elsif ( $curr % 3 == 2 )
{
if ( $lv < 3 ) { @out = (@{$mat->[$curr-1]}[0..2], @{$mat->[$curr-2]}[0..2]) }
elsif ( $lv < 6 ) { @out = (@{$mat->[$curr-1]}[3..5], @{$mat->[$curr-2]}[3..5]) }
else { @out = (@{$mat->[$curr-1]}[6..8], @{$mat->[$curr-2]}[6..8]) }
}
if ($curr >= 3)
{
push @out, map { $mat->[$_][$lv] } ( 0 .. 3*int($curr/3) - 1 );
}
push @out, @{$mat->[$curr]}[ 0 .. $lv-1 ];
%dupl = %hash;
grep { delete $dupl{$_} } @out;
my $res = 0;
for my $e ( keys %dupl )
{
$mat->[$curr][$lv] = $e;
$res = func($curr, $lv+1, $ref);
last if ($res == 1);
}
return $res;
}
sub try_next_line
{
my ($row) = shift;
my $nextline = undef;
func( $row+1, 0, \$nextline );
if ( not defined $nextline )
{
return 0;
}
else
{
return 1;
}
} |
[Finished in 0.1s]
遇到过的问题：
像这样的前面5行，都是符合要求的，但是第六行的前三个数字无解。因为剩下395可选，c无论如何都会和第三列其他元素冲突。
1,2,3,4,5,6,7,8,9
4,8,9,2,3,7,6,1,5
6,7,5,1,9,8,3,4,2
8,1,2,5,7,9,4,3,6
7,6,4,3,1,2,9,5,8
a,b,c
所以对第五行和第八行做了针对性处理，测试能否生成完整的下一行。
随机性质：
首行是随机的，后面8行的生成其实有一定规律，但是因为Perl的hash键本来就是随机的，所以我也没有特地做随机处理。
效率：
在我的电脑上产生1000个数独需要0.9秒
有空再想下其他思路~ |
|
发表于 2017-9-5 18:38
| 
发表于 2017-9-5 19:30
|