Perl Weekly Challenge: Week 286

Challenge 1:

Self Spammer

Write a program which outputs one word of its own script / source code at random. A word is anything between whitespace, including symbols.

Example 1
If the source code contains a line such as: 'open my $fh, "<", "ch-1.pl" or die;'
then the program would output each of the words { open, my, $fh,, "<",, "ch-1.pl", or, die; }
(along with other words in the source) with some positive probability.
Example 2
Technically 'print(" hello ");' is *not* an example program, because it does not
assign positive probability to the other two words in the script.
It will never display print(" or ");
Example 3
An empty script is one trivial solution, and here is another:
echo "42" > ch-1.pl && perl -p -e '' ch-1.pl

This was a fun one. Unfortunately, although it is a one-liner, it had to be contained in a script because $*PROGRAM-NAME gives the switches (i.e. -e) instead of the program name when called from the command-line. Thus two extra lines (the shebang line plus a blank) had to be added.

The instructions say words are anything separated by whitespace but as you can see below, it's one long word; there is no whitespace, which would make this solution rather boring. So I modified the spec slightly to consider . a word separator. I came up with this:

$*PROGRAM-NAME.IO.lines.tail.split(/\x2E/).pick(1).join.say;

(Full code on Github.)

$*PROGRAM-NAME gives the full path and filename of the script. .IO.lines() opens that filename and processes it into a Sequence of lines. .tail() filters out the last line. (The preceding two are irrelevant as mentioned before.) .split(/\x2E/) splits the line into a list of words separated by periods. I used the hexadecimal code for period rather than the literal character so it would not itself be considered a word separator. .pick(1) randomly chooses one of those words. Inconveniently, that is returned as a one-element list so .join() is used not to join but to convert it back into a string which is then printed out by .say().

Perl stores the program name in the special variable $0. We use it open a read-only file handle called $FILE.

open my $FILE, '<', $0;

The next line unsets the input record separator...

local $/ = undef;

...so <$FILE>, instead of one line, will slurp up the entire file into $program.

my $program = <$FILE>;

It's good programming hygiene to closs filehandles as soon as they are unneeded.

close $FILE;

This script also has some superfluous matter at the top (shebang line and a blank) so this line removes it.

$program =~ s/^.+\n\n//msx;

Now the code is split() into words (this time with whitespace as the separator.)

my @words = split /\s+/, $program; 

Finally a random word is selected and output.

say $words[int rand scalar @words];

(Full code on Github.)

Challenge 2:

Order Game

You are given an array of integers, @ints, whose length is a power of 2.

Write a script to play the order game (min and max) and return the last element.

Example 1
Input: @ints = (2, 1, 4, 5, 6, 3, 0, 2)
Output: 1

Operation 1:

    min(2, 1) = 1
    max(4, 5) = 5
    min(6, 3) = 3
    max(0, 2) = 2

Operation 2:

    min(1, 5) = 1
    max(3, 2) = 3

Operation 3:

    min(1, 3) = 1
Example 2
Input: @ints = (0, 5, 3, 2)
Output: 0

Operation 1:

    min(0, 5) = 0
    max(3, 2) = 3

Operation 2:

    min(0, 3) = 0
Example 3
Input: @ints = (9, 2, 1, 4, 5, 6, 0, 7, 3, 1, 3, 5, 7, 9, 0, 8)
Output: 2

Operation 1:

    min(9, 2) = 2
    max(1, 4) = 4
    min(5, 6) = 5
    max(0, 7) = 7
    min(3, 1) = 1
    max(3, 5) = 5
    min(7, 9) = 7
    max(0, 8) = 8

Operation 2:

    min(2, 4) = 2
    max(5, 7) = 7
    min(1, 5) = 1
    max(7, 8) = 8

Operation 3:

    min(2, 7) = 2
    max(1, 8) = 8

Operation 4:

    min(2, 8) = 2

This solution takes the input as a series of command-line arguments. Because these are immutable in Raku first we have to copy them into a new array.

my @ints = @args;

Now as long as @ints has more than one element...

while (@ints.elems > 1) {

...We create the next iteration of the array,

    my @next;

We go through the elements of @ints two by two...

    for 1 .. @ints.end -> $i {

...and if the second element of the pair has an even index, we find the largest of the two elements with .max() whereas if the second element of the pair has an odd index, we find the smallest of the two elements with .min(). In either case, the element selected is added to @next.

        @next.push($i %% 2
            ?? (@ints[$i- 1], @ints[$i]).max
            !! (@ints[$i - 1], @ints[$i]).min
        );
    }

After processing all the elements like this, we make @next the new @ints and go again.

    @ints = @next;
}

Each time we go through the inner loop, the size of @ints will halve and eventually we will end up with only one element at which point we exit the outer loop and print out that element.

say @ints[0];

(Full code on Github.)

For Perl we need implementations of max() and min(). Because we are only comparing pairs, these are really simple.

sub max($first, $second) {
    return $first > $second ? $first : $second;
}

sub min($first, $second) {
    return $first < $second ? $first : $second;
}

The rest works the same as in Raku.

my @ints = @ARGV;

while (scalar @ints > 1) {
    my @next;
    for my $i (1 .. scalar @ints - 1) {
        push @next, $i % 2 == 0
            ? max($ints[$i- 1], $ints[$i])
            : min($ints[$i - 1], $ints[$i])
        ;
    }
    @ints = @next;
}

say $ints[0];

(Full code on Github.)