数独

午夜凋零

前阵子看新闻看到一个人号称创出来最难的数独，当时就产生了个想法，将数独中已经提供的数字作为输入，得出所有的元素。
整了两三天的时间，终于用perl实现了，感觉自己好弱啊。{:2_169:}
另一方面，虽然感觉自己很弱，但是完成一项想法的感觉还是挺爽的。
下面是代码，欢迎各位批评指正，希望不会被拍的太厉害。。。。

1. #!/usr/bin/perl
   
2. use warnings;
   
3. use strict;
   
4. 
   
5. my @goal = (
   
6.              [[8], [ ], [ ], [ ], [ ], [ ], [ ], [ ], [ ]],
   
7.              [[ ], [ ], [3], [6], [ ], [ ], [ ], [ ], [ ]],
   
8.              [[ ], [7], [ ], [ ], [9], [ ], [2], [ ], [ ]],
   
9.              [[ ], [5], [ ], [ ], [ ], [7], [ ], [ ], [ ]],
   
10.              [[ ], [ ], [ ], [ ], [4], [5], [7], [ ], [ ]],
    
11.              [[ ], [ ], [ ], [1], [ ], [ ], [ ], [3], [ ]],
    
12.              [[ ], [ ], [1], [ ], [ ], [ ], [ ], [6], [8]],
    
13.              [[ ], [ ], [8], [5], [ ], [ ], [ ], [1], [ ]],
    
14.              [[ ], [9], [ ], [ ], [ ], [ ], [4], [ ], [ ]]
    
15.            );
    
16. 
    
17. for my $i ( 0..8 ) { # fill empty element with 1..9
    
18.     for my $j ( 0..8 ) {
    
19.         $goal[$i]->[$j] = [qw(1 2 3 4 5 6 7 8 9)] if @{$goal[$i]->[$j]} == 0;
    
20.     }
    
21. }
    
22. for my $i ( 0..8 ) { # delete the impossible numbers from 1..9
    
23.     for my $j ( 0..8 ) {
    
24.         &delete_element(\@goal, $i, $j);
    
25.     }
    
26. }
    
27. 
    
28. &print_shudu(\@goal);
    
29. &process(\@goal, 0, 0);
    
30. 
    
31. sub delete_element {
    
32.     my ( $ref, $row, $col ) = @_;
    
33.     if ( @{$ref->[$row][$col]} == 1 ) {
    
34.         for my $i ( 0..8 ) {
    
35.             return 0 if &remove( $ref, $row, $col, $row, $i ) == 0;
    
36.             return 0 if &remove( $ref, $row, $col, $i, $col ) == 0;
    
37.         }
    
38.         my $row_b = $row - $row % 3;
    
39.         my $col_b = $col - $col % 3;
    
40.         for my $i ( $row_b, $row_b+1, $row_b+2 ) {
    
41.             for my $j ( $col_b, $col_b+1, $col_b+2 ) {
    
42.                 return 0 if &remove( $ref, $row, $col, $i, $j ) == 0;
    
43.             }
    
44.         }
    
45.     }
    
46.     return 1;
    
47. }
    
48. sub remove {
    
49.     my ( $ref, $row, $col, $i, $j ) = @_;
    
50.     return 1 if ( $row == $i and $col == $j );
    
51.     my @a = @{$ref->[$i][$j]};
    
52.     $ref->[$i][$j] = [];
    
53.     foreach ( @a ) {
    
54.         push @{$ref->[$i][$j]}, $_ if $_ != $ref->[$row][$col][0];
    
55.     }
    
56.     if ( @{$ref->[$i][$j]} == 0 ) {
    
57.         return 0; # error
    
58.     }
    
59.     else {
    
60.         return 1; # success
    
61.     }
    
62. }
    
63. sub process {
    
64.     my ( $ref, $row, $col ) = @_;
    
65.     my ( $new_row, $new_col );
    
66.     if ( $col < 8 ) {
    
67.         $new_col = $col + 1;
    
68.         $new_row = $row;
    
69.     }
    
70.     else {
    
71.         if ( $row < 8 ) {
    
72.             $new_col = 0;
    
73.             $new_row = $row + 1;
    
74.         }
    
75.         else {
    
76.             &print_shudu($ref);
    
77.             exit;
    
78.         }
    
79.     }
    
80.     print "$row, $col, $new_row, $new_col\n"; # debug
    
81.     if ( @{$ref->[$row][$col]} == 1 ) {
    
82.         return if &delete_element($ref, $row, $col) == 0;
    
83.         &process($ref, $new_row, $new_col);
    
84.     }
    
85.     else {
    
86.         foreach ( @{$ref->[$row][$col]} ) {
    
87.             my $new = &cp_shudu($ref);
    
88.             $new->[$row][$col] = [$_];
    
89.             next if &delete_element($new, $row, $col) == 0;
    
90.             &process($new, $new_row, $new_col);
    
91.         }
    
92.     }
    
93. }
    
94. sub print_shudu {
    
95.     my $ref = shift;
    
96.     for my $i ( 0..8 ) {
    
97.         for my $j ( 0..8 ) {
    
98.             print $ref->[$i][$j][$_] for 0..$#{$ref->[$i][$j]};
    
99.             print "\t";
    
100.         }
     
101.         print "\n";
     
102.     }
     
103. }
     
104. 
     
105. sub cp_shudu {
     
106.     my $ref = shift;
     
107.     my $new;
     
108.     for my $i ( 0..8 ) {
     
109.         for my $j ( 0..8 ) {
     
110.             $new->[$i][$j] = [@{$ref->[$i][$j]}];
     
111.         }
     
112.     }
     
113.     return $new;
     
114. }

复制代码

cdtits

1. for (@goal) { # fill empty element with 1..9
   
2.     for my $j ( 0..8 ) {
   
3.         $_->[$j] = [qw(1 2 3 4 5 6 7 8 9)] if @{$_->[$j]} == 0;
   
4.     }
   
5. }

复制代码

午夜凋零

cdtits 发表于 2012-07-22 00:38

有理。我怎么没想到啊，思维有点固化了。。。
谢谢~~

rubyish

先收藏，再慢慢研究，谢谢了。
还要慢慢看~

jzp520520

太强大了，看的头痛！{:2_179:}

pitonas

太强大了, 小伙伴们, 这个高端奢华上档次。
{:2_168:}