diff options
| author | drbaggy <js5@sanger.ac.uk> | 2021-01-30 06:11:44 +0000 |
|---|---|---|
| committer | drbaggy <js5@sanger.ac.uk> | 2021-01-30 06:11:44 +0000 |
| commit | 4df65a00eeb4aab537692bbc5b19e7d88570865b (patch) | |
| tree | 0a0c1f0eae42060d0098d7fcd3dab2320c38cf2f | |
| parent | 9d52bdc26df4eb73970c40d7d1b90c2aa86fc0e3 (diff) | |
| download | perlweeklychallenge-club-4df65a00eeb4aab537692bbc5b19e7d88570865b.tar.gz perlweeklychallenge-club-4df65a00eeb4aab537692bbc5b19e7d88570865b.tar.bz2 perlweeklychallenge-club-4df65a00eeb4aab537692bbc5b19e7d88570865b.zip | |
changed comments added blog links
| -rw-r--r-- | challenge-096/james-smith/perl/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-097/james-smith/perl/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-097/james-smith/perl/ch-1.pl | 25 | ||||
| -rw-r--r-- | challenge-097/james-smith/perl/ch-2.pl | 150 |
4 files changed, 128 insertions, 49 deletions
diff --git a/challenge-096/james-smith/perl/blog.txt b/challenge-096/james-smith/perl/blog.txt new file mode 100644 index 0000000000..04c32fcd59 --- /dev/null +++ b/challenge-096/james-smith/perl/blog.txt @@ -0,0 +1 @@ +http://blogs.perl.org/users/james_curtis-smith/2021/01/perl-weekly-challenge-96.html diff --git a/challenge-097/james-smith/perl/blog.txt b/challenge-097/james-smith/perl/blog.txt new file mode 100644 index 0000000000..5b18ca0d4b --- /dev/null +++ b/challenge-097/james-smith/perl/blog.txt @@ -0,0 +1 @@ +http://blogs.perl.org/users/james_curtis-smith/2021/01/perl-weekly-challenge-97.html diff --git a/challenge-097/james-smith/perl/ch-1.pl b/challenge-097/james-smith/perl/ch-1.pl index d6dfd58a56..c0a6fae0bc 100644 --- a/challenge-097/james-smith/perl/ch-1.pl +++ b/challenge-097/james-smith/perl/ch-1.pl @@ -6,12 +6,31 @@ use warnings; use feature qw(say); use Test::More; -is( caesar('ABCDEFGHIJKLMNOPQRSTUVWXYZ',3), 'XYZABCDEFGHIJKLMNOPQRSTUVW' ); -is( caesar('THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG',3), 'QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD' ); +is( caesar('ABCDEFGHIJKLMNOPQRSTUVWXYZ',3), + 'XYZABCDEFGHIJKLMNOPQRSTUVW' ); +is( caesar('THE QUICK BROWN FOX JUMPS OVER THE LAZY DOG',3), + 'QEB NRFZH YOLTK CLU GRJMP LSBO QEB IXWV ALD' ); done_testing(); sub caesar { - return join q(), map { m{[A-Z]} ? chr 65+(ord($_)-65-$_[1])%26 : $_ } split m{}, $_[0]; + ## Use regex replace + ## 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! + + return $_[0] =~ s{([A-Z])}{chr 65+(-65-$_[1]+ord$1)%26}regex; + + ## Note about optimization of brackets in the eval function... + ## + ## 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 ..{chr(...)+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 - ...) } diff --git a/challenge-097/james-smith/perl/ch-2.pl b/challenge-097/james-smith/perl/ch-2.pl index 81f89d7e4f..72ed38f422 100644 --- a/challenge-097/james-smith/perl/ch-2.pl +++ b/challenge-097/james-smith/perl/ch-2.pl @@ -6,63 +6,121 @@ use warnings; use feature qw(say); use Test::More; -is( min_flips('101101',3), 0 ); is( min_flips('101100101',3), 1 ); is( min_flips('10110111', 4), 2 ); is( min_flips('100101100',3), 1 ); is( min_flips('101100100100101',3), 2 ); +is( min_flips('101101',3), 0 ); is( min_flips('0000000100100011010001010110011110001001101010111100110111101111',4), 32 ); done_testing(); +## 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.... +## Notes +## +## This was to use this to serve as an example of perl idioms +## that other programmers may find it difficult to understand +## - and so I tried to put as many of them in 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... Here we see a map returning an +## arrayref - in subsequent requests - $_->[0] is the start +## offset of the block and $_->[1] is the property we are +## munging in this case the substring. +## +## You have to be careful here as $_[0] and $_->[0] look similar +## but are different +## +## * map { [ $_->[0], $_->[1] 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], ( $_[0] ^ $_->[1] ) =~ y/\x01/\x01/ ] } - +## count the flips. Two perlisms here - we can use xor operator +## ^ on strings to xor the binary values of each string. +## y/../../ - the translate operator returns the number of +## substitutions it makes - in this case we are substituting +## the ASCII character with decimal a hex value of "01"... when +## the strings are same the byte value of the xor is 0 or "\x00" +## and when they are different the value is 1 or "\x01" +## +## * map { $/ = !$_->[0] || $_->[1] < $/ ? $_->[1] : $/ } - finally +## we keep the running total of the minimum value - Now this is +## why we kept the start of the block around - as the first +## time through the loop we have to define the minimum - if +## $_->[0] is zero then we assign $_->[1] to $/ - 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. + sub min_flips { ## Golf mode on... - ## - ## This was to use this to serve as an example of perl idioms that other programmers - ## may find it difficult to understand - and so I tried to put as many of them in relatively - ## short function.... - ## - ## One statement functions are a lovely perl concept - even if they can get a bit difficult - ## to read.... - ## + return[ + local$/, + local$\=length($_[0])/$_[1], + map{$/=!$_->[0]||$_->[1]<$/?$_->[1]:$/} + map{[$_->[0],($_[0]^$_->[1])=~y/\x01/\x01/]} + map{[$_->[0],$_->[1]x$\]} + map{[$_,substr$_[0],$_,$_[1]]} + map{$_*$_[1]} + 0..$\-1 + ]->[-1]; +} + +## With the white space back in.. - local $/; +sub min_flips_more_readable { return [ - map { - local $\ = ( $_[0] ^ (substr$_[0],$_,$_[1]) x (length($_[0])/$_[1]) ) =~ tr/\x01/\x01/, - $/ = (!$_ || ($\ < $/)) ? $\ : $/ - } - map { $_*$_[1] } - 0 .. ( length($_[0])/$_[1] - 1 ) + local $/, + local $\= length($_[0]) / $_[1], + + map { $/ = !$_->[0] || $_->[1] < $/ ? $_->[1] : $/ } + map { [ $_->[0], ( $_[0] ^ $_->[1] ) =~ y/\x01/\x01/ ] } + map { [ $_->[0], $_->[1] x $\ ] } + map { [ $_, substr $_[0], $_, $_[1] ] } + map { $_ * $_[1] } + 0 .. $\ - 1 ]->[-1]; - ## We could use variales here - but playing with localised special variables is fun! - ## $/ <- minimum value - ## $\ <- value for given chunk.... - ## - ## The inner map + range combination returns a list of ids of the form 0, $n, 2*$n until the - ## end of the array, we use this to chunk the array up for comparison - ## - ## Inside the end map - we first string "xor" the string with the repeated chunk of the array. - ## so e.g. for the first example this becomes: - ## '101100101' ^ '101'.'101'.'101' - ## '101100101' ^ '100'.'100'.'100' - ## '101100101' ^ '101'.'101'.'101' - ## if the symbols match you get a value \x00, when they don't match you get value \x01 - ## so we then count the \x01's using tr... and store in $\ - ## - ## Next if it is the first chunk OR the value of $\ is less than the current min ($/) - ## We set $/ to $\ otherwise we leave it as $/ - ## - ## The resulting array consists of the value for the node and the running minimum in the examples - ## - ## for ex 1: it is [0,0,0,0] - ## for ex 2: it is [1,1,2,1,1,1] - ## for ex 3: it is [1,1,1,1] - ## for ex 4: it is [2,2,2,2] - ## for ex 5: it is [2,2,1,1,1,1] - ## - ## We need the last value of this so we wrap the list into an array ref and take the last element - ## - ## [ list... ]->[-1]; } - |
