http://qs321.pair.com?node_id=516224
Category: Fun Stuff
Author/Contact Info Arturo Escudero Z. <darkturo@gmail.com>
Description: This program generates a random Sudoku table, and prints it out to the screen so you can copy it to the paper and try to solve it. It has different levels of difficulty, and is, in general terms, a funny program (or should i call it 'a funny hack'?).
Maybe future versions (if any) will have sudoku generator, sudoku solver, and a nice sudoky curses game? hahaha ... I invite perlmonks users to play with it and, of course, to modify it ;)
Happy Sudoking!
turo

PS: The difficulty implementation is no so well balanced :'( ... some times it generates a multiple solutions sudokus ... this is really annoying!
#!/usr/bin/perl 
# sudoku
#       A text-based sudoku game generator written in perl.
# Copyright (C) 2005  Arturo Escudero
# 
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
use List::Util qw(shuffle reduce sum);
use threads;
use Thread::Queue;
use POSIX;
use Time::HiRes qw( usleep gettimeofday tv_interval );

###
my $MAX_RETRIES = 50;
my $queue = new Thread::Queue;
my $level = 0; #there are three levels: novice(0),medium(1),expert(2)
my $seed  = 0;
my $print_solution = 0;
my $no_print_sdk = 0;
my $verbose = 0;
$| = 1;

### Main Program
parseArgs($#ARGV + 1, @ARGV);

$seed = time if ( not $seed ); #simple seed
srand($seed);

my $t1 = [gettimeofday()];
my @sudoku = generateSudokuTable();
printSudokuSol(@sudoku) if ( $print_solution or $no_print_sdk );
if ( not $no_print_sdk ) {
        print "\n" if ( $print_solution );
        printSudoku(@sudoku)
}
print "\nElapsed time: ", tv_interval($t1), " secs\n";
print "Turo 2005\n";

### Subroutines!
sub whichCell9x9 {
        return ((9 * $_[0]) + $_[1]);
}

sub generateSudokuTable {
        my @sdk = (0)x81;
        my ($number, $retries);

        my $thr = threads->create("progressDots","");
        $SIG{ALRM} = sub {} ;
        for (my $i = 0; $i < 9; $i++ ) {
                for (my $j = 0; $j < 9; $j++ ) {
                        $number = chooseNumber($i,$j,@sdk);
                        if ( $number ) {
                                $sdk[whichCell9x9($i,$j)] = $number;
                        } else {
                                $j = 0;
                                $retries ++;
                                if ( $retries > $MAX_RETRIES ) {
                                        $j=9; $i = -1; $retries = 0;
                                        @sdk = (); @sdk = (0)x81;
                                }
                        }
                }
        }
        $queue->enqueue("token");
        kill SIGALRM, getpid();
        $thr->join();
        return @sdk;
}

sub chooseNumber {
        my ( $i, $j, @sdk ) = @_;
        my ($element, %yetChoosed);


        $element = int(rand(9) + 1);
        $yetChoosed{$element} = $element;
        while ( not ( checkRow($i, $j, $element, @sdk)
                and   checkColumn($i, $j, $element, @sdk)
                and   checkSubSquare($i, $j, $element, @sdk ) ) )  {
                $element = int(rand(9) + 1);
                while ( exists $yetChoosed{$element} ) {
                        $element = ($element % 9) + 1; #next?
                        return undef if ( 45 == sum keys %yetChoosed )
                }
                $yetChoosed{$element} = $element;
        }
        return $element;
}

sub checkRow {
        my ($i, $j, $element, @sdk) = @_;

        for ( my $k = 0; $k < $j; $k++ ) {
                return 0 if ( $sdk[whichCell9x9($i, $k)] == $element )
+;
        }
        return 1;
}

sub checkColumn {
        my ($i, $j, $element, @sdk) = @_;

        for ( my $k = 0; $k < $i; $k++ ) {
                return 0 if ( $sdk[whichCell9x9($k, $j)] == $element )
+;
        }
        return 1;
}

sub checkSubSquare {
        my ($i, $j, $element, @sdk) = @_;
        my ($sum, $pivot_element, $num_elements);

        # We decide in which square we are
        my $row_i = (($i < 3)? 0 : (($i >= 3  and $i < 6)? 1 : 2)) * 3
+;
        my $column_j = (($j < 3)? 0 : (($j >= 3  and $j < 6)? 1 : 2)) 
+* 3;


        $sum = $pivot_element = $num_elements = 0;
        my @list = (0)x9;
        for ( my $k = $row_i; $k < ($row_i + 3); $k++ ) {
                for ( my $l = $column_j; $l < ($column_j + 3); $l++ ) 
+{
                        $pivot_element = ( $i == $k and $j == $l )?
                                                $element :
                                                $sdk[whichCell9x9($k,$
+l)];
                        if ( $pivot_element != 0 ) {
                                $list[$pivot_element] +=
                                        (($list[$pivot_element])? 45: 
+1);
                                $num_elements++;
                        }
                }
        }

        $sum = sum @list;
        return ($sum == $num_elements);
}

sub printSudokuSol {
        my @sdk = @_;
        for (my $i = 0; $i < 9; $i++ ) {
                for (my $j = 0; $j < 9; $j++ ) {
                        printf "%3d%s", $sdk[whichCell9x9($i,$j)],
                                        (( $j == 2 or $j == 5 )? "  |"
+ : "");
                }
                printf "\n%s", (($i == 2 or $i == 5)? "-"x35 . "\n" : 
+"");
        }
}

sub printSudoku {
        my @sdk = @_;
        my ($n, $levelElements);
        local $counter;
        my $sum_row, @sum_cols, @frequencies;

        @q = (0)x9;
        $counter = $levelElements = howMany4Level($level);
        for (my $i = 0; $i < 9; $i++ ) {
                $sum_row = 0;
                for (my $j = 0; $j < 9; $j++ ) {
                        $n = $sdk[whichCell9x9($i,$j)];
                        if ( mayIPrint( $i,
                                        $j,
                                        $levelElements,
                                        \@q,
                                        $frequencies[$n] + 1) ) {
                                if ( $verbose ) {
                                        $sum_row += $n;
                                        $sum_cols[$j] += $n;
                                }
                                $frequencies[$n] ++;
                                printf "%3d%s", $n,
                                        (($j == 2 or $j == 5 )? "  |" 
+: "");
                        } else {
                                printf "   %s",
                                        (($j == 2 or $j == 5 )? "  |" 
+: "");
                        }
                }
                print "  = $sum_row" if ( $verbose );
                printf "\n%s", (($i == 2 or $i == 5)? "-"x35 . "\n" : 
+"");
        }
        if ( $verbose ) {
                for (my $i = 0; $i < 9; $i++ ) {
                        printf " ||%s", (($i == 2 or $i == 5 )? "   " 
+: "");
                }
                print "\n";
                for (my $i = 0; $i < 9; $i++ ) {
                        printf "%3d%s",
                                $sum_cols[$i],
                                (($i == 2 or $i == 5 )? "   " : "");
                }
                print "\n\nFrequencies:\n";
                for (my $i = 1; $i <= 9; $i++ ) {
                        print "\t\tnum($i) = ", $frequencies[$i], "\n"
+;
                }
        }
}

sub howMany4Level {
        if ( $_[0] == 0 ) {
                #novice
                return (45 + int(rand(10)));
        } elsif ( $_[0] == 1 ) {
                #medium
                return (36 + int(rand(7)));
        } elsif ( $_[0] == 2 ) {
                #advanced
                return (27 + int(rand(4)));
        }
}

sub mayIPrint {
        # this is a little tricky; i've defined $counter as a global v
+ar.
        my ($i, $j, $levelElements, $quadList, $freq) = @_;

        my $quad = (($i < 3)? 0 : (($i >= 3  and $i < 6)? 3 : 6)) +
                   (($j < 3)? 0 : (($j >= 3  and $j < 6)? 1 : 2));

        if ($counter > 0) {
                if ( $quadList->[$quad] <= (int($levelElements/9)) ) {
                        if ( int(rand(100)+1) > 50 ) {
                                if ( $freq <= int(rand(2) + 3)) {
                                        $counter--;
                                        $quadList->[$quad] ++;
                                        return 1;
                                }
                        }
                }
        }
        return 0;
}

sub progressDots {
        print "Generating (seed: $seed) ";
        while ( not ($queue->dequeue_nb())) {
                print ".";
                usleep (50000);
        }
        print " [Done]\n\nSudoku!\n"
}

sub parseArgs {
        my ($argc, @argv) = @_;
        my $need_help = 0;

#       usage () if ( $argc == 0 );

        for (my $i = 0; $i < $argc; $i++) {
                if ( @argv[$i] eq '-level' ) {
                        my $lvl = @argv[++$i];
                        for ( $lvl ) {
                                if (/novice/) {
                                        $level = 0;
                                } elsif (/normal/) {
                                        $level = 1;
                                } elsif (/master/) {
                                        $level = 2;
                                } else {
                                        print "Bad level: '$lvl'!\n";
                                        usage();
                                }
                        }
                } elsif ( @argv[$i] eq '-seed' ) {
                        $seed = @argv[++$i];
                } elsif ( @argv[$i] =~ /^-solution$|^-s$/ ) {
                        $print_solution = 1;
                } elsif ( @argv[$i] =~ /^-solution-only$|^-so$/ ) {
                        $no_print_sdk = 1;
                } elsif ( @argv[$i] =~ /^-verbose$|^-v$/ ) {
                        $verbose = 1;
                } elsif ( @argv[$i] =~ /^--help$|^-help$|^-h$/ ) {
                        $need_help = 1;
                } else {
                        print "Bad parameter: '", @argv[$i], "'\n";
                        $need_help = 1;
                }
        }
        usage() if ( $need_help );
}

sub usage {
        print <<EOF ;
usage: sudoku [-level (novice|normal|master)] [-seed seed_num] [-solut
+ion]
        -level lvl
                Specifies the game level (default is novice).
        -seed sn
                To generate the sudoku's tables, we must take random n
+umbers.
                By controlling this seed you can regenerate the same s
+udoku 
                table, and demand its solution.
        -s
        -solution
                Prints out the solution of a speficied sudoku (you mus
+t use 
                the seed). If you don't use the seed param, then the p
+rogram
                will generate a new sudoku and it will print its solut
+ion. 
        
        -so
        -solution-only
                Like the above, but it only prints the solution.
        -v
        -verbose
                Verbose output.
        --help
                Prints this helpfully screen :-P

turo 2005
EOF
        exit 0;
}