Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

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

by choroba (Canon)
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: (4)
As of 2015-07-08 02:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (93 votes), past polls