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

Re^3: Challenge: Algorithm To Generate Bubble Blast 2 Puzzles With Difficulty

by choroba (Abbot)
on Sep 02, 2013 at 11:25 UTC ( #1051925=note: print w/ replies, xml ) Need Help??


in reply to Re^2: Challenge: Algorithm To Generate Bubble Blast 2 Puzzles With Difficulty
in thread Challenge: Algorithm To Generate Bubble Blast 2 Puzzles With Difficulty

I am not able to run the game (perhaps I need an account or an Android device?)

However, I wrote my own implementation. You can feed it a starting setup from a file, too. I am still not sure about situations like

v >1< ^

but it is fun, anyway. I am still not sure how to generate "tough" initial setups, though.

#!/usr/bin/perl use warnings; use strict; my $pause = 1; play(6, 5, shift); { package Local::Grid; use constant { EMPTY => ' ', DEBUG => 0 }; sub _to_grid { 2 * shift() - 4; } sub new { my $class = shift; my ($width, $height) = @_; my $self; for my $x (0 .. 3 + _to_grid($width)) { for my $y (0 .. 3 + _to_grid($height)) { $self->[$x][$y] = EMPTY; } } bless $self, $class; } sub width { int(@{ shift() } / 2 + 1); } sub height { int(@{ shift->[0] } / 2 + 1); } sub show { my $self = shift; print '----' x $self->width, "\n"; for my $y (0 .. _to_grid($self->height)) { if ($y % 2) { print ' |'; } else { printf '% 3d |', $y / 2; } for my $x (0 .. _to_grid($self->width)) { print 1 == length $self->[$x][$y] ? $self->[$x][$y] : +'X', ' '; } print "\n"; } print '----' x $self->width, "\n"; print ' '; printf '% 3d ', $_ for 0 .. $self->width - 2; print "\n"; } sub ready { my $self = shift; my $ready = 1; $ready = 0 if grep /[<>v^]/, map @$_, @$self; return $ready; } sub empty { my $self = shift; my $empty = 1; $empty = 0 if grep /[1-4]/, map @$_, @$self; return $empty; } sub add { my ($self, $x, $y, $char) = @_; return $self->[$x][$y] = $char if EMPTY eq $self->[$x][$y]; $self->[$x][$y] .= $char; } # Retruns true if there was an explosion. sub explode { my ($self, $x, $y) = @_; return if $x >= $self->width - 1 or $y >= $self->height - 1; $_ = 2 * $_ for $x, $y; return if $self->[$x][$y] !~ /[1234]/; return 1 if --$self->[$x][$y]; $self->add($x - 1, $y, '<') if $x > 0; $self->add($x + 1, $y, '>') if $x < _to_grid($self->width); $self->add($x, $y - 1, '^') if $y > 0; $self->add($x, $y + 1, 'v') if $y < _to_grid($self->height); return 1; } # The file should contain width and height on the first line. The # rest is just the table of numbers, but you can also include # shrapnels. sub new_from_file { my ($class, $file) = @_; open my $IN, '<', $file or die $!; my ($width, $height) = split ' ', <$IN>; my $self = $class->new($width, $height); $. = 0; while (<$IN>) { chomp; for my $x (0 .. length($_) - 1) { $self->[4 + _to_grid($x)][_to_grid($. + 1)] = substr $ +_, $x, 1; } } return $self; } sub fill { my $self = shift; $self->[2 * int(rand $self->width) - 2][2 * int(rand $self->he +ight) - 2] = 1 + int rand 4 for 1 .. 5* $self->width * $self->height; } sub copy { my $self = shift; my $new = ref($self)->new($self->width - 1, $self->height - 1) +; for my $x (0 .. _to_grid($self->width)) { for my $y (0 .. _to_grid($self->height)) { $new->[$x][$y] = $self->[$x][$y] =~ /[0<>^v]/ ? EMPTY +: $self->[$x][$y]; } } return $new; } sub step { my $self = shift; my $next = $self->copy; select undef, undef, undef, $pause; for my $x (0 .. _to_grid($self->width)) { for my $y (0 .. _to_grid($self->height)) { my $current = $self->[$x][$y]; if ($current =~ /[<>^v]/) { warn "[$x:$y] '$current'" if DEBUG; for my $shrapnel (split //, $current) { my ($i, $j) = ( $x + ({'<' => -1, '>' => 1}->{ +$shrapnel} // 0), $y + ({'^' => -1, 'v' => 1}->{ +$shrapnel} // 0)); if ($next->[$i][$j] !~ /[1-4]/) { if ($i >= 0 and $j >= 0 and $i <= _to_grid($self->width) and $j <= _to_grid($self->height)) { warn "->[$i:$j]" if DEBUG; $next->add($i, $j, $shrapnel); } } else { $next->explode($i / 2, $j / 2); } } } } } @$self = @$next; } } sub help { print STDERR << '__HELP__'; Enter coordinates as two numbers and press enter. Entering an empty line hits the same position again. Entering F makes the game faster, S makes it slower. Use Ctrl+D to end the game. __HELP__ } sub play { my ($width, $height, $file) = @_; my $grid; if (defined $file and -e $file) { $grid = 'Local::Grid'->new_from_file($file); } else { $grid = 'Local::Grid'->new($width, $height); $grid->fill; } help(); my $turn = 1; my $previous_command; while (1) { $grid->show; until ($grid->ready) { $grid->step; $grid->show; } last if $grid->empty; print 'Turn: ', $turn, '. Enter the position: '; my $command = <>; exit unless defined $command; $command = $previous_command if defined $previous_command and +$command eq "\n"; if (my ($x, $y) = $command =~ /^([0-9]+).*?([0-9]+)$/) { $turn += $grid->explode($x, $y) // 0; } elsif ($command =~ /^h/i) { help(); } elsif ($command =~ /^s/i) { $pause += .2 if $pause < 1; } elsif ($command =~ /^f/i) { $pause /= 2; } else { print "Invalid position.\n"; } $previous_command = $command; } $turn--; print "Completed in $turn turns.\n"; }

A screencast.

لսႽ ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ


Comment on Re^3: Challenge: Algorithm To Generate Bubble Blast 2 Puzzles With Difficulty
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://1051925]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others taking refuge in the Monastery: (11)
As of 2014-12-18 21:58 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (66 votes), past polls