This is posted in response to qball's question about alternating row colors. The sub &cycle (yes, I know there is a Tie::Cycle module) takes two arguments. The first is the number of times each element gets returned prior to moving to the next element. The second argument is a reference to an array that contains the elements to cycle through. The code below prints:
red red white white blue blue red red white white

Update: Yeah, I changed the sub name while I was posting it. Oops! Also, the comments about my second sanity check (array ref) are correct in that my error message doesn't match the actual check. My thought was that the check would simultaneously catch whether or not it was an array and whether it would have more than zero elements. So much for trying to golf validation :)

use warnings; use strict; my @colors = qw/ red white blue /; my $rotate = cycle( 2, \@colors ); for ( 1..10 ) { print &$rotate . "\n"; } sub cycle { my ( $toggle, $items ) = @_; my $error = ''; if ( $toggle !~ /^\d+$/ or $toggle == 0 ) { $error = "The first argument to &alternate must be a positive +integer: $toggle\n"; } if ( ! @$items ) { $error .= "The second argument to &alternate must be an array +reference."; } die $error if $error; my $count = 0; my $index = -1; return sub { $index += 1 if $count++ % $toggle == 0; $index = 0 if $index == @$items; $items->[ $index ]; } }

Replies are listed 'Best First'.
Re: Simple Rotation
by MeowChow (Vicar) on May 19, 2001 at 00:14 UTC
    I would do it this way:
    sub cycle { my ($repeat, $items, $index) = @_; return sub { $items->[ int ($index++ / $repeat) % @$items ]; } }
       MeowChow                                   
                   s aamecha.s a..a\u$&owag.print

      The golf master strikes again!

      Nice code, but why do you skip the sanity checks? If this is just for golfing purposes, that's fine, but I would never recommend someone actually use your code. In a response to this post, He Who Must Not Be Named wrote:

      I must admit that there has been many a time that I've come up with some beautiful piece of code that does exactly what I want it to do in one line or two, and then I have to pollute it and expand it with all of the error checking conditions. Most annoying, but necessary. The approach that I take to my code is "Make things as simple as possible, but no simpler". In other words, brevity is good and worthwhile and whatnot, but as soon as you start sacrificing necessary functionality or readability, you're trying to make it too short and you need to slow down a little. Most of my code tends to be fairly readable as a result. :)

      You were just playing through, right?

      Cheers,
      Ovid

      Join the Perlmonks Setiathome Group or just click on the the link and check out our stats.

        Golf master? Sir, I believe you have me confused with someone else :)

        The main point of my reply was the reworking of the closure, and although I did intentionally skip those error checks, I was too lazy to explain why. However, since you've brought it up, let's take a closer look:

        my $error = ''; if ( $toggle !~ /^\d+$/ or $toggle == 0 ) { $error = "The first argument to &alternate must be a positive +integer: $toggle\n"; } if ( ! @$items ) { $error .= "The second argument to &alternate must be an array +reference."; } die $error if $error;
        This first test determines if $toggle is really an integer. My opinion on this is that if you want typed parameters, then go ahead and use a strongly typed language, but don't sprinkle your Perl code with ersatz type checks that work in convoluted and inefficient ways. Regexes are great for validating user input, but they're not good for patching Perl's weak typing with ad-hoc runtime error checks. If you must, write it like this:
        die "Toggle not greater than 0" unless $toggle > 0;
        Then you'll get a nice argument isn't numeric warning from Perl if you accidentally passed a string, which should be sufficient.

        Now look closely at the second error check. See anything wrong? The error message doesn't even correspond with the test. The error check ensures that $items is a non-empty array reference. In fact, if it's not an array reference, you won't even get to your error message complaining of this fact, as Perl would first die with the error Can't use string ("...") as an ARRAY ref. Perl already does that error check for you. But a user of your code might pass an empty array reference, see the error message claiming that he hadn't passed an array reference at all, and sit in bewilderment until he actually looked at your code, and saw the discrepency between message and test.

        Despite that, you probably shouldn't even bother checking if the array is empty. Sure, it's a degenerate case, but degenerate cases are good to support when you're designing abstractions. Consider also that an array of only one element is another degenerate case. Should that too emit an error?

        In your code, you've gone so far as to create a synthetic text accumulator to store multiple error messages. You'll also notice that the subroutine you named inside your error messages is different from the subroutine given. Perhaps that last criticism was below the belt, but it only serves to underscore my point that error checks aren't intrinsic goods. Error checking for the purpose of error checking is not wise. Like any other code, error checks will need to be maintained, they create the potential for new bugs, and they can adversly impact performace if poorly implemented.

        So, before I add yet another error check, I ask a few questions:

        • Is this an error that my compiler / interpreter will catch anyway?
        • Is this an error that will result in an obvious bug, which would be quickly and easily debugged?
        • Will this error check affect my code's performance?
        • Is the code becoming so riddled with error checks that it's less readable?
        Having said that, I will leave it as an excercise for the reader to verify that my code, run under strict and -w, spews warnings and errors under almost every condition that you intend for your error tests to catch.

        None of this is to say that there are occasions were it's ok to not check for errors on system calls, or other external I/O. Paranoia about your outside environment is fundamental to good programming. But paranoia about the correct use of your own code isn't, and I dare say, it's even somewhat un-Perlish.

        If I wanted bondage and discipline, I'd program in Java or Eiffel. As it is, I trust myself and my fellow coders enough not to feed a string into a subroutine that expects a number. I trust that if I did, I would locate that bug in relatively short order. And I trust that whatever bugs I do spend time fixing will be much more subtle and complex than the bugs that B&D programming and obsessive-compulsive error checking are designed to uncover.

           MeowChow                                   
                       s aamecha.s a..a\u$&owag.print

      Just don't cycle too-many million times or the spinning will stop. (:

              - tye (but my friends call me "Tye")
        Assuming you're not under use integer, you have about 9 thousand-trillion cycles before it sputters out. Probably sufficient for most uses :)

        Under use integer, all bets are off after about 4 million:

        use integer; $y = $x = 0xFFFFFFFF; $x += 1; $y++; print "x:$x y:$y\n"
        Interesting behaviour, no? I wonder how $y is stored internally...
           MeowChow                                   
                       s aamecha.s a..a\u$&owag.print
Re: Simple Rotation
by myocom (Deacon) on May 19, 2001 at 04:45 UTC

    Excellent routine (as we've all come to expect from you...:-)), but I have one minor criticism: The sanity checks, while handy (and ++ for including them!), have a confusing error message. They refer to a sub called &alternate, but you have since renamed it to &cycle.

Re: Simple Rotation
by strredwolf (Chaplain) on May 19, 2001 at 03:00 UTC
    Wouldn't this work even better?

    unshift @arr, (pop @arr);

    --
    $Stalag99{"URL"}="http://stalag99.keenspace.com";