Perl Weekly Challenge 160.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 160.
Task 1: Four Is Magic
Submitted by: Mohammad S Anwar
You are given a positive number, $n < 10.
Write a script to generate english text sequence starting with
the English cardinal representation of the given number, the
word ‘is’ and then the English cardinal representation of the
count of characters that made up the first word, followed by a
comma. Continue until you reach four.
Example 1:
Input: $n = 5
Output: Five is four, four is magic.
Example 2:
Input: $n = 7
Output: Seven is five, five is four, four is magic.
Example 3:
Input: $n = 6
Output: Six is three, three is five, five is four, four is
magic.
This is simple, as four is indeed magic (see below). We initialize an array with the digit names and use their length as an index to the next name, starting from the supplied argument. This fits into a oneliner.
perl -E '@e=qw(zero one two three four five six seven eight nine); for $n(@ARGV){
while($n!=4){print "$e[$n] is ", $e[$n=length $e[$n]], ", "} say "four is magic"};
' 0 1 2 3 4 5 6 7 8 9
Results:
zero is four, four is magic
one is three, three is five, five is four, four is magic
two is three, three is five, five is four, four is magic
three is five, five is four, four is magic
four is magic
five is four, four is magic
six is three, three is five, five is four, four is magic
seven is five, five is four, four is magic
eight is five, five is four, four is magic
nine is four, four is magic
The corresponding full program would be:
1 # Perl weekly challenge 160
2 # Task 1: Four is magic
3 #
4 # See https://wlmb.github.io/2022/04/11/PWC160/#task-1-four-is-magic
5 use v5.12;
6 use warnings;
7 die "Usage: ./ch-1.pl N1 [N2... ]\n".
8 "to find all trajectories between number names starting at index N1, N2..."
9 unless @ARGV;
10 my @names=qw(zero one two three four five six seven eight nine);
11 for my $n(@ARGV){
12 say("Wrong input: $n"), next if $n>=@names;
13 while($n!=4){
14 print "$names[$n] is ", $names[$n=length $names[$n]], ", ";
15 }
16 say "four is magic"
17 };
Example:
./ch-1.pl 0 1 2 3 4 5 6 7 8 9 10
Results:
zero is four, four is magic
one is three, three is five, five is four, four is magic
two is three, three is five, five is four, four is magic
three is five, five is four, four is magic
four is magic
five is four, four is magic
six is three, three is five, five is four, four is magic
seven is five, five is four, four is magic
eight is five, five is four, four is magic
nine is four, four is magic
Wrong input: 10
The reason four is magic is that it has four letters, and that
the sequence started from any number converges to four. Thus,
instead of hard-coding the magic four, we may test for a fixed
point of the iteration that maps a $name to the
$name[length $name]. This allows the problem to be
generalized to an arbitrary array and an arbitrary mapping of
the array onto itself. The problem then is that there could be
cycles as well as fixed points, which would lead to infinite
loops if they are not detected. Thus, the following more
general and more robust program. I still use the length of
the string as a mapping function, but it could be changed.
1 # Perl weekly challenge 160
2 # Task 1: Four is magic
3 #
4 # See https://wlmb.github.io/2022/04/11/PWC160/#task-1-four-is-magic
5 use v5.12;
6 use warnings;
7 die <<'END' unless @ARGV >= 2;
8 Usage: ./ch-1a.pl "S1 [S2... ]" N1 [N2...]\n
9 to find all trajectories between strings S1 S2...
10 starting from position N1, N2...
11 The mapping function uses the length of a string as an index
12 to the next string
13 END
14 my @strings=split " ", shift;
15 foreach my $index(@ARGV){
16 my @seen;
17 while(1){
18 say("$strings[$index] is magic"), last if (my $next=next_index($index))==$index;
19 say("$strings[$index] is magic loop"), last if $seen[$index];
20 say("$index->nothing"), last unless defined $next;
21 $seen[$index]++;
22 print "$strings[$index] is $strings[$next], ";
23 $index=$next;
24 }
25 }
26 sub next_index {
27 my $current=shift;
28 my $next=length $strings[$current]; # Could use other mappings
29 return undef unless defined $strings[$next];
30 return $next;
31 }
Example:
./ch-1a.pl "zero one two three four five six seven eight nine" 0 1 2 3 4 5 6 7 8 9
Results:
zero is four, four is magic
one is three, three is five, five is four, four is magic
two is three, three is five, five is four, four is magic
three is five, five is four, four is magic
four is magic
five is four, four is magic
six is three, three is five, five is four, four is magic
seven is five, five is four, four is magic
eight is five, five is four, four is magic
nine is four, four is magic
Another example, with different strings,
./ch-1a.pl "red orange yellow green blue indigo violet" 0 1 2 3 4 5 6 7
Results:
red is green, green is indigo, indigo is violet, violet is magic
orange is violet, violet is magic
yellow is violet, violet is magic
green is indigo, indigo is violet, violet is magic
blue is magic
indigo is violet, violet is magic
violet is magic
7->nothing
In this case, there are two magic color names, as blue occupies position 4 (starting from 0) and it has four letters, while violet occupies position 6 and has six letters.
Task 2: Equilibrium Index
Submitted by: Mohammad S Anwar
You are give an array of integers, @n.
Write a script to find out the Equilibrium Index of the given
array, if found.
For an array A consisting n elements, index i is an
equilibrium index if the sum of elements of subarray A[0…i-1]
is equal to the sum of elements of subarray A[i+1…n-1].
Example 1:
Input: @n = (1, 3, 5, 7, 9)
Output: 3
Example 2:
Input: @n = (1, 2, 3, 4, 5)
Output: -1 as no Equilibrium Index found.
Example 3:
Input: @n = (2, 4, 2)
Output: 1
To solve this task I can sum the leading and trailing subarrays for all possible cuts. I use PDL’s ability to slice arrays and operate on its elements in the following one-liners.
perl -MPDL -MPDL::NiceSlice -E 'say "Input: ", $x=pdl(@ARGV); $i="-1 No eq. found";
for(1..$x->nelem-2){$i=$_ if $x(0:$_-1)->sumover==$x($_+1:-1)->sumover} say "Output: $i"
' 1 3 5 7 9
perl -MPDL -MPDL::NiceSlice -E 'say "Input: ", $x=pdl(@ARGV); $i="-1 No eq. found";
for(1..$x->nelem-2){$i=$_ if $x(0:$_-1)->sumover==$x($_+1:-1)->sumover} say "Output: $i"
' 1 2 3 4 5
perl -MPDL -MPDL::NiceSlice -E 'say "Input: ", $x=pdl(@ARGV); $i="-1 No eq. found";
for(1..$x->nelem-2){$i=$_ if $x(0:$_-1)->sumover==$x($_+1:-1)->sumover} say "Output: $i"
' 2 4 2
Results:
Input: [1 3 5 7 9]
Output: 3
Input: [1 2 3 4 5]
Output: -1 No eq. found
Input: [2 4 2]
Output: 1
The full version follows.
1 # Perl weekly challenge 160
2 # Task 2: Equilibrium index
3 #
4 # See https://wlmb.github.io/2022/04/11/PWC160/#task-2-equilibrium-index
5 use v5.12;
6 use warnings;
7 use PDL;
8 use PDL::NiceSlice;
9 die "Usage: ./ch-2.pl N1 [N2...] to find equilibrium index of an array of numbers"
10 unless @ARGV;
11 my $input=pdl(@ARGV);
12 my $result="-1 as no equilibrium index was found"; # default output
13 say "Input: ", $input;
14 for(1..$input->nelem-2){ #for all internal indices
15 $result="$_ as sum(".$input(0:$_-1).")==sum(".$input($_+1:-1).")", last
16 if $input(0:$_-1)->sumover==$input($_+1:-1)->sumover; # Found equilibrium
17 }
18 say "Output: $result";
Examples:
./ch-2.pl 1 3 5 7 9
./ch-2.pl 1 2 3 4 5
./ch-2.pl 2 4 2
Results:
Input: [1 3 5 7 9]
Output: 3 as sum([1 3 5])==sum([9])
Input: [1 2 3 4 5]
Output: -1 as no equilibrium index was found
Input: [2 4 2]
Output: 1 as sum([2])==sum([2])
Notice that the equilibrium point as defined above is not the center of mass of the array, as the array elements are summed disregarding their index with respect to the equilibrium index, accounting only for their sign (left or right). Thus the simpler calculation of the center of mass (the first moment of the array) wouldn’t work.