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

[download]

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++;
    }
}

[download]

Replies are listed 'Best First'.
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]

        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;

        [download]
[reply]
[d/l]

Back to Cool Uses for Perl