Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Battleship solitaire puzzle generator

by toolic (Bishop)
on Aug 29, 2016 at 19:11 UTC ( [id://1170733]=CUFP: print w/replies, xml ) Need Help??

What

This is a battleship solitaire puzzle generator. It creates a puzzle grid with a random number of clues. It also can display the corresponding puzzle solution. The solution has 10 ships on a 10x10 grid.

Why

Mostly because I felt like it. Also because I could not find anything that already existed online to easily do exactly what I wanted. There are some puzzle generators available which have GUI's with nice features, but they limit you to one puzzle per week (or month, or whatever), and it is difficult to annotate hard puzzles on the screen. This generator allows you to play as many puzzles as you want and to print them on paper to make annotations.

How

Run the generator and redirect the output to a file. You can edit the file and fill in the ships directly in your editor. Or, you can print the file onto a piece of paper. Alternately, you could redirect the CSV output to a file, then use the conversion script to create an Excel file. Then you can complete the puzzle in Excel or print the Excel file onto paper.

Status

Consider this alpha code. Since I did not create any tests to automatically check the code, there are likely bugs. The approach is probably naive, and the ASCII representation is ugly. Any suggestions for improvements are welcome.

Code for generator

use warnings FATAL => 'all'; use strict; use Getopt::Long qw(GetOptions); use Pod::Usage qw(pod2usage); use List::Util qw(shuffle); my $seed; my %opt; parse_args(); # Supplying a constant value as an argument to srand will produce the + same # random sequence for each invocation of this script. # Supplying no argument to srand will produce a different random sequ +ence # for each invocation of this script. srand $seed; # 10 ships # Half of the ships with length > 1 will be vertical (random). # If length=1, assign as vertical, but it doesn't really matter. my @lens = qw(4 3 3 2 2 2 1 1 1 1); my @verts = (shuffle( (0,1) x 3 ), (1) x 4); my @ships; for (0 .. 9) { push @ships, { len => $lens[$_], vert => $verts[$_], shapes => get_shapes($lens[$_], $verts[$_]), }; } # Create solution grid my @aoa; my @ccnts; # column counts my @rcnts; # row counts my $id = "seed=$seed hard=$opt{hard} ships: @lens"; # Initialize grid for my $r (0 .. 9) { for my $c (0 .. 9) { $aoa[$r][$c] = '.'; } } # Place ships and surround them with water for my $ship (@ships) { my $done = 0; while (not $done) { $done = place_ship($ship); } } add_remaining_water(); get_counts(); if ($opt{sol}) { print "\nSOLUTION: $id\n\n"; print_grid(); } # Create puzzle grid # This modifies the solution grid remove_water(); remove_ship_segments(); if ($opt{puzz}) { print "\nPUZZLE: $id\n\n"; print_grid(); } print_csv() if $opt{csv}; exit; sub place_ship { my $ship = shift; my $cs = randint(0, 9); # Start column my $rs = randint(0, 9); # Start row my $len = $ship->{len}; my $vert = $ship->{vert}; my $start = ($vert) ? $rs : $cs; my $incr = (($start + $len - 1) > 9) ? -1 : 1; # Check if this ship fits here my $ok = 1; for my $i (0 .. ($len-1)) { my $r = $rs + (($vert) ? $i*$incr : 0); my $c = $cs + (($vert) ? 0 : $i*$incr); if ($aoa[$r][$c] ne '.') { # not empty square $ok = 0; last; } } if ($ok) { # Ship does fit for my $i (0 .. ($len-1)) { my $r = $rs + (($vert) ? $i*$incr : 0); my $c = $cs + (($vert) ? 0 : $i*$incr); $aoa[$r][$c] = flip_shape($ship->{shapes}->[$i], $incr); } add_water(); #print $len, ' ', (($vert) ? 'vert ' : 'horiz'), " rs=$rs cs=$ +cs\n"; } return $ok; } sub add_water { # Add water around ships for my $r (0 .. 9) { for my $c (0 .. 9) { if ($aoa[$r][$c] =~ /[o#<>v^]/) { # Ship $aoa[$r+1][$c+1] = '~' if $r < 9 and $c < 9; $aoa[$r+1][$c-1] = '~' if $r < 9 and $c > 0; $aoa[$r-1][$c+1] = '~' if $r > 0 and $c < 9; $aoa[$r-1][$c-1] = '~' if $r > 0 and $c > 0; $aoa[$r-1][$c+0] = '~' if $r > 0 and $aoa[$r][$c] =~ / +[o<>^]/; $aoa[$r+1][$c+0] = '~' if $r < 9 and $aoa[$r][$c] =~ / +[o<>v]/; $aoa[$r+0][$c-1] = '~' if $c > 0 and $aoa[$r][$c] =~ / +[o<v^]/; $aoa[$r+0][$c+1] = '~' if $c < 9 and $aoa[$r][$c] =~ / +[o>v^]/; } } } } sub add_remaining_water { # Add water after all ships have been placed for my $r (0 .. 9) { for my $c (0 .. 9) { $aoa[$r][$c] =~ s/[.]/~/; } } } sub remove_water { # Remove water for puzzle display for my $r (0 .. 9) { for my $c (0 .. 9) { $aoa[$r][$c] =~ s/~/./; } } } sub remove_ship_segments { # Remove some random ship segments for my $r (0 .. 9) { for my $c (0 .. 9) { $aoa[$r][$c] =~ s/[.]/ /; $aoa[$r][$c] =~ s/./ / if randint(0, (1 + $opt{hard})); } } } sub get_counts { # Determine row and column counts from completed solution grid @ccnts = (0) x 10; @rcnts = (0) x 10; for my $r (0 .. 9) { my $cnt = 0; # row count for my $c (0 .. 9) { if ($aoa[$r][$c] ne '~') { $cnt++; $ccnts[$c]++; } } $rcnts[$r] = $cnt; } } sub print_csv { # Print grid in CSV format print "$id\n"; for my $r (0 .. 9) { my @cells; for my $c (0 .. 9) { push @cells, $aoa[$r][$c]; } push @cells, $rcnts[$r]; print join(',', @cells), "\n"; } print join(',', @ccnts, ' '), "\n"; } sub print_grid { # Print grid my $hline = '-' x 21 . "\n"; print $hline; for my $r (0 .. 9) { print '|'; for my $c (0 .. 9) { print $aoa[$r][$c], '|'; } #print " $rcnts[$r] r$r\n"; # row indicies only for debug print " $rcnts[$r]\n"; print $hline; } print " @ccnts\n\n"; return; # comment this line to show more for debug # Show column indicies (only for debug): print 'c ' for 0 .. 9; print "\n"; print "$_ " for 0 .. 9; print "\n\n"; } sub flip_shape { # Invert an end shape, if necessary my $char = shift; my $incr = shift; $char =~ tr/^v<>/v^></ if $incr == -1; return $char; } sub get_shapes { my $len = shift; my $vert = shift; my $e1 = ($vert) ? '^' : '<'; # End shape: top or left my $e2 = ($vert) ? 'v' : '>'; # End shape: bottom or right if ($len == 1) { return ['o'] } elsif ($len == 2) { return [$e1, $e2] } elsif ($len == 3) { return [$e1, '#', $e2] } elsif ($len == 4) { return [$e1, '#', '#', $e2] } } sub randint { # Return a random integer value between $min and $max, inclusive. # For example, randint(1,5) returns an integer between 1 and 5, # including the values 1 and 5. my ($min, $max) = @_; return int(rand($max - $min + 1)) + int($min); } sub parse_args { %opt = (hard => 0); GetOptions(\%opt, qw(help csv hard=i puzz sol seed=i)) or pod2usag +e(); $opt{help} and pod2usage(-verbose => 2); $seed = exists $opt{seed} ? $opt{seed} : randint(0, 100_000); $opt{hard} = 0 if $opt{hard} < 0; @ARGV and pod2usage("Error: unexpected args: @ARGV"); } =head1 NAME battle - Battleship solitaire puzzle generator =head1 SYNOPSIS battle [options] Options: -help Verbose help -puzz Print out puzzle -csv Print out puzzle in CSV format -sol Print out solution -hard int Difficulty level [default = 0] -seed int Seed to reproduce a puzzle =head1 DESCRIPTION Generate a random battleship solitaire puzzle. Both the solution grid and the corresponding puzzle grid can be displayed. The puzzle and the solution can be printed to STDOUT. The grid is 10x10, and the solution has 10 ships of the following size +s. 1 ship of length 4 grid squares : < # # > 2 ships of length 3 grid squares : < # > 3 ships of length 2 grid squares : < > 4 ships of length 1 grid square : o The above shows how the ships look horizontally. However, ships may a +lso be oriented vertically. Character legend: o is used for a ship of length 1 # is used for the middle of a ship of length 3 or 4 < is used for the left end of a horizontal ship of length 2-4 > is used for the right end of a horizontal ship of length 2-4 ^ is used for the top end of a vertical ship of length 2-4 v is used for the bottom end of a vertical ship of length 2-4 ~ is used for water (solution only) There is no guarantee that the puzzle has a unique solution. =head1 OPTIONS All options can be abbreviated. =over 4 =item B<-puzz> By default, no output is produced. To generate and display a puzzle, use the C<-puzz> option. battle -puzz =item B<-csv> To display a puzzle in CSV format, use the C<-csv> option. battle -csv =item B<-sol> Use the C<-sol> option to display the solution. battle -sol =item B<-hard> By default, easy puzzles are generated. To increase the difficulty, use the C<-hard> option. The default value is 0. In general, the lar +ger the value, the harder the puzzle. battle -hard 5 =item B<-seed> To reproduce a specific puzzle, use the C<-seed> option. It may also +be necessary to specify the C<-hard> option. battle -seed 1234 =item B<-help> Show verbose usage information. =back =head1 EXAMPLES Generate a puzzle using the seed C<1234> and a difficulty level of C<3 +>, displaying both the solution and the puzzle. battle -sol -puzz -seed 1234 -hard 3 =head1 SEE ALSO Refer to the following website for a description of the puzzle rules: https://en.wikipedia.org/wiki/Battleship_(puzzle) =cut

Code for Excel conversion

=head1 NAME B<conv2xls> - Convert battleship CSV files to Excel =head1 SYNOPSIS conv2xls file ... =head1 DESCRIPTION Input is a CSV battleship puzzle file (or several files). Three files fit onto one printed page. Output is an Excel file F<puz.xlsx>. Example: conv2xls p1 p2 p3 =cut use warnings FATAL => 'all'; use strict; use Excel::Writer::XLSX qw(); use File::Slurp qw(slurp); my $workbook = Excel::Writer::XLSX->new('puz.xlsx'); my $worksheet = $workbook->add_worksheet(); $worksheet->set_column(0, 10, 3); my $row = 0; for my $file (@ARGV) { my @lines; for (slurp($file)) { chomp; push @lines, [split /,/]; } push @lines, [' ']; my $row_rel = 0; for my $line (@lines) { my @cols = @{ $line }; my $col = 0; for my $data (@cols) { my $format = $workbook->add_format(); unless ($row_rel == 0 and $col == $#cols) { $format->set_align('center'); } if ($row_rel > 0 and $row_rel < $#lines-1 and $col < $#col +s) { $format->set_border(1); $format->set_bold(); } $worksheet->write($row, $col, $data, $format); $col++; } $row++; $row_rel++; } }

Replies are listed 'Best First'.
Re: Battleship solitaire puzzle generator
by Anonymous Monk on Aug 30, 2016 at 01:36 UTC

      The rules of the game, as they were taught to me, disallowed immediately adjacent ships.

      Another problem with placement is that you transpose unconditionally in the loop. E.g. the puzzle will always have size-three ships at right angles.

        Thanks. In my haste to get regexing I didn't read the rules very closely.

        Easily fixed, though:

        #!/usr/bin/perl # http://perlmonks.org/?node_id=1170733 use strict; use warnings; my $sea = ((' ' x 10) . "\n") x 10; sub transpose { local $_ = $sea; tr/<>^v/^v<>/; $sea = ''; $sea .= "\n" while s/^(.)/ $sea .= $1; '' /gem; } for my $ship ( 4,3,3,2,2,2,1,1,1,1 ) { my @places; push @places, $-[0] while $sea =~ /(?= {$ship})/g; substr $sea, $places[rand @places], $ship, ('O', '<>', '<#>', '<##>' )[$ship - 1]; for (0, 9, 11, 0, 9, 11) { $sea =~ s/(?<=[<>^v#O].{$_}) | (?=.{$_}[<>^v#O])/~/gs; transpose; } rand > 0.5 and transpose; } tr/ /~/ for $sea; print $sea; my @chars = $sea =~ /./g; use Tk; # for http://perlmonks.org/?node_id=1170638 my $mw = MainWindow->new( -title => "Battleship" ); for my $y (0..9) { for my $x (0..9) { my ($char, $b) = shift @chars; $b = $mw->Button( -font => 'courier 24', -text => ' ', -command => sub {$b->configure(-text => $char) }, )->grid(-row => $y, -column => $x); } } MainLoop;

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: CUFP [id://1170733]
Approved by stevieb
Front-paged by beech
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (3)
As of 2024-04-25 14:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found