Perl Weekly Challenge 286.

My solutions (task 1 and task 2 ) to the The Weekly Challenge - 286.

Task 1: Self Spammer

Submitted by: David Ferrone
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

The problem is simplified by the fact that the only condition on the probability of each word is that it is positive, and the word separator is simply a space. Thus, I first make a simple code to print a random word out of an array @w:

perl -E '...; say $w [ rand( 0+@w ) ] ;'

and the I populate the array @w with all the words of the program above:

perl -E '@w = qw( say $w [ rand( ) 0+@w ] ; ); say $w [ rand( 0+@w ) ] ;'

I add to the array the words introduced to populate the array, to make everything self-consistent. This yields a one-liner:

perl -E '@w = qw( @w = qw( ) say $w [ rand( 0+@w ) ] ; ); say $w [ rand( 0+@w ) ] ;'

I had to add an extra closing parenthesis to keep qw(...) happy. Therfore, it will be over-represented.

I run it a few times:

for i in `seq 20`; do
    perl -E '@w = qw( @w = qw( ) say $w [ rand( 0+@w ) ] ; ); say $w [ rand( 0+@w ) ] ;'
done

Results:

@w
rand(
0+@w
[
rand(
[
;
;
;
)
)
;
]
)
@w
=
qw(
$w
=
0+@w

I can see that no words are missing and estimate the probability of each by running it many times and then analysing the result

echo >rem.txt;
for i in `seq 1000`; do
    perl -E '@w = qw( @w = qw( ) say $w [ rand( 0+@w ) ] ; ); say $w [ rand( 0+@w ) ] ;'
done | perl -nE '
chomp; ++$c; push @w,$_; ++$c{$_};
END {say "word percentage";say"|-";say "$_ ",100*$c{$_}/$c for keys %c}'

Results:

word percentage
$w 8.1
rand( 7.7
@w 8.2
say 9.1
[ 8.5
qw( 8.3
0+@w 8.3
= 9.5
] 8.4
) 16.4
; 7.5

I can actually calculate the percentages by counting how many times each word appears in @w:

word appearances percentage
@w 1 8.33
= 1 8.33
qw( 1 8.33
) 2 16.67
say 1 8.33
$w 1 8.33
[ 1 8.33
rand( 1 8.33
0+@w 1 8.33
] 1 8.33
; 1 8.33
Sum 12 100.00

So the estimate is off by less than 1%, as expected from a sample of 1000 elements.

The full code is similar, but with a larger array of words:

 1  # Perl weekly challenge 286
 2  # Task 1:  Self Spammer
 3  #
 4  # See https://wlmb.github.io/2024/09/08/PWC286/#task-1-self-spammer
 5  use v5.36 ;
 6  no warnings qw( qw ) ;
 7  my @words = qw( #!/usr/bin/env perl # Perl weekly challenge 286 Task 1: Self Spammer See
 8               https://wlmb.github.io/2024/09/08/PWC286/#task-1-self-spammer
 9               use v5.36 no warnings qw
10               my @words = qw( ) say $words [ rand( 0+@words ) ] ; ) ;
11  say $words [ rand( 0+@words ) ] ;

Example, print a few random words from the code:

for i in `seq 20`; do ./ch-1.pl; done

Results:

See
qw(
use
say
Self
Task
qw
Spammer
$words
#
See
See
v5.36
1:
perl
challenge
See
$words
Spammer
;

I check below that no word is missing. I copy the @words= statement above and compare its contents to all the words of the program ch-1.pl. I also check that there is no extra word in the array @words, although for the strict purposes of this task, that is not too relevant:

use v5.36;
no warnings qw(qw);
# copy from ch-1.pl
my @words = qw( #!/usr/bin/env perl # Perl weekly challenge 286 Task 1: Self Spammer See
             https://wlmb.github.io/2024/09/08/PWC286/#task-1-self-spammer
             use v5.36 no warnings qw
             my @words = qw( ) say $words [ rand( 0+@words ) ] ; );
my %words;
++$words{$_} for @words;
my @prog=split " ", `cat ch-1.pl`;
my @extra=grep{!$words{$_}} @prog;
die "@extra not in words" if @extra;
my %prog;
++$prog{$_} for @prog;
for(keys %prog){die "Extra word $_ in \@words" if $prog{$_}==1}

As the program didn’t die, I now know the program ch-1.pl is self-consistent.

Task 2: Order Game

Submitted by: Mohammad Sajid Anwar
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

I can use the experimental for_list to consume array elements four at a time, finding their pairwise minimum and maximum until only two elements remain (or one, for degenerate inputs), in which case the result is the minimum of those remaining terms. The result fits a one and a half liner.

Example 1:

perl -Mexperimental=for_list -MList::Util=min,max -E '@a=@ARGV;while(@a>2){my @b;
for my($p,$q,$r,$s)(@a){push @b, min($p,$q),max($r,$s)} @a=@b;}say "@ARGV -> ",min(@a)
' 2 1 4 5 6 3 0 2

Results:

2 1 4 5 6 3 0 2 -> 1

Example 2:

perl -Mexperimental=for_list -MList::Util=min,max -E '@a=@ARGV;while(@a>2){my @b;
for my($p,$q,$r,$s)(@a){push @b, min($p,$q),max($r,$s)} @a=@b;}say "@ARGV -> ",min(@a)
' 0 5 3 2

Results:

0 5 3 2 -> 0

Example 3

perl -Mexperimental=for_list -MList::Util=min,max -E '@a=@ARGV;while(@a>2){my @b;
for my($p,$q,$r,$s)(@a){push @b, min($p,$q),max($r,$s)} @a=@b;}say "@ARGV -> ",min(@a)
' 9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8

Results:

9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8 -> 2

The full code just checks the input is correct.

 1  # Perl weekly challenge 286
 2  # Task 2:  Order Game
 3  #
 4  # See https://wlmb.github.io/2024/09/08/PWC286/#task-2-order-game
 5  use v5.36;
 6  use List::Util qw(min max);
 7  use experimental qw(for_list);
 8  die <<~"FIN" unless @ARGV and ((@ARGV&(@ARGV-1))==0); #finite power of 2
 9      Usage: $0 N1 N2...Nm
10      where m is a power of two to choose min max of consecutive pairs
11      and iterate until surviving element is found
12      FIN
13  my @next=@ARGV;
14  while(@next>2){
15      my @minmax;
16      for my($p,$q,$r,$s)(@next){
17          push @minmax, min($p,$q),max($r,$s);
18      }
19      @next=@minmax;
20  }
21  say "@ARGV -> ",min(@next)

Examples:

./ch-2.pl 2 1 4 5 6 3 0 2
./ch-2.pl 0 5 3 2
./ch-2.pl 9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8

Results:

2 1 4 5 6 3 0 2 -> 1
0 5 3 2 -> 0
9 2 1 4 5 6 0 7 3 1 3 5 7 9 0 8 -> 2

Example with a degenerate input:

./ch-2.pl 2

Results:

2 -> 2

Example with a malformed input:

./ch-2.pl 2 3 4

Results:

Usage: ./ch-2.pl N1 N2...Nm
where m is a power of two to choose min max of consecutive pairs
and iterate until surviving element is found
Written on September 8, 2024