diff options
| author | drbaggy <js5@sanger.ac.uk> | 2022-02-07 21:12:44 +0000 |
|---|---|---|
| committer | drbaggy <js5@sanger.ac.uk> | 2022-02-07 21:12:44 +0000 |
| commit | 9ef372efc5add60eec0427895c78ef6f09fa4486 (patch) | |
| tree | 7c46b182e4277acece9261d528ea787c654be944 | |
| parent | dfad84860b890121e315e2f25746682e19b34fea (diff) | |
| download | perlweeklychallenge-club-9ef372efc5add60eec0427895c78ef6f09fa4486.tar.gz perlweeklychallenge-club-9ef372efc5add60eec0427895c78ef6f09fa4486.tar.bz2 perlweeklychallenge-club-9ef372efc5add60eec0427895c78ef6f09fa4486.zip | |
x
| -rw-r--r-- | challenge-151/james-smith/README.md | 100 | ||||
| -rw-r--r-- | challenge-151/james-smith/blog.txt | 1 |
2 files changed, 32 insertions, 69 deletions
diff --git a/challenge-151/james-smith/README.md b/challenge-151/james-smith/README.md index 552d615280..49a7babb29 100644 --- a/challenge-151/james-smith/README.md +++ b/challenge-151/james-smith/README.md @@ -1,6 +1,6 @@ -[< Previous 149](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-149/james-smith) | -[Next 151 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-151/james-smith) -# Perl Weekly Challenge #150 +[< Previous 150](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-150/james-smith) | +[Next 152 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-152/james-smith) +# Perl Weekly Challenge #151 You can find more information about this weeks, and previous weeks challenges at: @@ -12,92 +12,54 @@ submit solutions in whichever language you feel comfortable with. You can find the solutions here on github at: -https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-150/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-151/james-smith -# Challenge 1 - Fibonacci Words +# Challenge 1 - Binary Tree Depth -***You are given two strings having same number of digits, $a and $b. Write a script to generate Fibonacci Words by concatenation of the previous two strings. Finally print 51st digit of the first term having at least 51 digits.*** +***You are given binary tree. Write a script to find the minimum depth. The minimum depth is the number of nodes from the root to the nearest leaf node (node without any children).*** ## The solution -As we are not interested in the full 'fibonnaci' sequence - we just need to keep the last two entries. -We use Perl's ability to update two variables at once with the line `( $r, $s ) = ( $s, $r.$s )` which means that the original `$r` is used in the evaluation of `$s` which is often very useful. We repeat this until the last string is long enough to find the 51st element. - -We then just use `substr` to extract it (remembering `substr` is `0`-based so we only need character `50`.) - -```perl -sub fibnum { - my ( $r, $s ) = @_; - ( $r, $s ) = ( $s, $r.$s ) while 51 > length $s; - substr $s, 50, 1; -} -``` - -A slightly more compact version is achieved by: - * By rewriting `( $r, $s ) = ( $s, $r.$s )` as the slightly less readable `$s = $r.( $r=$s )` here you have to realise that `$r` has the old value outside the brackets, and the new value (or `$s`) inside the brackets. So even though it looks like `$r.$r` it is infact `$r.$s`. Yargh!! - * Using `$a`, `$b` instead of `$r`, `$s`. The former are *special* variables (for the comparision function in `sort`) and therefore they don't have to be `my`ed even when strict mode is enabled. +The method is to: + * Split the string into the individual rows. + * For each row check to see if the row is complete {has enough entries so that there are no parent nodes with no data} + * If there are less than `2**$d-1` entries then this row is "incomplete" and we return the depth. + * Check that there is no pair (with the same parent) for which both nodes are "`*`". Or if it is the last pair that it + contains a single "*". If either of the case the row is "incomplete" and we return the depth. ```perl -sub fibnum_messy { - ($a,$b)=@_;$b=$a.($a=$b)while 51>length$b; - substr$b,50,1; +sub depth { + my $d = 0; + for ( split m{\s*\|\s*}, $_[0] ) { + last if scalar @{[m{\S+}g]} < 2**$d - 1 + || m{^\s*(?:\S+\s+\S+\s+)*?(\*\s+\*|\*\s*$)}; + $d++; + } + $d; } ``` -# Challenge 2 - Square-free Integer +# Challenge 2 - Rob the House -***Write a script to generate all square-free integers <= 500. In mathematics, a square-free integer (or squarefree integer) is an integer which is divisible by no perfect square other than 1. That is, its prime factorization has exactly one factor for each prime that appears in it. For example, 10 = 2 x 5 is square-free, but 18 = 2 x 3 x 3 is not, because 18 is divisible by 9 = 3**2 +***You are planning to rob a row of houses, always starting with the first and moving in the same direction. However, you can’t rob two adjacent houses. Write a script to find the highest possible gain that can be achieved.*** ## The solution -Rather than searching for all square factors, we realise that we only need to search for the squares of primes {e.g. a number which is a multiple of `36=6*6` is also a multiple of both `4=2*2` and `9=3*3`. - -So we do passes first we create a list of prime squares. Again we use our *nasty* 2 line "prime" generator. Except this time we store and check against `prime^2` rather than just prime. - -**Note** we do the extra work of getting the square of the primes, rather than just the primes themselves, here. We do the "squaring operation" once only - and not every time through the second loop from `1..$N`. - -The second pass (OK in compact form - may not be the most efficient as `$N` gets large) is a set of nested greps. The inner one returns an empty list if there are is a prime squared factor - and so negating it returns true. +We use a recursive solution. For any house the best solution can be found by. Either adding the value of the current house to the best solution for 2 doors down OR adding the value of the next house to the best solution for 3 doors down. ```perl -my($N,@p2) = (@ARGV?$ARGV[0]:500,4); - -for(my$c=3;$c*$c<$N;$c+=2){ - ($_>$c)?((push@p2,$c*$c),last):$c*$c%$_||last for@p2; +sub rob { + my @b = my $v = shift; + $b[$_]=$b[$_-1]<($v=($_>1&&$b[$_-2])+shift)?$v:$b[$_-1]while@_; + $b[-1]; +sub rob { + my @b = shift; + (push @b,$_+(@b>1&&$b[-2])),$b[-1]<$b[-2]&&($b[-1]=$b[-2]) for @_; + $b[-1]; } -say for grep{my$t=$_;!grep{!($t%$_)}@p2}1..$N; -``` - -**Note** `say` without any parameters - outputs the contents of `$_` and then sends a carriage return. so `say for @A;` outputs all elements of the array `@A` on separate lines. - -## Follow up - -We can re-write the inefficient double `grep` more elegantly with nested `for`*each* loops. The new code becomes: - -```perl -my ( $N, @p2 ) = ( @ARGV ? $ARGV[0] : 500 , 4 ); - -P: for ( my $c = 3; $c*$c <= $N; $c += 2 ) { - $_ > $c ? last : $c*$c % $_ || next P for @p2; - push @p2, $c*$c; } -O: for my $t ( 1 .. $N ) { - $_ > $t ? last : $t % $_ || next O for @p2; - say $t; -} ``` -### Notes: - * We optimize the inner loop by allowing it to finish early if: - * We have a prime^2 value greater than `$t` - * We have a square factor - - * The difference in these two cases are: - * We end the inner loop and output the number as a square-free int (`last`) - * We skip to the next iteration of the outer loop (`next O`) without doing anything - - * The optimized version gives anywhere between 75% and 90% speed up... (values of `$N` between 100 and 1,000,000) - - * We have also re-written the prime generator to use the same `next {label}` trick, and this leads to a certain symmetry between the two loops. diff --git a/challenge-151/james-smith/blog.txt b/challenge-151/james-smith/blog.txt new file mode 100644 index 0000000000..948bd89928 --- /dev/null +++ b/challenge-151/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-151/james-smith |
