diff options
| author | Mohammad S Anwar <Mohammad.Anwar@yahoo.com> | 2021-04-11 01:44:24 +0100 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2021-04-11 01:44:24 +0100 |
| commit | 690add5a21cd2b7cc0452d88a25f64900d7c619f (patch) | |
| tree | 3ae57cad90f14771d18a3ccfddd904b7b8aa8059 | |
| parent | 0eb9b07380a5109e844229d71368605077a2109f (diff) | |
| parent | 8a8af310d0ce24f6269b2e61d83206d6b8f089da (diff) | |
| download | perlweeklychallenge-club-690add5a21cd2b7cc0452d88a25f64900d7c619f.tar.gz perlweeklychallenge-club-690add5a21cd2b7cc0452d88a25f64900d7c619f.tar.bz2 perlweeklychallenge-club-690add5a21cd2b7cc0452d88a25f64900d7c619f.zip | |
Merge pull request #3852 from drbaggy/master
docs...
| -rw-r--r-- | challenge-107/james-smith/README.md | 161 | ||||
| -rw-r--r-- | challenge-107/james-smith/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-107/james-smith/perl/ch-1.pl | 24 | ||||
| -rw-r--r-- | challenge-107/james-smith/perl/ch-2.pl | 13 |
4 files changed, 192 insertions, 7 deletions
diff --git a/challenge-107/james-smith/README.md b/challenge-107/james-smith/README.md index 2a23e4ef37..ad96ffed8f 100644 --- a/challenge-107/james-smith/README.md +++ b/challenge-107/james-smith/README.md @@ -1,2 +1,161 @@ -Solutions by James Smith. +# Solution challenge 1 - Generate the first 3 self-descriptive numbers + +To describe a number we write down the number of 0s, 1s, 2s, 3s, etc + +A self-descriptive number is one of length `n` such that in base `n` the +description above is the number itself. + +Generating self descriptive numbers can be split between the case where n >= 7 and n < 7... +As we are asked for the first 3 these all exist in the case where n<7.... + +For n >= 7 the self-descriptive numbers are of the form + `n-4`, `21`, `0` {n-7 times}, `1000`; + +In our solution we loop through numbers starting 1 to see if they are self descriptive. + +To get the desciption of a number of length k, we loop from `0`..`(k-1)` counting the number of each digit in the string... +We can do this with a harcoded series of tr///s but if we want something dynamic we can write this as + +`@Q = m{($_)}g; $count = scalar @Q;` + +we can do this in one line by using @{[ ]} to convert to the list of matches to an array { subtle distinction here between +lists and arrays! } and counting it by getting the scalar of the array... + +The description is obtained by stitching those counts together... We can do this in the one-line join q(), map below.. +We just store it the list if the description and the number are the same.... + +``` +use strict; + +use warnings; +use feature qw(say); +use Test::More; +my ($c,@res) = 0; + +while( ++$c && @res<3 ) { + push @res, $c if $c == join q(), + map { scalar @{[ $c=~m{($_)}g ]} } 0 .. -1 + length $c; +} + +say "@res"; +``` + +We can reduce this further - by rewriting the inner if with using the `&&` trick. `&&` is evaluated lazily - so that if +the left hand side is false then the right hand side is not evaluated. + +So `if($x) { y() }` can be written as `$x && y()`; + +Similarly - `unless($x) { y() }` can be written as `$x || y()` and `if($x) { y() } else { z() }` can be written `$x ? y() : z()` + +This means we can make the statement inside the loop a single statement and postfix the while... + +``` +($c,@res) = 0; + +( $c == join q(), + map { scalar @{[ $c=~m{($_)}g ]} } + 0 .. -1 + length $c +) && push @res, $c while ++$c && @res<3; + +say "@res"; +``` + +Note we have to wrap the "condition" in brackets to force it to be evaluated before the && as o/w the line ends in +0 .. -1 + length( $x && push @res, $c); + +This is why we right the "yoda" looking -1 + length $c as if you write length $c - 1 this evaluates to length($c-1); + +I wouldn't do this in "normal" code as I think it can get confusing $x && f() is not obviously a piece of logic & +especially if f() has implicit side effects as here. + +If we don't want to capture the values - but just display the results - we can drop this into a perl 1-liner on the +command liner. + +``` +perl -E '($c-join"",map{0+@{[$c=~/($_)/g]}}0..-1+length$c)||++$n&&say$c while++$c&&$n<3' +``` + +or + +``` +perl -E '($c-join"",map{0+(@Q=$c=~/($_)/g)}0..-1+length$c)||++$n&&say$c while++$c&&$n<3' +``` + +You will notice we are using slightly different tricks here... (Mainly we can do these because we haven't enabled strict!! something +you rarely do in Perl 1-liners...) + + * We use -E (rather than -e) this enables more modern perl features - including usefully say! + + * We don't collect results - and we just keep a counter - this time we use `||` and `&&` in the "logic"... + + * We know ++$n is always going to be true (it starts of explicitly) and so we always run `say$c` if we get to the `++$n`.. + + * Note here - this is a place where it is important to choose `++$n` rather than the more common `$n++`, as the first evaluates to `0` the first time it is invoked - meaning we would skip the first answer... + + * We show a different trick to count the elements of the list. + + * We can use another trick other than the scalar `@{[ ]}` trick to convert the list into an array. we store it in an array variable which makes it we can then get the length of the array (we just ignore the array!) + + * As we are keeping the code short - we can replace the keyword scalar with a simple 0+ which forces the array to be converted into a scalar (and hence returns the length) + + * To gain another character as the equality is numeric we can rewrite if($a==$b) { f() } as ($a-$b)||f(). + + `$a-$b` is non-zero (true) if `$a!=$b` + + `$a-$b` is zero (false) if `$a==$b` + + So we rewrite + + `if( $a == $b ) { f() }` as `unless( $a - $b ) { f() }` + + which we know we mentioned we could rewrite as: + + `($a-$b) || f()` + + The brackets are important o/w this evaluates to: + + `$a-($b||f())` + + which isn't what we want... + +# Solution challenge 2 - Methods of a class + +When you import a class `%{class}::` contains a list of the methods for the class, +so we can just dump these (to make it deterministic) we sort first.... + +We can "import" the classes in two ways... use & require. + +By "require"ing the class - we don't get the additional import method added to the +class... (and so get the same list of fns as in the question) + +``` +say join "\n ",'Calc_Require:', sort keys %Calc_Require::; +say ''; +say join "\n ",'Calc_Use:', sort keys %Calc_Use::; +say ''; +``` + +Some of the entries in `%{class}::` are not methods so to filter these out we +can grep out those that `can` be called. `can` is a good function - especially if +you are writing "dispatchers", as you check if a given method exists. Even more +useful is `can` returns the code block so you can do: + +``` +my $fn = $obj->can('action_'.$command); +if( $fn ) { $obj->$fn( {'param'=>''} ); +``` + +The grep is as followe: + +``` +say join "\n ",'Calc_Require:', sort + grep {Calc_Require->can($_)} + keys %Calc_Require::; +say ''; +say join "\n ",'Calc_Use:', sort + grep {Calc_Use->can($_)} + keys %Calc_Use::; +say ''; +``` + diff --git a/challenge-107/james-smith/blog.txt b/challenge-107/james-smith/blog.txt new file mode 100644 index 0000000000..c4d7659ede --- /dev/null +++ b/challenge-107/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/blob/master/challenge-107/james-smith/README.md diff --git a/challenge-107/james-smith/perl/ch-1.pl b/challenge-107/james-smith/perl/ch-1.pl index fff417572c..dbec8818a5 100644 --- a/challenge-107/james-smith/perl/ch-1.pl +++ b/challenge-107/james-smith/perl/ch-1.pl @@ -88,10 +88,12 @@ perl -E '($c-join"",map{0+@{[$c=~/($_)/g]}}0..-1+length$c)||++$n&&say$c while++$ perl -E '($c-join"",map{0+(@Q=$c=~/($_)/g)}0..-1+length$c)||++$n&&say$c while++$c&&$n<3' =cut -## You will note so slightly different tricks here... -## (Mainly because we haven't enabled strict!!) +## You will notice we are using slightly different tricks here... +## (Mainly we can do these because we haven't enabled strict!! something +## you rarely do in Perl 1-liners...) ## -## * We use -E this enables more modern perl features - including say! +## * We use -E (rather than -e) this enables more modern perl features +## - including usefully say! ## ## * We don't collect results - and we just keep a counter - this time ## we use || and && in the "logic"... @@ -106,9 +108,10 @@ perl -E '($c-join"",map{0+(@Q=$c=~/($_)/g)}0..-1+length$c)||++$n&&say$c while++$ ## ## * We show a different trick to count the elements of the list. ## -## Rather than using the scalar @{[ ]} trick to convert it to -## an array we store it in a variable which makes it an array -## we can then get the length of the array. +## We can use another trick other than the scalar @{[ ]} trick to +## convert the list into an array. we store it in an array +## variable which makes it we can then get the length of the +## array (we just ignore the array!) ## ## As we are keeping the code short - we can replace the keyword ## scalar with a simple 0+ which forces the array to be converted @@ -116,7 +119,9 @@ perl -E '($c-join"",map{0+(@Q=$c=~/($_)/g)}0..-1+length$c)||++$n&&say$c while++$ ## ## * To gain another character as the equality is numeric we can ## rewrite if($a==$b) { f() } as ($a-$b)||f(). +## ## $a-$b is non-zero (true) if $a!=$b so we can rewrite: +## $a-$b is zero (false) if $a==$b so we can rewrite: ## ## if( $a == $b ) { f() } ## @@ -127,3 +132,10 @@ perl -E '($c-join"",map{0+(@Q=$c=~/($_)/g)}0..-1+length$c)||++$n&&say$c while++$ ## which we know we mentioned we could rewrite as: ## ## ($a-$b) || f() +## +## The brackets are important o/w this evaluates to: +## +## $a-($b||f()) +## +## which isn't what we want... +## diff --git a/challenge-107/james-smith/perl/ch-2.pl b/challenge-107/james-smith/perl/ch-2.pl index bf00dba212..edaefe1661 100644 --- a/challenge-107/james-smith/perl/ch-2.pl +++ b/challenge-107/james-smith/perl/ch-2.pl @@ -22,4 +22,17 @@ use Calc_Use; say join "\n ",'Calc_Require:', sort keys %Calc_Require::; say ''; say join "\n ",'Calc_Use:', sort keys %Calc_Use::; +say ''; + +## If we want to hide the "fake" methods (import/BEGIN) we +## can use grep/can to do so + +say join "\n ",'Calc_Require:', sort + grep {Calc_Require->can($_)} + keys %Calc_Require::; +say ''; +say join "\n ",'Calc_Use:', sort + grep {Calc_Use->can($_)} + keys %Calc_Use::; +say ''; |
