[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[原创代码] [Perl]生成随机数独矩阵

本帖最后由 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秒

有空再想下其他思路~

  1. 1 2 3 4 5 6 7 8 9
  2. 4 5 6 7 8 9 1 2 3
  3. 7 8 9 1 2 3 4 5 6
  4. 2 3 1 5 6 4 8 9 7
  5. 5 6 4 8 9 7 2 3 1
  6. 8 9 7 2 3 1 5 6 4
  7. 3 1 2 6 4 5 9 7 8
  8. 6 4 5 9 7 8 3 1 2
  9. 9 7 8 3 1 2 6 4 5
  10. 再做置换
复制代码

TOP

本帖最后由 523066680 于 2017-9-5 21:16 编辑

回复 2# avgBullsCows

知道,在做不同的尝试。
    http://www.bathome.net/thread-5358-1-1.html

以前的置换方案感觉有些局限,比如还是能看出原来分段放置的规律。但如果是更详细的置换,写法又未必比递归选取简单。

TOP

返回列表