Ir para o conteúdo

Sudoku

Exemplo de um pequeno script que resolve sudokus.

#!/usr/bin/perl
#author: pedrotuga

$puzzleraw = ".14.6.3..62...4..9.8..5.6...6.2....3.7..1..5.5....9.6...6.2..3.1..5...92..7.9.41.";

$puzzleraw=~ s/\./0/g;

do "functions.pl";

@puzzle = put_into_array($puzzleraw);


solve(@puzzle);

#===============================================================================

sub solve{

    my @puzzleC = @_;   

    if (!have_empty_cells(@puzzleC)){
        print "Hurray! Puzzle solved!\n";
        print_puzzle_array(@puzzleC);
        die("yeeepee!\n");
        }

    my $empty_cell_position = find_first_empty_cell(@puzzleC);
    $puzzleC[0] = $empty_cell_position;

    my @cell_possibilities = get_possibilities(@puzzleC);
    if (!@cell_possibilities){ return -1; } 
    for my $possible_value (@cell_possibilities){
        $puzzleC[$empty_cell_position] = $possible_value;
        solve(@puzzleC);
    }

}


#===============================================================================
#   uniquify an array
#===============================================================================
sub uniquify{
    my %return_these_keys;
    for (@_){
        $return_these_keys{$_}=1;
    }
    return keys %return_these_keys;
}

#===============================================================================
#   Put the puzzle in a friendly array
#===============================================================================
sub put_into_array{

    my @puzzlearrayraw = split(//, $_[0]);

    my $i=11;
    foreach(@puzzlearrayraw){
        if($i%10 == 0){$i++;}
        $puzzleboarded[$i]=$_;
        $i++;
    }
    return @puzzleboarded;

}

#===============================================================================
#   Print the friendly array puzzle in a human readable format
#===============================================================================
sub print_puzzle_array{

    print "\n+-----------+\n";
    for my $i (1..9){

        print "|";
        for my $j (1..9){   
            print $_[$i*10+$j];
            print "|" if !($j%3);
        }
        print "\n";
        if (!($i%3) && $i<9){print "|---+---+---|\n";}
    }
    print "+-----------+\n";

}

#===============================================================================
#   Check if a puzzle has empty cells
#===============================================================================
sub have_empty_cells{

    foreach (@_){
        #print "->".$_."\n";
        if(defined($_) && $_==0){ return true; }
    }
    return 0;
}


#===============================================================================
#   find the first empty cell
#===============================================================================
sub find_first_empty_cell{

    for my $i (11..99){
        if ($i%10!=0 && $_[$i]==0){
            return $i;
        }
    }
    return 0; #puzzle without empty cells
}

#===============================================================================
#   get all other subsquare 'neighbours'
#===============================================================================
sub get_neighbours{
    my $cell_position = $_[0];
    my $cell_column = $cell_position % 10;
    my $cell_row = ($cell_position - $cell_column)/10;


    $subsquare_neighbourhood[1]=[11,12,13,21,22,23,31,32,33];
    $subsquare_neighbourhood[2]=[14,15,16,24,25,26,34,35,36];   
    $subsquare_neighbourhood[3]=[17,18,19,27,28,29,37,38,39];
    $subsquare_neighbourhood[4]=[41,42,43,51,52,53,61,62,63];
    $subsquare_neighbourhood[5]=[44,45,46,54,55,56,64,65,66];
    $subsquare_neighbourhood[6]=[47,48,49,57,58,59,67,68,69];
    $subsquare_neighbourhood[7]=[71,72,73,81,82,83,91,92,93];
    $subsquare_neighbourhood[8]=[74,75,76,84,85,86,94,95,96];
    $subsquare_neighbourhood[9]=[77,78,79,87,88,89,97,98,99];

    OUTER:
    for my $ii (1..9) {
        for my $jj (0..8){
            if ($cell_position == $subsquare_neighbourhood[$ii][$jj]){
                $subsquare = $ii;
                break OUTER;
            }
        }
    }

    $reff = $subsquare_neighbourhood[$subsquare];
    @all = @$reff;

    #columns and row neighbours
    for my $i (1..9) {      
        push @all, (10*$cell_row + $i , 10*$i + $cell_column);
    }


    #remove own cell
    @neighbours = grep {$_ != $cell_position} @all;

    @neighbours = uniquify(@neighbours);
    return @neighbours;
}


#===============================================================================
#   get possibilities for a given cell
#===============================================================================
sub get_possibilities{
    my @puzzle = @_;
    my $cell_position = $_[0];
    my @used_values;

    my @neighbours = get_neighbours($cell_position);

    for (@neighbours) {
        if ($puzzle[$_] != 0){$used_values[$puzzle[$_]]=1;} 
    }

    my @possibilities = grep {!$used_values[$_]} (1..9);
    return @possibilities;
}