PWC 215

I have attempted the Perl Weekly Challenge after a hiatus of several weeks, as I was too busy at work. Still busy, so I have just attempted the current challenge in Perl 5. Like I like to do, I have restricted myself to perl 4 syntax as specified in the first edition of Programming perl.

Update and disclaimer: These programs will not work on Perl 4 as I discovered later when I found and installed a Perl 4.019 executable. For one thing, the ability to assign a subroutine to a locally scoped typeglob was not available in Perl 4.

Challenge 1 (Odd one out)

In this challenge, we are given a list of alphabetic strings, and asked to return the list without the strings in which the characters are not sorted (I assume that this means sorted in lexical ascending order). We are also asked to print the number of strings that were removed (i.e., that were not sorted). 

I use a subroutine &odd_one_out(@words) with a nested helper sub-sub-routine to check if a string is sorted. Here is the helper sub-sub routine (not as compact as it could be, but this is easier to read):

 local *is_sorted = sub { #not idiomatic but I prefer readable

    local ($string)=@_;

    local $chk=join('',sort {$a cmp $b} split(//,$string));

    return ($string eq $chk);

  };

Here is the core of &odd_one_out:

  for $word (@words) {

    if (&is_sorted($word)) {

        push @retval, $word;

    } 

    else {

        $ctr++;

    }

  }

  print $ctr;

  return @retval;

Challenge 2 (Number placement)

In this challenge, we are given a list of single-digit numbers restricted to 0 or 1, as well as a counter say $count. We are asked to find if there are at least $count 0's in the list that can be replaced with a 1, where the rule is that a 0 can only be replaced by a 1 if it does not have a 1 on either side of it prior to any replacement. 

As with Challenge 1, I use a subroutine with a nested helper sub-subroutine that checks if a digit has an adjacent 1. Here is the helper sub-subroutine (it takes the position of the digit in the original list as input):

local *has_1_neighbor = sub {

        local ($indx)=@_;

        

        ( ($indx > 0) && ($numbers[$indx-1] =~ /^1$/) )

        || 

        ( ($indx < @numbers-1) && ($numbers[$indx+1] =~ /^1$/ ));

    };   

Here is the core of the &number_placement subroutine:

   local ($indx,$ctr);

    $ctr=0;

    

    for $indx (0 .. @numbers-1) {

        ( ($numbers[$indx] =~ /^0$/) && (!(&has_1_neighbor($indx))) )

        && ($ctr++);

        

        last if ($ctr >= $count); 

    }

    

    ($ctr >= $count) ? 1 : 0; #-- the last line or return value