In Search of a Smarter Sub

[Petras]

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

[moritz]

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

[KurtSchwind]

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.

[cdarke]

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);

[dragonchild]

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"; } );