James Curtis-Smith

Here are solutions to this weeks challenges from the Perl Weekly Challenge.

You can find my full code on Github

Challenge 1

You are given string $S containing alphabets A..Z only and a number $N. Write a script to encrypt the given string $S using Caesar Cipher with left shift of size $N.

Solution

sub caesar {
  return $_[0] =~ s{([A-Z])}{chr 65+(-65-$_[1]+ord$1)%26}regex;
}

This is a simple one liner - but has some neat features - other than using "regex" for the switches, although most are important...

• r - return value rather than substitute in original string
• e - evaluate replace rather than use string
• g - repeat over all characters
• x - not needed (comments in match) - but looks good!

In the evaled replacement code - there is some clever ordering of values to reduce the need for brackets...

• 65 is at the front of the chr block as needing the bracket for the %26 - it would be evaluated as the bracket wrapping the parameters for chr .. so would evaluate as:
  • ( chr(-65-$_[1]+ord$1) ) %26+65
• -65 is at the start of the bracket - to allow us to not use brackets for the ord - if it was at the beginning you would need ord as it would evaluate ord $1 - 65 - $_[1] as
  • ord( $1 - 65 - $_[1] )

Binary Substrings

You are given a binary string $B and an integer $S.

Write a script to split the binary string $B of size $S and then find the minimum number of flips required to make it all the same.

Solution

As the first problem was a good one for applying "Golfing" techniques to it - I thought I would play along and try the second one....

sub min_flips {
  return [
    local $/ = length($_[0]),
    local $\ = $/ / $_[1],
    map { $/ = $_ < $/ ? $_ : $/     }
    map { ( $_[0] ^ $_ ) =~ y/\1/\1/ }
    map { $_ x $\                    }
    map { substr $_[0], $_ * $_[1], $_[1] }
    0 .. $\ - 1
  ]->[ -1 ];
}

Notes

This was designed to serve as an example of perl idioms that other programmers may find difficult to understand - and so I tried to put as many of them in a relatively short function.... a discussion thread on the Perl programmers facebook group.

• One statement functions are a "lovely" perl concept - even if they can get a bit difficult to read....
• In perl there are special variables which give you information about the current process, or allow us to alter the functionality. To avoid creating variables I use these in the function. If you change these you can change how the code works - but here we use "local" copies - so that when we return from the function (block) they revert to their normal values - so we don't introduce any side-effects of our code
  • $/ - normally the input record separator - we will use for the minimum value
  • $\ - normally the output record separator - we will use for the number of chunks
• @_ - the list of parameters passed to a function - in this case $_[0] is the string and $_[1] is the block size
• Chained maps - we can simplify the maps by chaining them together, here we break it down into 5 separate stages - remember we have to read the code backwards. So we will look at the separate blocks of code working upwards...
  • 0..$\-1 - this returns a list of indices for the substrings
  • map { $_*$_[1] } - this converts those indices into start locations ($_ is the value of the element of variable that the map function is processing
  • map { substr$_[0],$_,$_[1] } - this grabs the substring for the nth block - but keeps the start location as we will need it later...
  • map { $_ x $\ } - this maps the string we just have to have the same length as our original string - by performing a perl "string multiplication" x
  • map { ( $_[0] ^ $_ ) =~ y/\1/\1/ } - count the flips. Two perlisms here - we can use xor operator ^ on strings to xor the binary values of each character. y/../../ - the translate operator returns the number of substitutions it makes - in this case we are substituting the ASCII character with decimal value of "1"... when the strings are same the byte value of the xor is 0 or "\0" and when they are different the value is 1 or "\1"
  • map { $/ = $_ < $/ ? $_ : $/ } - finally we keep the running total of the minimum value - We initialize $/ to the length of the string (as the value must be less than or equal to that) we could have used the List::Util function min - but I try and avoid using external modules if I can...
• The list is the running minimums so we have to get the last element off the list - we do this with by wrapping the list in [ ] to make it an arrayref and then taking its last value [{list}]->[-1] perl indexes the last element as -1.
• And we return this value (implicit return)
• As the statement ends before the closing curly brace we don't need a semicolon {we aren't really sticking to PBP here anyway...!}

Just for the golf connoisseurs amongst you - here is the solution written as a single line {each line is 60 characters long}

sub mf_3{[local$/=length$_[0],local$\=$//$_[1],map{$/=$_<$/?

$_:$/}map{($_[0]^$_)=~y/\1/\1/}map{$_ x$\}map{substr$_[0],$_

,$_[1]}map{$_*$_[1]}0..$\-1]->[-1]}

In fact we can shorten it further by combining some of the maps - but the code is not as easy to understand - as multiple steps are taken at once..., for golf aficionados - here is the code reduced (I think to a minimum unless you can prove otherwise).... each line is just 40 characters long....

sub mf{(($a,$b)=@_,$/=length$a,$\=$//$b,
map{$/=$_<$/?$_:$/}map{($a^substr($a,$_*
$b,$b)x$\)=~y/\1//}0..$\-1)[-1]}

This just as 104 symbols between the two curly braces

• I have introduced potential side effects by removing the "local"s from the definitions of $/ & $\)
• I copy @_ into the special variables ($a & $b) which don't need "my"ing even under use strict - they are used in sort comparisons.
• The y/\1/\1/ is just convention - you can just drop the \1 in the replace to make the code shorter.