Perl Weekly Challenge: Week 34

Challenge 1:

Write a program that demonstrates using hash slices and/or array slices.

My demo is an implementation of the binary search algorithm. This time, I'll discuss the Raku solution first.

sub MAIN() {
    my @letters = ('a' .. 'z');
    my @haystack = @letters.pick(@letters.elems / 2);
    my $needle = @letters.pick;

    say "Is $needle in ", @haystack.join, '?';
    say binarySearch(@haystack.sort, $needle) ?? 'Yes.' !! 'No.';
}

What should I search? For lack of any better idea I decided to, as the traditional idiom says, "find a needle in a haystack" or rather, a random letter of the alphabet (the needle) in a list of 13 unique random letters of the alphabet. (the haystack.) Raku makes this kind of thing easy with the .pick() method.

sub binarySearch(@haystack, $needle) {
    if @haystack.elems {
        my $mid = (@haystack.elems / 2).Int; 

        if $needle eq @haystack[$mid] { 
            return True;
        }

        if $needle gt @haystack[$mid] { 
            return binarySearch(@haystack[$mid + 1 .. *], $needle);
        } 

        return binarySearch(@haystack[0 .. $mid - 1], $needle);
    }
    return False;
}

(Full code on Github.)

In a binary search, the search space is recursively divided in two halves until the search term is found or we run out of places to look. I used array slices to make the halves.

This is the Perl version:

my @letters = ('a' .. 'z');
my @haystack = pick([@letters], scalar @letters / 2);
my $needle = pick([@letters], 1);
say "Is $needle in ", (join q{}, @haystack), '?';
say binarySearch([sort @haystack], $needle) ? 'Yes.' : 'No.';

Perl doesn't have a pick() function so I wrote one. It takes a reference to a list and the number of elements we want from that list.

sub pick {
    my @range = @{$_[0]};
    my $quantity = $_[1];

    if ($quantity < 1 || $quantity > scalar @range) {
        die "out of range\n";
    }

    my @picked;

    for my $i (0 .. $quantity) {
        my $try = q{ };
        while ($try eq q{ }) {
            $try = $range[int(rand(scalar @range))];
        }
        @range = map { $_ eq $try ? q{ } : $_; } @range;
        push @picked, $try;
    }

    return wantarray ? @picked : $picked[0];
}

If you only pick one element, it makes more sense to get it as a scalar rather than a one-element array. Perls' wantarray() function can tell us if we are being called in an array or scalar context so we can return the appropriate result.

sub binarySearch {
    my @haystack = @{$_[0]};
    my $needle = $_[1];

    if (@haystack && scalar @haystack) {
        my $mid = int (scalar @haystack / 2); 

        if ($needle eq $haystack[$mid]) { 
            return 1;
        }

        if ($needle gt $haystack[$mid]) {
            return binarySearch([@haystack[$mid + 1 .. scalar @haystack - 1]],
                $needle);
        } 

        return binarySearch([@haystack[0 .. $mid - 1]], $needle);
    }

    return undef;
}

(Full code on Github.)

Like the Raku version, the Perl BinarySearch() function uses array slices to divide up the search space. One difference is that Perl doesn't have True and False so I return 1 and undef instead.

Challenge 2:

Write a program that demonstrates a dispatch table.

For this demo I chose to implement the game popularly known as "Rock, Paper, Scissors" (though I always call it "Paper, Scissors, Rock" for some reason.)

Once again, I'll discuss the Raku version first. The dispatch tables (I used three altogether) are implemented as arrays of references to subroutines.

my @choices = ( &chose_paper, &chose_scissors, &chose_rock );

my @outcomes = (
    (    &draw,              &scissors_loss,     &paper_win,    ),
    (    &scissors_win,      &draw,              &rock_loss,    ),
    (    &paper_loss,        &rock_win,          &draw,         )
);

Or even 2D arrays.

my @winners = ( &winner_A, &winner_B );

The subroutines themselves are pretty unremarkable in this simple application so I won't show all of them.

sub chose_paper($chooser) {
    say "$chooser chose Paper.";
}

sub paper_win {
    say "Paper covers Rock.  ";
    @winners[0]();
}

sub paper_loss {
    say "Paper covers Rock.  ";
    @winners[1]();
}

sub winner_A {
    say "A wins.";
}

sub MAIN() {
    my $achoice = (0..2).roll;
    my $bchoice = (0..2).roll;

    @choices[$achoice]('A');
    @choices[$bchoice]('B');

    @outcomes[$achoice][$bchoice]();
}

(Full code on Github.)

To invoke a code reference, just place () (optionally including parameters) after it. To select a random subroutine from @choices I used the .roll() method. This is like .pick() as used in the first challenge but the returned value is not necessarily unique.

my $achoice = int rand 3;
my $bchoice = int rand 3;

(Full code on Github.)

The Perl version works almost identically to Raku so all I am showing here is how to get a random value in the absence of .roll(). int() is necessary because rand() returns a floating-point value. In C, it is recommended that you call the srand() function to properly initialize the random number algorithm before using rand(). Perl also has srand() so I always used it but when looking at the perldoc while writing this code, I learned that it's not really necessary. srand() will be called behind the scenes the first time you use rand().