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++;
}
}
Re: Battleship solitaire puzzle generator
by Anonymous Monk on Aug 30, 2016 at 01:36 UTC
|
| [reply] |
|
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.
| [reply] |
|
#!/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;
| [reply] [d/l] |
|
|
|
|
|
|
|