PWC 215

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.

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




Comments

Post a Comment

Popular posts from this blog

PWC 183

PWC 183 Challenge 1 (Unique array) Given an array of arrays, we are asked to remove any duplicate elements (arrays) and return the sub-array with only unique elements. Thus, given ([1,2],[3,4],[5,6],[1,2]), the script should return ([1,2],[3,4],[5,6]). Perl 5 In Perl 5, PDL offers an immediate solution via the uniqvec method. One just reads the list into a piddle: $list = pdl ([1,2],[3,4],[5,6],[1,2]); and then calls uniqvec on it: $list->uniqvec  The uniqvec method still works if the piddle has rows of unequal lengths, as in ([1,2],[3,4],[5,6,7],[1,2]). In this case, it pads the shorter rows with zeroes in the output: [     [1,2,0]     [3,4,0]     [5,6,7] ] I have presented my Perl 5 solution as a perldl executable command history. Here is my perldl script. Julia Julia has something similar to uniqvec in the unique function. println(unique(arry)) Just like PDL, it handles rows of unequal lengths. It does not pad the shorter rows with zeroes. println(unique([[1,2],[3,4],[5,6,7
Read more

PWC 182

PWC 182 Challenge 1 (max index) Given a list of numbers, we are asked to give the index of the first occurrence of the biggest number in the list. This is easy to do via one-liners in all three languages. Here is my Raku one-liner raku -e ' say (0 .. @*ARGS.elems-1).grep({@*ARGS[$_] == @*ARGS.max}) ' 5 2 9 1 7 6 Here is my Perl 5 one-liner perl -MList::Util= ' max ' -E ' for (0 .. $#ARGV) {if ($ARGV[$_]==max(@ARGV)) {say;}} ' 5 2 9 1 7 6         It would be more compact with a trailing if as in say if (.. . ) , but I think that's just a cosmetic improvement.  I'll let the uglier syntax above stand. Julia has the convenient argmax function which returns the index of the maximum item. Here is my Julia one-liner julia -e 'println(argmax(ARGS)-1)' 5 2 9 1 7 6 My solutions differ slightly from the specification in that they return the indices of every occurrence of the biggest item, not just the first
Read more

PWC 177

PWC 177 Challenge 1 (Damm Algorithm) This challenge requires implementing the Damm algorithm which uses an extra check digit to catch errors in entering digits in a numeric code, especially the common transposition errors. In terms of programming, this is a simple matter of setting up a lookup table and then looking it up. I implement two subroutines, closely following the howto in the wikipedia page. "get_check_digit" calculates a check digit for a given number, and "validate" checks if a number is correct based on the extended number including a check digit. In Perl 5 and Raku, I give in to dark primitivist urges and set up the lookup table as a flat list of strings. In Julia, it is easy to implement it as a Matlab-like matrix. This algorithm is useful enough to have its own CPAN module: Algorithm::Damm Here is my Perl 5 script. Here is my Raku script. Here is my Julia script. Challenge 2 (Palindromic Prime Cyclops) This challenge requires looking for the first 2
Read more