Beefy Boxes and Bandwidth Generously Provided by pair Networks Ovid
Problems? Is your data what you think it is?
 
PerlMonks  

In Search of a Smarter Sub

by Petras (Friar)
on Dec 11, 2007 at 10:04 UTC ( #656361=perlquestion: print w/ replies, xml ) Need Help??
Petras has asked for the wisdom of the Perl Monks concerning the following question:

Recently I saw a thread about when to use a subroutine. It had some useful ideas, but now I want to ask How to Make a SMARTER Subroutine?

In a fit of boredome-turned-educational I wrote this small Tk game:
#!perl use warnings; use strict; use Tk; require Tk::ROText; my $MW=MainWindow->new; $MW->title("Jump!"); $MW->geometry("775x240+10+10"); my $game_frame=$MW->Frame->pack; $MW->fontCreate('readable', -family => 'arial', -size => 13); my $instruct=$game_frame->ROText( -wrap => "word", -height => 4, -font => "readable", -relief => "flat", -takefocus => 0 )->grid (-row => 0, -columnspan=>1 +3); $instruct->insert('end', "You've five red and five blue chips. One spa +ce is blank. Red chips can only move to the right, blue chips to the +left. Any chip can move into the blank space. A red chip can jump ove +r a single blue chip into the blank space. A blue chip can jump over +a single red chip into the blank space. Your goal is to get all the r +eds on the right, and all the blues on the left."); my @button; for (1..11) { $button[$_]=$game_frame->Button( -text => "X", -width => 8, -height =>4, -relief => "solid", -activeforeground => "black", -borderwidth => 3, -command => [ \&move, $_ ] )-> grid(-row => 1, -column => $_); } $game_frame->Button( -text => "Start Over", -command => [ \&setup ], -font => "readable" ) -> grid(-row =>2, -columnspan => 13, + -pady => 2); my $msg; my $message=$game_frame->Label (-textvariable => \$msg, -font => "read +able", -foreground => "red") -> grid(-row=>3, -columnspan => 13); setup(); MainLoop; sub setup { $msg=""; for (1..5) { make_color("red", $_); } for (7..11) { make_color("blue", $_); } make_blank(6); } sub make_color { my ($c, $index) = @_; $button[$index]->configure ( -activebackground => $c, -foreground => $c, -background => $c, -state => "normal"); } sub make_blank { $_=shift; $button[$_]->configure ( -background => "white", -foreground => "black", -activebackground => "white", -state => "disabled", -disabledforeground => "black"); } sub move { $msg=""; $_=shift; my $old_color = $button[$_]->cget(-background); if ($old_color eq "red") { if ($_ == 11) { alert(1); } elsif ($button[$_+1]->cget(-background) eq "red") { alert(2); } elsif ($_ <= 9 && $button[$_+1]->cget(-background) eq "blue" && +$button[$_+2]->cget(-background) ne "white") { alert(3); } elsif ($button[$_+1]->cget(-background) eq "white") { make_color ("red", $_+1); make_blank ($_); check_win(); } else { make_color ("red", $_+2); make_blank ($_); check_win(); } } if ($old_color eq "blue") { if ($_ == 1) { alert(1); } elsif ($button[$_-1]->cget(-background) eq "blue") { alert(2); } elsif ($_ >= 2 && $button[$_-1]->cget(-background) eq "red" && $ +button[$_-2]->cget(-background) ne "white") { alert(3); } elsif ($button[$_-1]->cget(-background) eq "white") { make_color ("blue", $_-1); make_blank ($_); check_win(); } else { make_color ("blue", $_-2); make_blank ($_); check_win(); } } } sub alert { $_=shift; if ($_ == 1) { $msg = "You can't move any further than the end!"; } elsif ($_ == 2) { $msg = "You can't jump over the same color chip!"; } elsif ($_ == 3) { $msg = "You can only jump over the opposite colored chip if the ne +xt space is blank!"; } else { $msg = "You won!"; for (1..11) { $button[$_]->configure(-state => "disabled"); } for (1..5) { $button[$_]->configure(-disabledforeground => "blue"); } $button[6]->configure(-disabledforeground => "white"); for (7..11) { $button[$_]->configure(-disabledforeground => "red"); } } } sub check_win { for (1..5) { if ( $button[$_]->cget(-background) ne "blue" ) { return; } } for (7..11) { if ( $button[$_]->cget(-background) ne "red" ) { return; } } alert(4); }
These two if statements look a lot alike:
if ($old_color eq "red") { if ($_ == 11) { alert(1); } elsif ($button[$_+1]->cget(-background) eq "red") { alert(2); } elsif ($_ <= 9 && $button[$_+1]->cget(-background) eq "blue" && +$button[$_+2]->cget(-background) ne "white") { alert(3); } elsif ($button[$_+1]->cget(-background) eq "white") { make_color ("red", $_+1); make_blank ($_); check_win(); } else { make_color ("red", $_+2); make_blank ($_); check_win(); } } if ($old_color eq "blue") { if ($_ == 1) { alert(1); } elsif ($button[$_-1]->cget(-background) eq "blue") { alert(2); } elsif ($_ >= 2 && $button[$_-1]->cget(-background) eq "red" && $ +button[$_-2]->cget(-background) ne "white") { alert(3); } elsif ($button[$_-1]->cget(-background) eq "white") { make_color ("blue", $_-1); make_blank ($_); check_win(); } else { make_color ("blue", $_-2); make_blank ($_); check_win(); } }

and I wish I knew a way to include some toggles to make one sub work for either color, but I'm at a loss how to do that.

When writing a Minesweeper clone I hit something similar:
for $j (1..$row_count) { for $k (1..$col_count) { #DO SOMETHING, LIKE PLACE RANDOM MINES, #FIGURE OUT WHAT NUMBER GOES HERE, CLEAR #ADJACENT EMPTY SPACES, WHATEVER } }
What I wound up doing was repeating the double-for loop several times in the code. I'd like to be able to do something like:
sub double_for { /&CODE_REFERENCE = $ARG[0]; for $i (1..$row_count) { for $j (1..$col_count) { &CODE_REFERENCE($i, $j); } } }
But it's beyond me. It's been said "The Map is Posted on Every Corner" but it's a pretty big map. Any pointers on where to go or where to look?

Thanks and Cheers!
-P

That is what the textbook says, but it's wrong.

-DC

Comment on In Search of a Smarter Sub
Select or Download Code
Re: In Search of a Smarter Sub
by moritz (Cardinal) on Dec 11, 2007 at 10:53 UTC
    at first glance the two if-statement blocks differ only in the constants "red" and "blue".

    You can factor them out in a common sub:

    sub good_sub_name_here { my ($color, $other_color) = @_; if ($old_color eq $color) { if ($_ == 1) { alert(1); } elsif ($button[$_-1]->cget(-background) eq $color) { alert(2); } elsif ($_ >= 2 && $button[$_-1]->cget(-background) eq $other_col +or && $button[$_-2]->c +get(-background) ne "white") { alert(3); } elsif ($button[$_-1]->cget(-background) eq "white") { make_color ($color, $_-1); make_blank ($_); check_win(); } else { make_color ($color, $_-2); make_blank ($_); check_win(); } } } # and call it: good_sub_name_here(qw(blue red)) good_sub_name_here(qw(red blue))
    If you declare the sub in the place where the if blocks are now, you shouldn't have any scoping issues
Re: In Search of a Smarter Sub
by cdarke (Prior) on Dec 11, 2007 at 13:00 UTC
    Are you sure that's what the textbook says? Anyway, the following works:
    sub double_for { $CODE_REFERENCE = $_[0]; for $i (1..$row_count) { for $j (1..$col_count) { &$CODE_REFERENCE($i, $j); } } } double_for(\&mysub);
Re: In Search of a Smarter Sub
by KurtSchwind (Hermit) on Dec 11, 2007 at 13:10 UTC

    The first idea is to do what moritz suggested, but I see a small issue with that. Actually, it isn't so small.

    While it appears to be that the only differences are that the colours in change, there are other pieces that are different. Here is a diff I ran just to see what was going on.

    kschwind@yzerman:~/src/local/j.random> diff red.pl blue.pl 1,2c1,2 < if ($old_color eq "red") { < if ($_ == 11) { --- > if ($old_color eq "blue") { > if ($_ == 1) { 4c4 < } elsif ($button[$_+1]->cget(-background) eq "red") { --- > } elsif ($button[$_-1]->cget(-background) eq "blue") { 6c6 < } elsif ($_ <= 9 && $button[$_+1]->cget(-background) eq "blue" & +& $button[$_+2]->cget(-background) ne "white") { --- > } elsif ($_ >= 2 && $button[$_-1]->cget(-background) eq "red" && + $button[$_-2]->cget(-background) ne "white") { 8,9c8,9 < } elsif ($button[$_+1]->cget(-background) eq "white") { < make_color ("red", $_+1); --- > } elsif ($button[$_-1]->cget(-background) eq "white") { > make_color ("blue", $_-1); 13c13 < make_color ("red", $_+2); --- > make_color ("blue", $_-2);

    So now it looks like we have some other differences. Mostly indexing from the looks of it. If you wanted to write some maintainable code, you may want to name these index variants into a hash of some type.

    my smartish_sub { my ($colour) = @_; # Here is the hash with some constants based on the colour. You can +put this hash anywhere really. my %colour_indexes = ( red => ( equal_cond => 11, button_ind => 1, make_colour_ind1 => 1, make_colour_ind2 => 2, ), blue => ( equal_cond => 1, button_ind => -1, make_colour_ind1 => -1, make_colour_ind2 => -2, ) ); # rest of code is written to use the hash references keyed on the colo +ur, much like moritz described ...

    The only other bit of mankery is that you have a  <= 9 for red and  >= 2 for blue. You may want to break that test out into another, smaller sub based on colour that will return true if that condition is met. It'll clean up the 'smart' sub and inlining it might get a bit messy.

    --
    I used to drive a Heisenbergmobile, but every time I looked at the speedometer, I got lost.
Re: In Search of a Smarter Sub
by dragonchild (Archbishop) on Dec 11, 2007 at 21:05 UTC
    You don't want a smarter sub so much as the ability to pass behaviors into a sub. This is known as a subref or coderef and is the basis for functional programming.

    The idea is that you have a set of structures, just like your nested if-statements. You want to have a set of behaviors in that nested-if and you don't want to have to hard-code it all over the place.

    sub nested_ifs { my ($i_max, $j_max, @behaviors) = @_; foreach my $i ( 1 .. $i_max ) { foreach my $j ( 1 .. $j_max ) { foreach my $behavior ( @behaviors ) { $behavior->( $i, $j ); } # Or, more succinctly: # $_->( $i, $j ) for @behaviors; } } } sub func1 { ... } sub func2 { ... } nested_ifs( 10, 20, \&func1, \&func2, sub { my ($i,$j) = @_; print "I: + $i\n\tJ: $j\n"; } );

    My criteria for good software:
    1. Does it work?
    2. Can someone else come in, make a change, and be reasonably certain no bugs were introduced?

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (11)
As of 2014-04-17 19:46 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    April first is:







    Results (454 votes), past polls