in reply to Making Sudoku Puzzles Using PDF::API2

FYI, now that the latest Perl Review has been released I've had a chance to play around with the Sudoku generator. I added some spice to allow one to create multiple Sudoku puzzles in a PDF document. Attached are a few scripts:

A slightly modified sudoku_generator.pl file
A modestly modified sudoku_maker.pl file, renamed to sudoku2pdf.pl for de-obfuscation purposes
A sample shell script, create_sudoku_puzzles.sc that accepts two command line arguments: number of puzzles to create and PDF filename; it will then loop through and create x number of puzzles in the given PDF file

Here they are:

sudoku_generator.pl

#!/usr/bin/perl ############################################################ ## INIT ## ############################################################ use strict; use warnings; use List::Util qw{ shuffle }; # constants our $COLCNT = 4 * 9**2; # number of columns in cover our $ROWCNT = 9**3; # number of rows in cover # bitvecs for full and empty rows and cols our $ZEROCOL = pack( 'b*', "0" x $COLCNT ); our $ZEROROW = pack( 'b*', "0" x $ROWCNT ); our $FULLCOL = pack( 'b*', "1" x $COLCNT ); our $FULLROW = pack( 'b*', "1" x $ROWCNT ); ############################################################ ## MAIN ## ############################################################ # use STDERR because STDOUT is used to pass the puzzle text # to sudoku2pdf.pl print STDERR "Generating Sudoku puzzle...\n"; # create the cover puzzle, and an initial path stash my $puzzle = make_puzzle(); my $pstash = make_path_stash( $puzzle ); # find a completed Sudoku puzzle my @solutions = solve_cover( $puzzle, $pstash, 1 ); my $solset = pop @solutions; #print "\nComplete puzzle:\n"; #pprint_puzzle( @$solset ); # find -a- minimal puzzle with that set my @sol = find_minimal( @$solset ); #print "\nMinimal puzzle:\n"; pprint_puzzle( @sol ); # for fun, re-solve the puzzle #print "\nRe-solved:\n"; #my $nstash = make_path_stash( $puzzle, @sol ); #my @re_solved = solve_cover( $puzzle, $nstash, 1 ); #pprint_puzzle( @{ $re_solved[0] } ); ############################################################ ## FUNCTIONS ## ############################################################ ############################################################ # solve_cover() - given an initial path stash, solve puzzle sub solve_cover { my ( $puzref, $iloc, $tofind ) = @_; $tofind ||= 1; # initialize as much as possible here, # to avoid allocing during tightloop my @stack = ( $iloc ); # 'recurse' agenda my @liverows = (); # don't allocated any arrays in my @pivrows = (); # loop - expensive. my @solutions = (); # solutions found my $curpaths = 0; # counter for paths (stats only) my @puz = @$puzref; RECURSE: while ( 1 ) { # basecase 1: my $rloc = pop @stack or last RECURSE; if ( $rloc->{livecol} eq $ZEROCOL ) { my @setlist = grep { vec $rloc->{solset}, $_, 1 } 0.. ( $ROWCN +T - 1 ); push @solutions, \@setlist; # basecase 2 - we satisfy our solution agenda last RECURSE if ( scalar( @solutions ) >= $tofind ); next RECURSE; } # enumerate active rows my $cand = ( ~ $rloc->{removed} ); @liverows = (); vec( $cand, $_, 1 ) && push( @liverows, $_ ) for 0 .. ( $ROWCNT - 1 ); # basecase 3: my $colcheck = $ZEROCOL; $colcheck |= $puz[$_] for @liverows; next RECURSE unless $colcheck eq $rloc->{livecol}; # select a pivot column my $pivcol; my $pivmask; COLPICK: for my $col ( 0 .. $COLCNT - 1 ) { next COLPICK unless vec( $rloc->{livecol}, $col, 1 ); $pivcol = $col; $pivmask = $ZEROCOL; vec( $pivmask, $pivcol, 1 ) = 1; my $cnt = 0; (( $pivmask & $puz[$_] ) ne $ZEROCOL ) and $cnt++ for @liverows; # shortcurcuit select if any singletons found last COLPICK if $cnt == 1; } # enumerate pivot rows: @pivrows = (); for ( @liverows ) { push @pivrows, $_ if (( $pivmask & $puz[$_] ) ne $ZEROCOL ); } # DESCEND - each pivot row is a path to descend into for my $prow ( shuffle @pivrows ) { my %crloc = %$rloc; # prune out covered rows for my $r ( @liverows ) { vec( $crloc{removed}, $r, 1 ) = 1 if ( $puz[$r] & $puz[$prow] ) ne $ZEROCOL; } # mask out consumed columns $crloc{livecol} &= ~ $puz[$prow]; # add row to solutionset vec( $crloc{solset}, $prow, 1 ) = 1; $curpaths++; push @stack, \%crloc; } } return @solutions; } ############################################################ sub find_minimal { my ( @solset ) = @_; # This is cheap and dirty, but at least it's cheap and dirty. my @sol; do { @sol = shuffle @solset; pop @sol for 0..30; } until ( is_unambiguous( @sol ) ); TRIM: while ( 1 ) { for ( 0..$#sol ) { my $front = shift @sol; next TRIM if is_unambiguous( @sol ); push @sol, $front; } last TRIM; # none can be removed } return @sol; } ############################################################ sub is_unambiguous { my @set = @_; my $puzzle = make_puzzle(); my $pstash = make_path_stash( $puzzle, @set ); my @solutions = solve_cover( $puzzle, $pstash, 2 ); return ( scalar( @solutions ) == 1 ); } ############################################################ sub make_path_stash { my( $puz, @set ) = @_; my $mask = $ZEROCOL; my $solset = $ZEROROW; my $remset = $ZEROROW; if ( @set ) { $mask |= $puz->[$_] for @set; for my $row ( 0.. ( $ROWCNT - 1 ) ) { vec( $remset, $row, 1 ) = 1 if ( ( $puz->[$row] & $mask ) ne $ZEROCOL ); } vec( $solset, $_, 1 ) = 1 for @set; } return { livecol => ( ~ $mask ) & $FULLCOL, removed => $remset, solset => $solset, colptr => 0, }; } ############################################################ # return puzzle array sub make_puzzle { my @puz; for my $sqr ( 0..80 ) { for my $val ( 1..9 ) { push @puz, map_to_covervec( $val, $sqr ); } } return \@puz; } ############################################################ # given a square and a value, return bitvec sub map_to_covervec { my ( $num, $sqr ) = @_; my $bitmap = $ZEROCOL; # blank row my $seg = 9**2; # constraint segment offset my $row = int( $sqr / 9 ); # row my $col = $sqr % 9; # col my $blk = int( $col / 3 ) + # block int( $row / 3 ) * 3; # map to contraint offsets my @offsets = ( $sqr, $seg + $row * 9 + $num - 1, $seg * 2 + $col * 9 + $num - 1, $seg * 3 + $blk * 9 + $num - 1, ); # poke out offsets vec( $bitmap, $_, 1 ) = 1 for @offsets; return $bitmap; } ############################################################ # pretty print puzzle sub pprint_puzzle { my @set = @_; # map values on to squares: my @puzzle; $puzzle[int($_ / 9)] = 1 + $_ % 9 for @set; for ( 1..81 ) { print( ( $puzzle[$_-1] ) ? "$puzzle[$_-1] " : "- " ); print " " unless $_ % 3; print "\n" unless $_ % 9; print "\n" unless $_ % (9*3); } } __END__ Complete puzzle: 8 2 3 5 6 4 9 1 7 1 5 9 8 2 7 6 4 3 6 4 7 3 9 1 8 5 2 7 6 1 2 8 5 4 3 9 3 8 5 4 7 9 1 2 6 4 9 2 6 1 3 7 8 5 2 1 8 7 5 6 3 9 4 9 3 6 1 4 2 5 7 8 5 7 4 9 3 8 2 6 1 Minimal puzzle: 8 - 3 - - 4 - - 7 1 5 - - 2 7 - 4 - - 4 - 3 - - - - 2 - - - - 8 - 4 - - 3 - 5 - - - - - 6 - - - - 1 - - - - - - - 7 - 6 - - - - - 6 - - 2 5 - - - - - - - - 2 - - Re-solved: 8 2 3 5 6 4 9 1 7 1 5 9 8 2 7 6 4 3 6 4 7 3 9 1 8 5 2 7 6 1 2 8 5 4 3 9 3 8 5 4 7 9 1 2 6 4 9 2 6 1 3 7 8 5 2 1 8 7 5 6 3 9 4 9 3 6 1 4 2 5 7 8 5 7 4 9 3 8 2 6 1

sudoku2pdf.pl

#!/usr/bin/perl =head1 NAME sudoku2pdf.pl - create Sudoku puzzles with PDF::API2 =head1 SYNOPSIS % <sudoku text> | perl sudoku2pdf.pl sudoku.pdf - - 6 8 - 4 - - - - - - - 9 - 7 - 8 - - - 5 - - - 9 - 1 - - - 4 - - - 9 - - - - - - 5 - - 4 6 - - - 1 - 3 - 8 7 - - - - 4 - - - - - - 5 - 2 - - - - - - - 2 - 1 - =head1 DESCRIPTION This is a proof-of-concept script. Eric Maki created a Sudoku puzzle generator, but he output the text you see in the SYNOPSIS. I wanted to turn that into a nice puzzle so I started tinkering with PDF::API2. Eric's source will be part of the Spring 2006 issue of The Perl Review +. If you want to change the input, change C<get_puzzle> to parse it correctly. UPDATE: Some additions by Michael S. Collins to make the PDF stuff mor +e usable: Added cmd line arg: input/output PDF file name Changed program output to write directly to PDF file instead of ST +DOUT Added PDF-specific information: 'Author' = 'sudoku2pdf.pl' 'Keywords' = 'puzzlecount=##' (where ## = number of puzzles in + PDF doc) (To view this information in Adobe Reader, click File > Document P +roperties) Added quick & dirty validation routine: If supplied PDF file does not exist it is created ('.pdf' appended if necessary) If supplied PDF file does exist, checks for 'Author' to be equ +al to 'sudoku2pdf.pl'; dies if not This prevents the script from putting sudoku puzzles on 'norma +l' PDFs! Looks for 'puzzlecount=##' in 'Keywords'; if not found, start +at 0 Added logic to put allow six puzzles per page After six puzzles, a new page is added and newest puzzle placed Repeated calls to sudoku2pdf.pl with the same PDF file will result + in many puzzles appended =head1 TO DO =over 4 =item * most things can be configurable, but I hardcoded them =item * i'd like to generate several puzzles per page (see MC UPDATE a +bove) =item * the C<place_digit> routine is a bit of guess work for font cen +tering. =back =head1 AUTHOR brian d foy, C<< <bdfoy@cpan.org> > =head1 COPYRIGHT and LICENSE Copyright 2006, brian d foy, All rights reserved. This software is available under the same terms as perl. =cut use strict; use warnings; use PDF::API2; use constant PAGE_WIDTH => 595; use constant PAGE_HEIGHT => 842; use constant MARGIN => 25; use constant GUTTER => 32; use constant WIDE_LINE_WIDTH => 3; use constant LINE_WIDTH => 2; use constant THIN_LINE_WIDTH => 1; use constant X_COORD => 0; use constant Y_COORD => 1; use constant SQUARE_SIDE => 243; # changed from brian's 270 use constant FONT_SIZE => int( 0.70 * SQUARE_SIDE / 9 ); use constant MAX_PUZZLES => 6; # max number puzzles per page # Now we cheat a bit: there are only 6 possible starting x,y positions # array of anonymous arrays - # $xy_pos[1] = [x1,y1], $xy_pos[2] = [x2,y2], etc. # NOTE: puzzle 6 = $xy_pos[0] = [x0,y0] because we use modulus # Then when we call make_grid and place_digit we use these as our x,y # GUTTER = horizontal space between puzzles my @xy_pos = ( [ ( PAGE_WIDTH + GUTTER) / 2, PAGE_HEIGHT - SQUARE_SIDE * 3 - GUTTER * 2 - MARGIN ], # x,y pu +zzle 6 [ ( PAGE_WIDTH - (SQUARE_SIDE * 2 + GUTTER) ) / 2, PAGE_HEIGHT - SQUARE_SIDE - MARGIN ], # x,y pu +zzle 1 [ ( PAGE_WIDTH + GUTTER) / 2, PAGE_HEIGHT - SQUARE_SIDE - MARGIN ], # x,y pu +zzle 2 [ ( PAGE_WIDTH - (SQUARE_SIDE * 2 + GUTTER) ) / 2, PAGE_HEIGHT - SQUARE_SIDE * 2 - GUTTER - MARGIN ], # x,y pu +zzle 3 [ ( PAGE_WIDTH + GUTTER) / 2, PAGE_HEIGHT - SQUARE_SIDE * 2 - GUTTER - MARGIN ], # x,y pu +zzle 4 [ ( PAGE_WIDTH - (SQUARE_SIDE * 2 + GUTTER) ) / 2, PAGE_HEIGHT - SQUARE_SIDE * 3 - GUTTER * 2 - MARGIN ] # x,y pu +zzle 5 ); my $pdf; # pdf object my $puzzle_count; # how many puzzles in this PDF my $page_count; # how many pages in this PDF my $puzzlenum; # which puzzle on this page (1, 2, 3...) # if have cmd line arg, assume it's a file name + path # if file exists, assume it's a pdf, open it for appending puzzles # if file does not exist, create it my $infile = $ARGV[0]; print "Using $infile as pdf file...\n"; if ( -f $infile ) { $pdf = PDF::API2->open( $infile ) or die "Unable to open PDF file $infile \n"; my %pdfinfo = $pdf->info; my $keywords = $pdfinfo{'Author'}; if ( $keywords !~ m/sudoku2pdf\.pl/ ) { die "This is not a PDF created by sudoku2pdf.pl \n"; } (undef,$puzzle_count) = split "=",$pdfinfo{'Keywords'}; if ( ! $puzzle_count ) { $puzzle_count = 0; # no puzzle count, setting it to 0 } $page_count = $pdf->pages; } else { $pdf = PDF::API2->new; $pdf->info( 'Author' => 'sudoku2pdf.pl' ); $page_count = 1; $puzzle_count = 0; $pdf->mediabox( PAGE_WIDTH, PAGE_HEIGHT ); if ( substr( $infile, -4 ) ne '.pdf' ) { $infile .= '.pdf'; } } my $font = $pdf->corefont( 'Helvetica-Bold' ); run() unless caller; sub run { my $page; # it's generally easier to have a page object av +ailable $page = $pdf->openpage( $page_count ); if ( ! $page ) { $page = $pdf->page; # first page of brand new PDF doc } # check to see if we need to add a page if ( ++$puzzle_count / MAX_PUZZLES > $page_count ) { $page = $pdf->page; # adds a new page, sets $page obj to new + page } # determine which puzzle on page to use: # 1st puzzle = upper left, 2nd = upper right # 3rd puzzle = mid left, 4th = mid right # 5th puzzle = lower left, 6th = lower right $puzzlenum = $puzzle_count % MAX_PUZZLES; my $gfx = $page->gfx; $gfx->strokecolor( '#000' ); $gfx->linewidth( WIDE_LINE_WIDTH ); make_grid( $gfx, #$xpos[ $puzzlenum ], # x #$ypos[ $puzzlenum ], # y $xy_pos[$puzzlenum]->[X_COORD], # x $xy_pos[$puzzlenum]->[Y_COORD], # y ); populate_puzzle( $gfx, get_puzzle() ); $pdf->info( 'Keywords' => "puzzlecount=$puzzle_count" ); $pdf->saveas($infile); print "$infile now has $puzzle_count Sudoku puzzle"; if ( $puzzle_count > 1 ) { print "s"; } # if } print ".\n\n"; # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # +# # sub populate_puzzle { my( $gfx, $array ) = @_; foreach my $row ( 0 .. $#$array ) { my $row_array = $array->[$row]; foreach my $column ( 0 .. $#$row_array ) { next unless defined $row_array->[$column]; place_digit( $gfx, $row, $column, $row_array->[$column] ) } } } sub place_digit { my( $gfx, $row, $column, $digit ) = @_; #my $x_start = $xpos[$puzzlenum]; #my $y_start = $ypos[$puzzlenum]; my $x_start = $xy_pos[$puzzlenum]->[X_COORD]; my $y_start = $xy_pos[$puzzlenum]->[Y_COORD]; my $x_offset = 0.30 * SQUARE_SIDE / 9; # empirically derived my $y_offset = 0.25 * SQUARE_SIDE / 9; my $x = $x_start + $column * SQUARE_SIDE / 9 + $x_offset; my $y = $y_start + $row * SQUARE_SIDE / 9 + $y_offset; $gfx->textlabel( $x, $y, $font, FONT_SIZE, $digit ); } sub get_puzzle { my @array; print STDERR "Reading puzzle from Sudoku generator...\n"; while( <STDIN> ) { chomp; s/^\s|\s$//g; next unless length $_; push @array, [ map { $_ eq '-' ? undef : $_ } split ]; } print "Puzzle data read from STDIN.\n"; print "Adding puzzle to PDF file...\n"; return \@array; } sub make_grid { my( $gfx, $lower_left_x, $lower_left_y ) = @_; make_outline( $gfx, $lower_left_x, $lower_left_y ); $gfx->linewidth( THIN_LINE_WIDTH ); make_blocks( $gfx, $lower_left_x, $lower_left_y, 9 ); $gfx->linewidth( LINE_WIDTH ); make_blocks( $gfx, $lower_left_x, $lower_left_y, 3 ); } sub make_blocks { my( $gfx, $lower_left_x, $lower_left_y, $cells ) = @_; my( $xs, $ys ) = map { my $point = $_; [ map { $point + $_ * SQUARE_SIDE / $cells } 1 .. $cells - + 1 ]; } ( $lower_left_x, $lower_left_y ); foreach my $x ( @$xs ) { make_line( $gfx, $x, $lower_left_y, $x, $lower_left_y + SQUARE_SIDE, ); } foreach my $y ( @$ys ) { make_line( $gfx, $lower_left_x, $y, $lower_left_x + SQUARE_SIDE, $y, ); } } sub make_outline { my( $gfx, $lower_left_x, $lower_left_y ) = @_; my( $upper_right_x, $upper_right_y ) = map { $_ + SQUARE_SIDE } ( $lower_left_x, $lower_left_y ); my @points = ( [ $lower_left_x, $lower_left_y - WIDE_LINE_WIDTH / 2, $lower_left_x, $upper_right_y ], [ $lower_left_x, $upper_right_y - WIDE_LINE_WIDTH / 2, $upper_right_x, $upper_right_y ], [ $upper_right_x - WIDE_LINE_WIDTH / 2, $upper_right_y, $upper_right_x, $lower_left_y ], [ $upper_right_x, $lower_left_y + WIDE_LINE_WIDTH / 2, $lower_left_x, $lower_left_y ], ); foreach my $tuple ( @points ) { make_line( $gfx, @$tuple ) } } sub make_line { my( $gfx, $x, $y, $x2, $y2 ) = @_; $gfx->move( $x, $y ); $gfx->line( $x2, $y2 ); $gfx->fillstroke; } __END__ - - 6 8 - 4 - - - - - - - 9 - 7 - 8 - - - 5 - - - 9 - 1 - - - 4 - - - 9 - - - - - - 5 - - 4 6 - - - 1 - 3 - 8 7 - - - - 4 - - - - - - 5 - 2 - - - - - - - 2 - 1 -

create_sudoku_puzzles.sc

# create_sudoku_puzzles.sc # # accepts a number and a file name/path on the command line # creates x number of puzzles in PDF of filename # # simply loops x number of times and launches this combo of Perl scrip +ts: # sudoku_generator.pl | sudoku2pdf.pl $filename # # That's it! numpuzzles=$1 filename=$2 count=1 echo Creating $numpuzzles puzzle\(s\) in file echo $filename while [ $count -le $numpuzzles ]; do echo "" echo Creating puzzle $count sudoku_generator.pl | sudoku2pdf.pl $filename count=$(($count+1)) done echo Done with puzzle creation

I've tested this shell script values up to 100 and it seems to work okay. YRMV, but have fun with it!

-MC

P.S. - To brian, Eric, and the rest of you TPR guys: Thanks! I just subscribed to The Perl Review and I love it!


Comment on NEW CODE: Making Sudoku Puzzles Using PDF::API2
Select or Download Code