James Curtis-Smith

We are finally here - we have hit week 100 of Manwar's Perl Weekly Challenges, and here are solutions to this weeks challenges from the Perl Weekly Challenge.

You can find my full code on Github

Task 1: Fun time

You are given a time (12 hour / 24 hour). Write a script to convert the given time from 12 hour format to 24 hour format and vice versa. Ideally we expect a one-liner.

Example 1: Input: 05:15 pm or 05:15pm -> Output: 17:15
Example 2: Input: 19:15               -> Output: 07:15 pm or 07:15pm

The solution

Firstly I have to thank Manwar for asking for a one line solution as this is my modus operandi.... So we will look at this and see how we can get a simple yet compact solution... well here goes.... {code is 110 bytes, within the functions curly braces there are just 102 bytes of code}

sub ft{pop=~s/(.+)(:..)\s*(.m|)/sprintf'%02d%s%s',
($1%12||(12*!$3))+12*('pm'eq$3),$2,$3?'':$1<12?'am':'pm'/re}

Let me try and explain the logic in this.

Firstly what is the smallest regex we can use to distinguish between 12 hour and 24 hour clock times (assuming that the value is either)

First pass we try /\A(\d\d):(\d\d)\s*([ap]m)?\Z/.

How can we simplify this?

• We don't need to anchor the ends so we can remove the \A and \Z
• ** /(\d\d):(\d\d)\s*([ap]m)?/
• We don't need to know that the numbers are numbers just they are of the form something-something-:-something-something, and we only need to know that we have something-m at the end if 12 hour clock
• ** /(.+):(..)\s*([ap]m)?/
• For later it would be useful if we captured the : with the minutes saves us a byte in the sprintf.
• ** /(.+)(:..)\s*([ap]m)?/
• Finally again for later we want don't want to check whether or not $3 exists we can re-write (.m)? as (.m|) to achieve this.
• ** /(.+)(:..)\s*(.m|)/

So we end up with: /(.+)(:..)\s*(.m|)/

Now for the replace logic.

• For the hours: If 24 hour clock we reduce the number modulo 12 (but if it is 0 we use 12 instead)
  We user "||" for this as if the first value is 0 we use the 2nd values...
  $1%12||(12*!$3)
• For the hours: If 12 hour clock we reduce the number module 12 (and add 12 if it is pm)
  ($1%12)+12*('pm'eq$3)
  We use a yoda condition to shorten the perl by putting the constant before the eq and the variable after we don't need a space between the variable name and the eq.
• For the minutes: Minutes stay the same
• For the suffix: If 12 hour clock we do nothing
• For the suffix: If < 12 we return am o/w we return pm

Other things

• We use s///er to both evaluate a function based on the matches and return the replaced string
• One minor thing - rather than using shift to get the parameter passed we use pop as this is two bytes shorter

sub fun_time {
  return pop =~
    ## Note the nasty hack we pop rather than shift - that saves 2 bytes
    ## in our golfdom....
    s/
        ## Split into 3 parts, $1 - hours, $2 - minutes & $3 - am/pm
      (.+) (:..) \s* ( .m | )
        ## We assume all strings are valid - so we don't have to anchor
        ## at both ends or worry what the 12hr clock sufficies are
        ## am/pm and .m is shorter than [ap]m
        ##
        ## We assume that the time will always have a : followed
        ## 2 digits...
        ##
        ## Note if we right (.m)? the 3rd capture variable $3 is
        ## sometimes undefined - better is to use (.m|) which
        ## matches the same way but $3 is now an empty string not
        ## undefined when we have a 24 hour clock time
    /
      sprintf '%02d%s%s',
        ( $1 % 12 || ( 12 * ! $3 ) ) + 12 * ( 'pm' eq $3 ),
          ## Get hour modulo 12..
          ## From 24hr to 12hr clock we need to convert 00:?? to 12:??
          ## From 12hr to 24hr clock it is pm we then need to add 12...
          ## Note we use the "yoda condition" for the equals
          ##   'pm'eq$3
          ## as this is a byte shorter than the more usual way of
          ## writing inequalitys
          ##   $3 eq'pm'
          ## as we don't need a space between the $3 & the eq...
        $2,
          ## The minutes is the easy bit just copy..
        $3 ? '' : $1 < 12 ? 'am' : 'pm'
          ## If we are converting from 12hr clock the third string is
          ## empty - if not and the time is <12 we return am o/w  pm
    /rex;
}

Some notes on golfing

1. Doing everything inside the regex using /re modifiers... /e most people will know is "execute", /r is return the replacement - not replace in place.
2. Normally we would use shift to get the parameter of the subroutine, but in this case we know we have one parameter so we can use pop instead - saves 2 characters!
3. The regex isn't specific - we aren't really using it to match we are using it to extract characters from the parameter
4. !$var - returns 1 if the $var is ''/undef/0, 0 otherwise - in this case if we are converting to 12hr clock we don't tend to write 0:01am but 12:01am so we need to add 12 if the first number is 0 & match var $3 is empty...
5. Talking of match var 3 most people would write (.m|) as (.m)? but if you are running under use strict/use warnings this throws an undefined variable warning... as $3 is undefined if you don't match - on the other hand (.m|) returns a match or the empty string!
6. "'pm'eq$3" - a "yoda condition" - use it we do - to save a byte. If we wrote it the way you would expect to use "$3 eq 'pm'" you have to have a space between the "3" and the "eq" by writing it as a yoda condition you don't as you don't need a space between "'" and "eq" and "eq" and "$"
7. We could use another ternary here as well ('pm'eq$3?12:0) but that would be longer... but we know the match returns 1 (true) or 0 (false) so we can just multiply...

There will some more "golf" tricks in task 2.... Just a little note - if you are golfing then it is good to use TDD (Test Driven Design) and define tests so that you can make sure that the little tweaks - the removal of a symbol here or the tweak of the way a comparison is done - doesn't change the result. I use Test::More to define the tests.

Task 2: Triangle sum

You are given triangle array. Write a script to find the minimum path sum from top to bottom. When you are on index i on the current row then you may move to either index i or index i + 1 on the next row.

Example 1:
Input: Triangle = [ [1], [2,4], [6,4,9], [5,1,7,2] ]
Output: 8

Explanation: The given triangle

            1

           2 4

          6 4 9

         5 1 7 2

The minimum path sum from top to bottom:  1 + 2 + 4 + 1 = 8

             [1]

           [2]  4

           6 [4] 9

          5 [1] 7 2

Example 2:

Input: Triangle = [ [3], [3,1], [5,2,3], [4,3,1,3] ]

Output: 7

Explanation: The given triangle

            3

           3 1

          5 2 3

         4 3 1 3

The minimum path sum from top to bottom: 3 + 1 + 2 + 1 = 7

             [3]

            3  [1]

           5 [2] 3

          4 3 [1] 3

The solution

There are literally two directions you can go with this problem, quite literally up and down.

The first thought is to go down - there is a relatively simple recursive solution and another which tries all paths - but these are effectively O(n2^n) complexity.

Then we can look at going up... We take off the last row of the triangle and merge it into the line before - adding to it the minimum of it's two "children". Repeating until we only have one cell. this is O(n^2) complexity.

Even for the examples here there is a considerable (4 fold) gain over the descent methods.

sub triangle_sum {
  ## Make a deep copy as code is destructive
  my @tri = map { @{$_} } @_;
  while(@tri>1) {
      ## Strip off base of triangle...
    my $b = pop @tri;
      ## Update new last line by adding smallest of it's "children"
    $tri[-1][$_] += $b->[$b->[$_]<$b->[$_+1]?$_:$_+1] for 0..@tri-1;
  }
  return $tri[0][0];
}

Golfing the script

Can we write this with less lines... yes - we can 'golf' this one - but as we weren't asked to - I thought I would add this as an aside...

To make this a 1 liner we will need a couple of "golf" tricks..

1. We need to convert the inner for to a map
2. We need remove the separate $b = pop @tri - we can move it into the while clause.
3. Here is a cool Perl fact - $a & $b can both be used with or without "my" in code even under use stricts - this is because they are "local" special variables - the two comparison variables used in sort blocks.

The code becomes:

sub triangle_sum_1point5_liner {
  @_ = map { @{$_} } @_;
  @{$_[-1]} = map {
    $_[-1][$_] + $b->[ $b->[$_] < $b->[$_+1] ? $_ : $_+1 ]
  } 0..@_-1 while @{$b=pop @_}>1;
  $b->[0];
}

Note as we do the pop in the while clause we need to use $b rather than $_[0] (which no longer exists as we've already popped it off)

Aside 2 - Displaying the path

Although not asked it would be good to see if we could see the path through the triangle...

This is just really an extension of what we did in the first case - but as well as keeping the lowest total for each cell - we also keep a list of the nodes which generated that minimal sum.

As the code to get the route is destructive we first have to take a deep copy of the triangle passed in. The triangle can nicely be drawn in a single statement, by nested maps (note we do have to copy the outer loop $_ into another variable - again we use the local special variables $a... We set it in the first part of the map array - in such a way it is hidden from the print.

Rather than concatenate - we just allow print to automatically concatenate all the strings. But there is a gotcha here - as we wrap the map in parentheses and print is a function, print will only display the contents of the parentheses, and ignore anything that follows.. To avoid this we need to make sure that the first symbol after the print is not an open parenthesis. To avoid this we start with the crucial '',. Other ways of doing this is, for a scalar is either q(). or 0+ depending if you are returning a string or a number...

sub display_sum {
  my @tri = map{ [@{$_}] } @_; ## Deep copy the triangle as the
                               ## search is destructive

  my @route; ## For each node in the "current" bottom row, the route

             ## is the list of indices of the child nodes that make

             ## up the "optimal" path

             ## We use the implicit my on $b

 

  while(@{$b = pop @tri}>1) {

    ($tri[-1][$_],$route[$_]) = $b->[$_]<$b->[$_+1]

      ? ( $tri[-1][$_] + $b->[$_],   [$_,  @{$route[$_  ]||[]}] )

      : ( $tri[-1][$_] + $b->[$_+1], [$_+1,@{$route[$_+1]||[]}] )

    foreach 0..@tri-1;

  }

  @route = (0,@{$route[0]}); ## We need to add the top node index

                             ## (always 0), at the same time we can

                             ##  just take the first (only)

                             ## path out of the 2d route matrix;

  print ## Assume all cell numbers are single digits...

    '',

    ( map {

      '  ' x (@_-($a=$_)), ## use implicit my on $a;

      ( map {

        sprintf $route[$a]==$_ ? '[%d] ': ' %d  ' , $_[$a][$_]

      } 0..$a ),

      "\n"

    } 0..@_-1 ),

    "\nMinimum path: ",(join ' -> ', map {

       $_[$_][$route[$_]] } 0..@_-1 ),' ; Total: ',$b->[0],"\n\n";

}

Here is the output from the examples:

        [1]
      [2]  4
     6  [4]  9
   5  [1]  7   2

Minimum path: 1 -> 2 -> 4 -> 1 ; Total: 8

        [3]

       3  [1]

     5  [2]  3

   4   3  [1]  3

Minimum path: 3 -> 1 -> 2 -> 1 ; Total: 7

        [3]

      [3]  1

    [3]  8   9

   4  [3]  1   3

Minimum path: 3 -> 3 -> 3 -> 3 ; Total: 12

The final one demonstrates that the minimal route does not always take the smallest value from each row. In the 2nd & 4th rows the chosen node is not the smallest - as to choose that you would also mean you would have to include the large 8 or 9 from the 3rd row.