# Each row must contain the digits 1 through 9 in any order. # Each column must contain the digits 1 through 9 in any order. # The 9x9 grid holds nine 3x3 grids. Each of those 3x3 grids must # contain the digits 1 through 9 in any order. use strict; use warnings; use Data::Dumper; use POSIX qw( ceil ); use List::Compare; # $solution[$row][$col], 0 = unknown # a dummy row and col will be added to @solution to allow indeces 1..9 my @solution = ( [ qw( 8 5 0 1 0 2 7 0 3 ) ], [ qw( 3 0 0 0 4 0 0 0 0 ) ], [ qw( 0 0 4 7 3 0 0 0 0 ) ], [ qw( 4 0 0 0 0 0 8 5 0 ) ], [ qw( 0 2 0 0 0 0 0 1 0 ) ], [ qw( 0 1 5 0 0 0 0 0 4 ) ], [ qw( 0 0 0 0 1 7 4 0 5 ) ], [ qw( 0 0 0 0 2 0 0 0 1 ) ], [ qw( 7 0 0 9 0 5 0 2 6 ) ] ); unshift( @solution, [] ); foreach my $row ( 1..9 ) { unshift( @{ $solution[$row] }, 0 ); } # the 3x3 grids are arranged into a 9x9 cell table as follows # 1 2 3 # 4 5 6 # 7 8 9 # the 9x9 cell table has rows 1..9 and cols 1..9 # translate row and col indeces (concatenated) of the upper left cell in each 3x3 grid into an index my %gridnum = ( 11 => 1, 12 => 2, 13 => 3, 21 => 4, 22 => 5, 23 => 6, 31 => 7, 32 => 8, 33 => 9 ); # $grid[1..9] = [ options left for this 3x3 grid ] my @grids; initialize_grids(); # $rows[1..9] = [ options left for this row ] # $cols[1..9] = [ options left for this col ] my @rows; my @cols; initialize_rows(); initialize_cols(); my $unsolved = ( 9 * 9 ) - num_hints(); while( $unsolved ) { foreach my $row ( 1..9 ) { foreach my $col ( 1..9 ) { next if $solution[$row][$col]; # find intersection of @row and @col for this cell, and intersection with @grid = options left for this 3x3 grid # if only 1 left, assign to @solution and subtract from @row and @col and @grid, $unsolved-- my $gridkey = join( '', POSIX::ceil( $row/3 ), POSIX::ceil( $col/3 ) ); my $gridnum = $gridnum{$gridkey}; my $lc_obj = List::Compare->new( $rows[$row], $cols[$col], $grids[$gridnum] ); my @options = $lc_obj->get_intersection(); if( scalar @options == 1 ) { $solution[$row][$col] = $options[0]; foreach my $a_ref ( $rows[$row], $cols[$col], $grids[$gridnum] ) { @{ $a_ref } = grep{ $_ != $options[0] } @{ $a_ref }; } $unsolved--; } } } } foreach my $row ( 1..9 ) { print join( ' ', @{ $solution[$row] }[1..9] ), "\n"; } sub initialize_grids { # determine what numbers are available as options for each 3x3 grid # initialize each 3x3 grid foreach my $gridnum ( 1..9 ) { @{ $grids[$gridnum] } = ( 1..9 ); } # filter out hints already in @solution foreach my $row ( 1..9 ) { foreach my $col ( 1..9 ) { my $gridkey = join( '', POSIX::ceil( $row/3 ), POSIX::ceil( $col/3 ) ); my $gridnum = $gridnum{$gridkey}; @{ $grids[$gridnum] } = grep{ $_ != $solution[$row][$col] } @{ $grids[$gridnum] }; } } } sub initialize_rows { # determine what numbers are available as options for each row foreach my $row ( 1..9 ) { @{ $rows[$row] } = ( 1..9 ); foreach my $col ( 1..9 ) { @{ $rows[$row] } = grep{ $_ != $solution[$row][$col] } @{ $rows[$row] }; } } } sub initialize_cols { # determine what numbers are available as options for each col foreach my $col ( 1..9 ) { @{ $cols[$col] } = ( 1..9 ); foreach my $row ( 1..9 ) { @{ $cols[$col] } = grep{ $_ != $solution[$row][$col] } @{ $cols[$col] }; } } } sub num_hints { my $hints = 0; foreach my $row( 1..9 ) { $hints += scalar grep{ $_ != 0 } @{ $solution[$row] }; } return $hints; }