Colin Crain › Perl Weekly Review #160

Tuesday, May 17, 2022| Tags: perl

( …continues from previous week. )

Welcome to the Perl review pages for Week 160 of The Weekly Challenge! Here we will take the time to discuss the submissions offered up by the team, factor out some common methodologies that came up in those solutions, and highlight some of the unique approaches and unusual code created.


●︎ Why do we do these challenges?

I suppose any reasonable answer to that question would be from a field as wide ranging and varied as the people who choose to join the team. One thing, though, is clear: it’s not a competition, and there are no judges, even if there is a “prize” of sorts. About that – I think of it more as an honorarium periodically awarded to acknowledge the efforts we make towards this strange goal. So there’s no determination to find the fastest, or the shortest, or even, in some abstract way, the best way to go about things, although I’m certain the participants have their own aspirations and personal drives. As Perl is such a wonderfully expressive language, this provides quite a bit of fodder to the core idea of TMTOWTDI, producing a gamut of varied techniques and solutions.

Even the tasks themselves are often open to a certain amount of discretionary interpretation. What we end up with is a situation where each participant is producing something in the manner they find the most interesting or satisfying. Some team members focus on carefully crafted complete applications, thoroughly vetting input data and handling every use case they can think up. Others choose to apply themselves to the logic of the underlying puzzle and making it work in the most elegant way they can. Some eschew modules they would ordinarily reach for, others embrace them, bringing to light wheels perhaps invented years ago that happen to exactly solve the problem in front of them today.

I’ve been considering this question for some time and have found one binding commonality between all of us out solving these challenges each week, in that however we normally live our lives, the task in front of us more than likely has nothing to do with any of that. And I think this has great value. We all do what we do, in the real world, and hopefully we do it well. The Weekly Challenge provides us with an opportunity to do something germane to that life yet distinctly different; if we only do the things we already know how to do then we will only do the same things over and over. This is where the “challenge” aspect comes into play.

So we can consider The Weekly Challenge as providing a problem space outside of our comfort zone, as far out from that comfort as we wish to take things. From those reaches we can gather and learn things, pick and choose and bring what we want back into our lives. Personally, I think that’s what this whole thing is about. YMMV.


Every week there is an enormous global collective effort made by the team, analyzing and creatively coding the submissions, and that effort deserves credit due.

And that, my friends, is why I’m here, to try and figure out ways to do just that.

So, here we are then. I’m ready — let’s get to it and see what we can find.


For Additional Context…

before we begin, you may wish to revisit either the pages for the original tasks or the summary recap of the challenge. But don’t worry about it, the challenge text will be repeated and presented as we progress from task to task.

Oh, and one more thing before we get started:

Getting in Touch with Us

Email › Please feel free to email me (Colin) with any feedback, notes, clarifications or whatnot about this review.

GitHub › Submit a pull request to us for any issues you may find with this page.

Twitter › Join the discussion on Twitter!

I’m always curious as to what the people think of these efforts. Everyone here at the PWC would like to hear any feedback you’d like to give.

...So finally, without further ado...

•       Task 1       •       Task 2       •       BLOGS       •


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.

about the solutions

Adam Russell, Alexander Pankoff, Ali Moradi, Arne Sommer, Athanasius, Bruce Gray, Cheok-Yin Fung, Colin Crain, Dave Jacoby, Duncan C. White, E. Choroba, Flavio Poletti, Jaldhar H. Vyas, James Smith, Jorg Sommrey, Laurent Rosenfeld, Lubos Kolouch, Matthew Neleigh, Maxim Kolodyazhny, Mohammad S Anwar, Paulo Custodio, Pete Houston, Peter Campbell Smith, PokGoPun, Robert DiCicco, Roger Bell_West, Simon Green, and W. Luis Mochan

Let me be straight with you — I quite enjoy these little excursions into what amounts to Natural Language Programming. Albeit this particular task is not particularly complex, it fits the category nonetheless. Here we’re constructing a sentence of sorts, really a phrase, using words for numbers instead of numbers, and then using a property of those words — the letter count — to modify the phrase going forward.

The algorithm, it might be noted, always finishes no matter the input number given. The best way to demonstrate this is to prove that the numbers from one to nine — the task as given — all finish, and then start expanding the scope. The first nine digits will all fall into patterns that will finish based on three, four or five character names. The irregular numbers up to twenty all have less than ten characters, and so with an extra conversion step we will land on a sequence that is known to converge. We can then expand the known range to include compound numbers less than one-hundred, as the longest construction — “seventy-seven” has a length known to converge. At this point we have included all numbers that when written out have less than one-hundred characters and we can see this includes all numbers through some finite number of intermediate steps.

Speaking to a generalized algorithm, it turns out not to matter whether we include hyphens in our digit count, although I think the game plays more smoothly if we ignore them. We can include zero too, as both “zero” and “no” will converge, so there are options available as well to use different phrasing if desired. We can also continue backwards down the number line including the word “negative” and into the real numbers with “point”:

“negative sixty-six point six six three is thirty-two, thirty-two is nine, nine is four, four is magic”

There were 28 submissions for the first task this past week.

A SELECTION of SUBMISSIONS

Cheok-Yin Fung, Roger Bell_West, E. Choroba, James Smith, Paulo Custodio, Colin Crain, Dave Jacoby, Mohammad S Anwar, Adam Russell, and Maxim Kolodyazhny

The actual English language programming for the challenge is not very involved; essentially we need a way to translate digital numbers into their English word equivalents, and then parse those words for their character count to continue building the phrase until we finish.

We saw arrays and hashes to perform the translation lookup, and also the use of a numeric text module specifically designed for the purpose. It was also fairly common to extend the allowed range for input beyond the required nine cases.

Cheok-Yin Fung

We will start the survey with a mathematician. CY solves the lookup problem gracefully, by constructing an array of words corresponding to the written-out names of the index positions. By maintaining the count as a digital number she can then use it as an index in the array to get the associated word quickly and easily. This array does include the dummy value “zero” to keep the alignment synchronized, although for the task as given this will never be used.

On the other hand, we’ll note that “Zero is four, four is magic”, works just fine. Also note that to construct the proper phrase in the style of the examples we should capitalize the first letter and end with a period.

The control flow is built around phrase-elements “«written number» is «number of characters»", repeated until we arrive at the number 4, which triggers what CY refers to as the “spell” portion of the sentence, “four is magic.” The first numeric instance is uppercased, and then the phrase generation is handed off to a loop until the sequence resolves.

Proper punctuation is included at the time of construction.

    sub fim {
        my @num = ("zero", "one", "two", "three", "four", "five",
                   "six", "seven", "eight", "nine");
        my $spell = "four is magic.";
        my $c = $_[0];
        if ($c == 4) {
            print ucfirst($spell), "\n";
            return;
        }
        $num[$c] = ucfirst($num[$c]);
        while ($c != 4) {
            print $num[$c];
            $c = length $num[$c];
            print " is $num[$c], ";
        }
        print "$spell\n";
    }

Roger Bell_West

  additional languages: Javascript, Kotlin, Lua, Postscript, Python, Raku, Ruby, Rust

  blog writeup: RogerBW’s Blog: The Weekly Challenge 160: Balancing Four is Magic

Roger also gives us a tight loop, built around a central lookup array for his text equivalents. Here he’s changed the action slightly to focus around the phrase-element generation, moving the sentence construction of capitalization and punctuation into the last, output line. The whole logic structure is now built on assembling the digit-word subcomponents inside the loop.

On the other hand CY’s definitely got him beat on using that $spell variable name, which made me smile. I suppose you could consider $s to stand for that, but I do think “string” is more likely, as that’s what we’re assembling. I quite enjoy CY’s Chinese-language takes on English variable and subroutine naming.

    sub fim {
      my $n=shift;
      my @words=qw(zero one two three four five six seven eight nine);
      my @p;
      while (1) {
        my $s=$words[$n] . ' is ';
        if ($n == 4) {
          $s .= 'magic.';
          push @p,$s;
          last;
        } else {
          $n=length($words[$n]);
          $s .= $words[$n];
          push @p,$s;
        }
      }
      return ucfirst(join(', ',@p));
    }

E. Choroba

Choroba strips the fat even further, into a short recursive routine with a wrapper function to provide initial capitalization and punctuation.

    my @cardinals = qw( one two three four five six seven eight nine );

    sub four_is_magic ($n) {
        ucfirst _four_is_magic($n) . '.'
    }

    sub _four_is_magic ($n) {
        return 'four is magic' if 4 == $n;

        my $word = $cardinals[ $n - 1 ];
        my $length = length $word;
        return "$word is $cardinals[ $length - 1 ], " . _four_is_magic($length)
    }

James Smith

  blog writeup: Perl Weekly Challenge #160

Although in the limited range of the task the numbers 1 through 9 are easily written out using a lookup of some sort, array or hash, in general natural language programming is more complex, with a wide variety of linguistic quirks to accommodate. As such specialized tools have been developed by enthusiasts willing to take up the challenge. One such enthusiast is PWC member Neil Bowers, who has among his many, many achievements brought Lingua::EN:Numbers into our world.

This module has two functions, one to translate a number into written English text, and a second to convert a number into an ordinal string, such as “fifty-third”.

Using this module removes the numeric complexity from the algorithm, allowing input from any range. This was the second basic method used to solve the problem.

    use Lingua::EN::Numbers qw(num2en);

    sub magic {
      my $r = ucfirst num2en( my $n = shift ).' is ';
      $r .= join num2en( $n = length num2en($n)=~s/\W//rg ), '', ', ', ' is ' until $n==4;
      $r.'magic.';
    }

Paulo Custodio

Here’s another example from Paulo. Note we no longer need to check the range of the input, as any number will work, say -1.45e24:

    Negative one point four five times ten to the twenty-fourth is fifty-nine, fifty-nine is ten, ten is three, three is five, five is four, four is magic.

The exact method used to decide which characters to include or not include when counting, as we said, is basically inconsequential. Either the long way or the short way, we’ll get there in the end.

    use Lingua::EN::Numbers qw(num2en);

    say sequence(shift||1);

    sub sequence {
        my($n) = @_;
        my @out;
        while ($n != 4) {
            my $num_en = num2en($n);
            my $len = length($num_en);
            my $len_en = num2en($len);

            push @out, "$num_en is $len_en";
            $n = $len;
        }

        push @out, "four is magic.";
        $out[0] =~ s/(\w)/\U$1/;
        return join(", ", @out);
    }

Colin Crain

  additional languages: Raku

  blog writeup: Sign of the Four - Programming Excursions in Perl and Raku

  blog writeup: All Things in Balance - Programming Excursions in Perl and Raku

Natural language programming problems, like CSV parsing and date and time manipulations, hide surprisingly complex tasks disguised as simple concepts. Hence I view them as best handled by specialized libraries dedicated to getting all the fiddly bits right.

In my own solution, I’ve been having a small problem lately with the familiar while (1) { ... } construct for an infinite loop. I know it’s a little late to complain, and have in fact been using it without incident for — what? — decades now, but lately using a conditional with something that will never fail is just looking… kludgy to me. I don’t know. I can’t quite put my finger on it. Perhaps it will pass.

In any case I’ve started experimenting with redo inside a block. Unfortunately this puts the action verb after the object, which is less-than-perfect, but seems to scan well. At least it does what it says it should: while (1) is just sort of sarcastic.

“Let’s try and communicate by saying the opposite of what we really mean”. Yea, that’s gonna work. See? Now they’ve even got me doing it. I really am trying to avoid sarcasm lately. Life is difficult and confusing enough, thank you very much.

    sub magic ($num, $out = '') {
        {
            my $name =  num2en($num);
            $out  .= "$name is ";
            $name =~ s/[^a-z]//g;
            $num == 4
                ? return ($out . "magic")
                : ($out .= num2en(  length $name  ) . ', ');
            $num = length $name ;
            redo;
        }
    }

Dave Jacoby

  blog writeup: Does That Make Friendship Equal Four?: Weekly Challenge #160 | Committed to Memory

One more in this style from Dave. Note the use of a regular expression to match out word characters instead of using length, which only counts the letters, and not hyphens. It doesn’t matter in the end, only slightly changing the path to the inevitable outcome, but it is kind of cool as a technique, to isolate out only a select subset of characters. As I said the algorithm will finish no matter whether you include hyphens or not, or even, for that matter, if you were to spell out the word “hyphen”. But as a magic trick I think it works better if you don’t mention them.

    sub magic ( $i ) {
        return 'four is magic.' if $i == 4;
        my $w   = num2en($i);
        my $c   = () = $w =~ /(\w)/gmix;
        my $d   = num2en($c);
        my $out = qq{$w is $d, };
        $out .= magic($c);
        return ucfirst lc $out;
    }

Mohammad S Anwar

  additional languages: Raku

Mohammad is back this week, with a submission based of a hash lookup for his cardinal number names. I believe there is a natural thought process to see an associative array as a more complex data structure and hence more computationally expensive, but the truth of matter is that hashes in Perl are basic, simple and useful, and hence over the years have become extremely-well tuned for speed. Hash lookups occur in constant time completely independant of scaling and are impressively fast.

I was kind of waiting for someone to use a Perl hash for this translation table, and here we are.

    sub four_magic {
        my ($n) = @_;

        die "ERROR: Missing number.\n"      unless defined $n;
        die "ERROR: Invalid number [$n].\n" unless ($n >=0 and $n < 10);

        my %name_of = (0, 'zero',  1, 'one',
                       2, 'two',   3, 'three',
                       4, 'four',  5, 'five',
                       6, 'six',   7, 'seven',
                       8, 'eight', 9, 'nine');

        my @str = ();
        while (1) {
            my $name = $name_of{$n};
            my $len  = length($name);
            push @str, "$name is $name_of{$len}";
            last if ($len == 4);
            $n = length($name);
        }

        push @str, 'four is magic.';

        return ucfirst(join(', ', @str));
    }

Adam Russell

  additional languages: Prolog

  blog writeup: Four is Equilibrium — Perl — RabbitFarm

  blog writeup: Four is Equilibrium — Prolog — RabbitFarm

After a brief summary of what he plans to do, Adam also chooses a hash for his lookup. Good choice. As language features go, Perl hashes stand out as a basic building block at the most primitive level. When you only provide three data structures (ok more, but lets not nit-pick) then they should be good.

    # 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.


    my %cardinals = (
        1 => "one",
        2 => "two",
        3 => "three",
        4 => "four",
        5 => "five",
        6 => "six",
        7 => "seven",
        8 => "eight",
        9 => "nine"
    );

    sub four_is_magic {
        my($n, $s) = @_;
        $s = "" if !$s;
        return $s .= "four is magic" if $n == 4;
        $s .= $cardinals{$n} . " is " . $cardinals{length($cardinals{$n})} . ", ";
        four_is_magic(length($cardinals{$n}), $s);
    }

Maxim Kolodyazhny

We’ll close out with this submission from avid golfing enthusiast Maxim. Golf, you say? Well there are a few dead giveaways, that taken together lead me to the conclusion:

  • the use of pop to get the base number from the implicit @ARGV, saving two characters over shift, and then assigning to the predeclared topic variable.
  • similarly defining the number list with qw() quoting, and not spelling out “zero” as it will never be used
  • 1while is of course a hideous monstrosity but effective, albeit confusing
  • forgoing the courtesy of a closing semicolon. It’s all business with this lot.

That said, using a substitution regex is a really inventive solution, and really off the beaten path so kudos, Maxim. In short, we replace any number except 4 with the appropriate phrase segment followed by the result of the length subroutine as a number. We now have another number to match so the substitution is run again, until the new number is 4. No longer allowed to match, the loop stops as well. The final 4 is substituted out in the output, which uses the /r switch to return the result of the substitution as a string. Handy that, as you see.

Note that in 1while it’s not the conditional that’s true, but the block, like:

    while (*conditional*) {
        1;  ## do nothing

    }

Here’s the tightly-wrapped beast in its glory:

    $_ = pop;

    my @n = qw( 0 one two three four five six seven eight nine );
    sub l { length @n[@_] }

    1while s/[^4]$/$n[$&] is $n[l $&], ${\l $&}/;
    say ucfirst s/4/four is magic./r

Blogs and Additional Submissions in Guest Languages for Task 1:

Alexander Pankoff

  additional languages: Haskell

  blog writeup: Challenge 160 Task #1 - No way around four

  blog writeup: Challenge 160 Task #2 - Steps to recovering the Equilibrium in your lists

Ali Moradi

  additional languages: C++, Lua, Pascal, Raku

Arne Sommer

  additional languages: Raku

  blog writeup: The Magic Equilibrium with Raku and Perl

Athanasius

  additional languages: Raku

Bruce Gray

  additional languages: Raku, Yabasic

  blog writeup: TWC 160: Mystic/Math Balance | Bruce Gray

Duncan C. White

  additional languages: C

Flavio Poletti

  additional languages: Raku

  blog writeup: PWC160 - Four Is Magic - ETOOBUSY

  blog writeup: PWC160 - Equilibrium Index - ETOOBUSY

Jaldhar H. Vyas

  additional languages: Raku

  blog writeup: Perl Weekly Challenge: Week 160

Laurent Rosenfeld

  additional languages: Raku

  blog writeup: Perl Weekly Challenge 160: Four is Magic and Equilibrium Index

Lubos Kolouch

  additional languages: Python

Peter Campbell Smith

  blog writeup: Four is magic and Equilibrium Indices

PokGoPun

  additional languages: Go

Robert DiCicco

  additional languages: Julia, Raku, Ruby

Simon Green

  additional languages: Python

  blog writeup: Weekly Challenge 160

W. Luis Mochan

  blog writeup: Perl Weekly Challenge 160 – W. Luis Mochán



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

about the solutions

Adam Russell, Alexander Pankoff, Ali Moradi, Arne Sommer, Athanasius, Bruce Gray, Cheok-Yin Fung, Colin Crain, Dave Jacoby, Duncan C. White, E. Choroba, Flavio Poletti, Jaldhar H. Vyas, James Smith, Jorg Sommrey, Laurent Rosenfeld, Lubos Kolouch, Matthew Neleigh, Olivier Delouya, Paulo Custodio, Pete Houston, Peter Campbell Smith, PokGoPun, Robert DiCicco, Roger Bell_West, Simon Green, and W. Luis Mochan

The definition of an equilibrium state is when several forces working in opposition arrive at a net balance, cancelling each other out to achieve at a stable state. In this challenge, the two opposing forces are the sums of the sub-lists on either side of a given index position.

This suggests perhaps a problem of evaluation and adjustment, ultimately homing in on a final result. But in practicality it was more of an exploration into list-wise processing, examining index positions individually for ones that fit the criteria. There were several diferent approaches we saw to solving the problem.

There were a total of 27 submissions for the second task this past week.

A SELECTION of SUBMISSIONS

Laurent Rosenfeld, Alexander Pankoff, Simon Green, Robert DiCicco, Jorg Sommrey, W. Luis Mochan, Athanasius, Matthew Neleigh, Colin Crain, Bruce Gray, and Olivier Delouya

As we said, there were a variety of solutions seen. Predominately the method revolved around computing the side-lists at each position to find those that summed the same.

Laurent Rosenfeld

  additional languages: Raku

  blog writeup: Perl Weekly Challenge 160: Four is Magic and Equilibrium Index

Laurent will start us of today with a very direct approach: examining each element in turn and summing the sublists preceding and following it. With small lists resembling the ones in the examples, he notes, this approach will computationally be no problem.

The list is iterated over by index, which allows us to use two array slices to examine the left- and right-hand sides. A homemade sum function is then applied to return a compounded total.

    sub equilibrium {
        my @ary = @_;
        for my $i (1..$#ary-1) {
            return $i if sum (@ary[0..$i-1]) == sum (@ary[$i+1..$#ary]);
        }
        return -1;
    }

    sub sum {
        my $sum = 0;
        $sum += $_ for @_;
        return $sum;
    }

Alexander Pankoff

  additional languages: Haskell

  blog writeup: Challenge 160 Task #1 - No way around four

  blog writeup: Challenge 160 Task #2 - Steps to recovering the Equilibrium in your lists

This was not an uncommon approach. Here Alexander uses two variables to hold the sublists left and right, perhaps making the action a little clearer, but with net result being the same.

    use List::Util qw(all sum0);

    sub run() {
        my @xs = @ARGV;
        die "Expect a list of integers!\n" unless all { m/^-?\d+$/ } @xs;

        say equilibrium_index(@xs);
    }

    sub equilibrium_index(@xs) {
        for my $i ( 0 .. $#xs  ) {
            my $lower = sum0( @xs[ 0 .. $i - 1 ] );
            my $upper = sum0( @xs[ $i + 1 .. $#xs ] );
            return $i if $lower == $upper;
        }

        return -1;
    }

Simon Green

  additional languages: Python

  blog writeup: Weekly Challenge 160

Using array slices and the sum function from List::Util produces a very compact solution, as you can see. This ended up being the most common method used by far. It’s elegant and effective. I personally really like using slices, and list-wise processing in general.

    sub main {
        my @n = @_;

        my $idx = -1;

        foreach my $i ( 1 .. $#n - 1 ) {
            # If the sum of digits to the left match the sum of digits to the

            #  right, we have found a solution.

            if ( sum( @n[ 0 .. $i - 1 ] ) == sum( @n[ $i + 1 .. $#n ] ) ) {
                $idx = $i;
                last;
            }
        }

        say $idx;
    }

Robert DiCicco

  additional languages: Julia, Raku, Ruby

In sort of the opposite approach we have this submission by Robert, broken down into subroutine components, with handmade summing, and considerable commentary.

In the end the code doesn’t care much about how many lines it is in most cases. In intensive number crunching I can see the rationale behind directly accessing the stack in @ARGV and subroutines, for example, eliminating an assignment here, tightening a loop there. But ultimately the trade-off is usually between minor tuning in efficiency vs. ease in mainetenance and comprenhension, and our task to find the sweet spot betweeen the two.

The cost of disk space, for instance, used to be a serious issue. Now it’s not. There is a case for clarity now. YMMV.

    sub leftsum {                           # get sum of the array to left of the inflection point,

      my $a = shift;                        # this includes the inflection point

      my $i = shift;

      my $sum = 0;
      while($i >= 0 ){
        $sum += @$a[$i];
        $i--;
      }

      return $sum;
    }

    sub rightsum {                          # get sum of the array to right of the inflection point,

      my $a = shift;                        # this includes the inflection point

      my $i = shift;

      my $sum = 0;
      while($i < scalar(@$a) ){
        $sum += @$a[$i];
        $i++;
      }

      return $sum;
    }

     sub balance {
       my $a = shift;                       # the input array


       my $flag = 0;                        # 'found' flag

       my $len = scalar(@$a);
       foreach my $i (1..$len-2){           # step thru possible inflection points

          my $leftval = leftsum($a, $i);    # get the sum of left side of inflection point

          my $rightval = rightsum($a,$i);   # get sum of right side of inflection point

          if ($leftval == $rightval){       # compare sums

            print "Output: $i\n\n";
            $flag++;                        # increment flag if equal

            last;
          }
       }

       unless ( $flag > 0 ) {print "Output: -1 as no Equilibrium Index found.\n\n"} ;
     }

Jorg Sommrey

Jorg gives us a unique manner of progressing his index; inside an exit conditional loop the first operation acts on the index $i and increments it post-evaluation, so when the second operation occurs we have already moved it forward. So we end up adding the old value if $i to the left list and subtract the new updated value from the right.

    sub equilibrium_index {
        my ($i, $left, $right) = (0, 0, sum0 @_[1 .. $#_]);
        # Starting with an empty left subarray, shift the index until an

        # equilibrium is found or the right subarray becomes empty.

        while ($left != $right && $i < $#_) {
            $left += $_[$i++];
            $right -= $_[$i];
        }

        $left == $right ? $i : -1;
    }

W. Luis Mochan

  blog writeup: Perl Weekly Challenge 160 – W. Luis Mochán

The basic data structure of the Perl Data Language extensions is a multi-dimensional array. As that multiple dimension can quite reasonably also be 1, that means that any array or list function processing algorithm is well suited to adaptation using the PDL.

Here Luis demonstrates. Slicing arrays is second nature when using the PDL, to the point it is normal to refer to a data subset as a range, denotated using a colon: (idx_from:idx_to). We get this handy notation by using NiceSlice. We also get the sumover function on a slice out of the box, to sum over the slice elements (as you would hopefully expect).

In the end we get a familiar algorithm in a new form.

    use PDL;
    use PDL::NiceSlice;
    die "Usage: ./ch-2.pl N1 [N2...] to find equilibrium index of an array of numbers"
        unless @ARGV;
    my $input=pdl(@ARGV);
    my $result="-1 as no equilibrium index was found"; # default output

    say "Input: ", $input;
    for(1..$input->nelem-2){ #for all internal indices

       $result="$_ as sum(".$input(0:$_-1).")==sum(".$input($_+1:-1).")", last
       if $input(0:$_-1)->sumover==$input($_+1:-1)->sumover; # Found equilibrium

    }
    say "Output: $result";

Athanasius

  additional languages: Raku

The monk shares a really interesting take on the problem, computing the two side-list sums at the beginning of the search and then updating the values at each step as we walk the list from left-to-right.

The bookkeeping is straightforward: as the index is advanced we are focused on the three values: at the index, immediately preceeding the index, and immediately following. At each shift the values of the summed side-lists change acording to a strict pattern: the previosly examined index value is added to the left-side sum and the value of the new index element is subtracted from the right-hand sum. Practically the value added to the left list is accessed by looking at the value of the currect index minus one, obviating the need for a separate temporary holding variable.

    MAIN:
    {
        my @n = parse_command_line();

        printf "Input:  \@n = (%s)\n", join ', ', @n;

        my $index      = -1;
        my $left_sum   =  0;
        my $right_sum  =  0;
           $right_sum += $_ for @n[ 1 .. $#n ];

        for my $i (0 .. $#n)
        {
            if ($left_sum == $right_sum)
            {
                $index = $i;
                last;
            }

            $left_sum  += $n[ $i     ];
            $right_sum -= $n[ $i + 1 ] if $i < $#n;
        }

        print "Output: $index\n";
    }

Matthew Neleigh

Here Matthew gives a variation on the technique. Two sums are maintained as we work across the list by index, values are added to the let-hand total and subtracted from the right.

Of note the list ahead of us, of indices higher than the current position, is known as the “fore” list, and those behind our intrepid traversing iterator, in the wake of the transformation, the “aft”. I like that terminology.

    sub calculate_equilibrium_index{

        # Can't have an equilibrium index if there

        # aren't at least three elements

        return(-1)
            if(scalar(@ARG) < 3);

        my $fore = 0;
        my $aft = $ARG[0];
        my $i = 1;

        # Compute the fore total

        for(2 .. $#ARG){
            $fore += $ARG[$_];
        }

        # Loop from 1 to ($#ARG - 1)

        while($i < $#ARG){
            if($aft == $fore){
                # Found an equilibrium index- return it

                return($i);
            }

            # Advance the index, adjusting the fore and

            # aft totals

            $aft += $ARG[$i];
            $fore -= $ARG[++$i];
        }

        # No equilibrium index found

        return(-1);

    }

Colin Crain

  additional languages: Raku

  blog writeup: Sign of the Four - Programming Excursions in Perl and Raku

  blog writeup: All Things in Balance - Programming Excursions in Perl and Raku

For my own submission, I ended up solving the problem three ways. First, I worked across the list indices, summing and comparing array slices for the lists to the sides. This works well, but I couldn’t help but think about the inefficiency of recomputing the side sums for every position. For a short list this is no problem, but ultimately squares the complexity as we touch every element for each new position considered. We saw several examples of this technique.

There had to be another way.

So I came on the idea of summing the entire list to start, and as we advance subtracting from this total and adding to a left-hand sum of elements already processed. We also saw this demonstrated. But this too necesitates traversing the entire list twice; once to construct the sum and then again to examine the positions.

Ultimately I came upom the idea that for every position, at equilibrium the side lists are equal to each other and further, we can calculate the sum they will arrive at. This will be the sum of the entire list, minus the element at the index, divided in half. There’s no way, if the left position equals this value, that the right does not.

So we make a single traversal, and at each position we add the proeviously visited element to a accumulating sum of the left-hand list. From this we can compute a hypothetical whole-list sum by doubling it and adding the value of the index being visited.

This new value is then used as a hash key, associated to the index position that got us that result. When we have finished making a single complete traversal we have enough information to get the actual sum for the entire list, which we can then look up in our hash to find the hypothetical sum that matches up. If the lookup is successful we have an answer, and if it fails we know there is no equilibrium.

Not addressed is the idea that we can possibly have multiple equilibria, which can arise if we allow 0 and negative values, which as written are not excluded. Both solutions can be adapted for this possibility: the first by removing the short circuit and examining every position for a balance, recording all positive results, and the second by having the hash point to an array of results instead of a single scaler index.

Is removing the second traversal really worth the extra effort? Meh, I don’t know. Working a list of 6.7 million elements it might add up. But it was a fun exercise, capitalizing on the idea that hash lookups are a small constant time operation insensitive to scaling.

    use List::Util qw( first sum );

    sub eq_direct {
    ## exhaustive traversal, re-summing side-lists

        return (first { sum(@_[0..$_-1]) == sum(@_[$_+1..$#_]) } (1..$#_-1)) // -1;
    } ;

    sub eq_linear (@list) {
    ## single-pass continuous summing with lookup

        my %sums;
        my $total = $list[0];
        for (1..$#list-1) {
            $sums{ 2 * $total + $list[$_] } = $_;
            $total += $list[$_];
        }
        $total += $list[-1];
        return $sums{$total} // -1
    }

Bruce Gray

  additional languages: Raku, Yabasic

  blog writeup: TWC 160: Mystic/Math Balance | Bruce Gray

Looking through all the solutions, it seems Bruce did come up with this single-pass method for his Raku solution, which for me at least is nice to see. I thought it was cool. However for his Perl solution he does not do this, providing us an exciting alternative.

Exciting I say!

Do I have your attention now? Good. So, he creates two lists of partial sums. In the first, he works left-to-right adding another value and listing the new result. In the second list, however, he counts downward from the total sum one element at a time, starting at the first element. Then, at the end, he compares the two lists index-by-index, and if the values match we have found an equilibrium point.

The advantages of this technique is that it can find all points when an equilibrium is reached.

And when can that happen? Only if we allow negative numbers, or in certain rather boring cases zeros. I make note that it doesn’t seem that anyone else much addressed the idea that multiple equilibria could even exist. Most solutions stop at the first example, but my hash example as written will overwrite and find the last example.

I don’t see this as too much a problem, really, as the challenge definition isn’t very detailed. But no, negative numbers are very much not excluded, so multiple equilibria can certainly arise, as Bruce demonstrates.

To get his results Bruce used the reductions function from List::Util, which applies a function block successively to each item in an input list, returning a list of the state of an accumulator at each step. This creates a new list as a running total, like

(a, a+b, a+b+c, … )

so for the list

(1, 3, 5, 7, 9)

we create the new list

(1, 4, 9, 16, 25)

To compute the second list however, working downward from the other side, we need to get more creative. We perform the same reduction operation, only starting with the input reversed, so we’re adding elements from the end and going towards the start. To compare the two lists, though, we need them aligned so we need to reverse the result again.

For the example above, we end up with

(25, 24, 21, 16, 9)

and as you can see at index [3] we have the value 16 in both, which is the equilibrium point as

1 + 3 + 5 = 9

Bruce’s function, eq_index(), returns a list of all indices at valid equilibrium points.

    use List::Util   qw<sum0 reductions>;

    sub eq_index (@list) {
        my @x =         reductions { $a + $b }         @list;
        my @y = reverse reductions { $a + $b } reverse @list;
        return grep { $x[$_] == $y[$_] } keys @x;
    }

Olivier Delouya

Finally, Olivier gives us a unusual mix of a program, blurring the boundaries of Perl and the shell. Invoked in the shell a function is defined in that language in Perl. Then the Perl interpreter is called to run instances of the function as one-liners.

What a profoundly weird way to go about this. But he must know that.

    #!/bin/bash

    equilibrium='@A=eval($a); $N=scalar(@A); die "Not enough element" if($N < 3); foreach my $i (1..$N-1) { $left=$right=0; map {$left += $_} @A[0..$i-1]; map {$right += $_} @A[$i+1..$N]; die "equilibrium index is $i" if($left == $right); }; print "no equilibrium index"; '

    perl -se "$equilibrium" -- -a="(1,2,3,2,1)"

    perl -se "$equilibrium" -- -a="(1,2,3,2,10)"

    perl -se "$equilibrium" -- -a="(1,2,7,9,10)"

    perl -se "$equilibrium" -- -a="(1,2)"

Blogs and Additional Submissions in Guest Languages for Task 2:

Adam Russell

  additional languages: Prolog

  blog writeup: Four is Equilibrium — Perl — RabbitFarm

  blog writeup: Four is Equilibrium — Prolog — RabbitFarm

Ali Moradi

  additional languages: C++, Lua, Pascal, Raku

Arne Sommer

  additional languages: Raku

  blog writeup: The Magic Equilibrium with Raku and Perl

Dave Jacoby

  blog writeup: Does That Make Friendship Equal Four?: Weekly Challenge #160 | Committed to Memory

Flavio Poletti

  additional languages: Raku

  blog writeup: PWC160 - Four Is Magic - ETOOBUSY

  blog writeup: PWC160 - Equilibrium Index - ETOOBUSY

Jaldhar H. Vyas

  additional languages: Raku

  blog writeup: Perl Weekly Challenge: Week 160

James Smith

  blog writeup: Perl Weekly Challenge #160

Lubos Kolouch

  additional languages: Python

Peter Campbell Smith

  blog writeup: Four is magic and Equilibrium Indices

PokGoPun

  additional languages: Go

Roger Bell_West

  additional languages: Javascript, Kotlin, Lua, Postscript, Python, Raku, Ruby, Rust

  blog writeup: RogerBW’s Blog: The Weekly Challenge 160: Balancing Four is Magic



 

 

 

 

_________ THE BLOG PAGES _________


That’s it for me this week, people! Warped by the rain, driven by the snow, resolute and unbroken by the torrential influx, by some miracle I somehow continue to maintain my bearings.

Looking forward to next wave, the perfect wave, I am: your humble servant.

But if Your Unquenchable THIRST for KNOWLEDGE is not SLAKED,

then RUN (dont walk!) to the WATERING HOLE

and FOLLOW these BLOG LINKS:

( …don’t think, trust your training, you’re in the zone, just do it … )

Adam Russell

Alexander Pankoff

Andinus

Arne Sommer

Bruce Gray

Colin Crain

Dave Jacoby

Flavio Poletti

Jaldhar H. Vyas

James Smith

Laurent Rosenfeld

Luca Ferrari

Peter Campbell Smith

Roger Bell_West

Simon Green

W. Luis Mochan

SO WHAT DO YOU THINK ?

If you have any suggestions or ideas then please do share with us.

Contact with me