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 sequence # 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] =~ /[ov^]/; } } } } 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^>'; # 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 pod2usage(); $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 sizes. 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 also 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 larger 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