## Perl weekly challenge 97

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 \$_ =~ s{([A-Z])}{chr 65+(-65-\$_+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-\$_+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 - \$_ as
• ord( \$1 - 65 - \$_ )

### 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(\$_),
local \$\ = \$/ / \$_,
map { \$/ = \$_ < \$/ ? \$_ : \$/     }
map { ( \$_ ^ \$_ ) =~ y/\1/\1/ }
map { \$_ x \$\                    }
map { substr \$_, \$_ * \$_, \$_ }
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 \$_ is the string and \$_ 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 { \$_*\$_ } - this converts those indices into start locations (\$_ is the value of the element of variable that the map function is processing
• map { substr\$_,\$_,\$_ } - 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 { ( \$_ ^ \$_ ) =~ 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\$_,local\$\=\$//\$_,map{\$/=\$_<\$/?
\$_:\$/}map{(\$_^\$_)=~y/\1/\1/}map{\$_ x\$\}map{substr\$_,\$_
,\$_}map{\$_*\$_}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. Perl developer for nearly 30 years now, mainly in maintenance scripts and web pages, using mod_perl. I also code a lot in PHP (20+yrs), and also extensive experience in HTML (27+yrs), Javascript(25+yrs), CSS (24+yrs) and SASS.