diff options
| -rw-r--r-- | challenge-199/james-smith/README.md | 2 | ||||
| -rw-r--r-- | challenge-200/james-smith/README.md | 197 | ||||
| -rw-r--r-- | challenge-200/james-smith/blog.txt | 1 | ||||
| -rw-r--r-- | challenge-200/james-smith/perl/ch-1.pl | 43 | ||||
| -rw-r--r-- | challenge-200/james-smith/perl/ch-2.pl | 36 |
5 files changed, 134 insertions, 145 deletions
diff --git a/challenge-199/james-smith/README.md b/challenge-199/james-smith/README.md index 77c550d2b6..b4670b096a 100644 --- a/challenge-199/james-smith/README.md +++ b/challenge-199/james-smith/README.md @@ -1,7 +1,7 @@ [< Previous 198](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith) | [Next 200 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith) -# The Weekly Challenge 198 +# The Weekly Challenge 199 You can find more information about this weeks, and previous weeks challenges at: diff --git a/challenge-200/james-smith/README.md b/challenge-200/james-smith/README.md index 77c550d2b6..c73cbf1efe 100644 --- a/challenge-200/james-smith/README.md +++ b/challenge-200/james-smith/README.md @@ -1,7 +1,7 @@ -[< Previous 198](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-198/james-smith) | -[Next 200 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith) +[< Previous 199](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-199/james-smith) | +[Next 201 >](https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-201/james-smith) -# The Weekly Challenge 198 +# The Weekly Challenge 200 You can find more information about this weeks, and previous weeks challenges at: @@ -13,162 +13,71 @@ 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-199/james-smith +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith -# Task 1 - Good Pairs +# Task 1: Arithmetic Slices -***You are given a list of integers, `@list`. Write a script to find the total count of Good Pairs. A pair `(i, j)` is called good if `list[i] == list[j]` and `i < j`.*** +***You are given an array of integers. Write a script to find out all Arithmetic Slices for the given array of integers. An integer array is called arithmetic if it has at least 3 elements and the differences between any three consecutive elements are the same.*** ## Solution -This problem can be reduced to a simpler problem - We note for any number - the contribution will be equal to the number of distinct pairs of the number - so if it has a frequence of `n` - then the number of good pairs containing that number are `n(n-1)`. We add these up and then divide by `2` as each pair is counted twice.. - -We use a hash as a simple way to count each number! We then throw away the keys and add the computed values up and then return the value! +There are a number of solutions.. I will start with the first "optimal" one I have... if I have time I'll write up a more compact one. ```perl -sub good_pairs { - my($c,%f); - $f{$_}++ for @_; - $c+=$_*($_-1) for values %f; - $c/2; -} -``` - -Note we could have used an external `freq` and `sum` method. To simplify this to: - -``` -sub good_pairs_fn { - ( sum map{$_*($_-1)} values %{freq(@_)} ) /2; -} -``` -# Task 2 - Good Triplets - -***You are given an array of integers, `@array` and three integers `$x`,`$y`,`$z`. Write a script to find out total Good Triplets in the given array. -A triplet `array[i]`, `array[j]`, `array[k]` is good if it satisfies the following conditions:*** - - * `0 <= i < j < k <= n` - * `abs(array[i] - array[j]) <= x` - * `abs(array[j] - array[k]) <= y` - * `abs(array[i] - array[k]) <= z` - -## Solution - -If you look in the source code you will find a few different methods - but I will outline a few places where gains are made and then include the fastest solution. - -One naive approach could be: - -```perl -sub good_triples_naive { - my($c,$x,$y,$z) = (0,splice @_, 0, 3 ); - for my $i ( 0..$#_-2 ) { - for my $j ( $i+1..$#_-1 ) { - for ( $j+1..$#_ ) { - $c++ if abs($_[$i]-$_[$j])<= $x - && abs($_[$j]-$_[$_])<= $y - && abs($_[$i]-$_[$_])<= $z; - } +sub a_slices { + ## Less than 1 value return... + return unless $#_; + ## Set start of sequence to 0, d - the difference between entry 1 and entry 0 + my($st,$d,@pairs)=(0,$_[1]-$_[0]); + ## Loop through all end points + for(my$en=1;$en<@_;$en++) { + ## If the gap is different - update gap (and start) and continute through loop + if($_[$en]-$_[$en-1] != $d) { + ($st,$d)=($en-1,$_[$en]-$_[$en-1]) + ## If it is the same add it and all alternative entries + } else { + ## We only store the start/end of the runs not the whole sequence + push( @pairs, map { [$_,$en] } $st..$en-2 ); } } - $c; + ## Now we find all the start ends and return the series of each of these subsequences. + return [ map { [ @_[ $_->[0] .. $_->[1] ] ] } @pairs ]; } ``` -The things we note: - 1. We perform the check `abs($_[$i]-$_[$j])<= $x` everytime in the inner loop - 2. We use a lot of array references `$_[$i]``, `$_[$j]`... - 3. We use a built in function `abs` - -All these slow us down. - -So **1** is easy to solve we move that condition into an if to avoid the inner loop. For tidyness we invert the condition and use `next`... - -**2** we can copy `$_[$i]`, `$_[$j]`, `$_[$_]` into variables - there is an overhead in this - replacing `$_[$i]` & `$_[$j]` improves performance but the inner one slows things down (overhead of "copy" vs overhead of reference) - -**3** we can convert the `abs` condition into a range. `abs($_1-$_2) <= $x` - -can be written as `-$x <= $_1-$_2 && $_1-$_2 <= $x` +# Task 2: Seven Segment 200 -can be written as `$_1-$x<=$_ && $_2<=$_1+$x` - -This just doesn't remove the call to `abs` but aslo a subtraction - as we can precompute `$_1-$x` & `$_1+$x`. - -This gives us - -```perl -sub good_triples_range_2 { - my($c,$x,$y,$z,$_1,$_2,$lx,$ux,$lz,$uz,$ly,$uy)=(0,splice@_,0,3); - for my $i ( 0..$#_-2 ) { - ($lx,$ux,$lz,$uz) = (($_1 = $_[$i])-$x, $_1+$x,$_1-$z,$_1+$z); - for my $j ( $i+1..$#_-1 ) { - $_2 = $_[$j]; - next if $_2 < $lx || $_2 > $ux; - ($ly,$uy) = ($lz>$_2-$y?$lz:$_2-$y,$uz<$_2+$y?$uz:$_2+$y); - for ( $j+1..$#_ ) { - $c++ if $ly <= $_[$_] && $_[$_] <= $uy; - } - } - } - $c; -} +***A seven segment display is an electronic component, usually used to display digits. The segments are labeled 'a' through 'g' as shown: The encoding of each digit can thus be represented compactly as a truth table:*** ``` +my @truth = qw<abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg>; +``` +***For example, `$truth[1] = ‘bc’`. The digit 1 would have segments ‘b’ and ‘c’ enabled.*** -Note in the inner loop we merge the ranges so reducing the comparisons even further. - -### Bonus - how can we get this faster - -How can we get this faster - This O(3) whatever happens can we reduce the time in anyway... - -Other than what we've done - the only way to improved performance is to reduce the number of times we loop. Well the inner loop we can't change - the outer loop we can't change - but what about the inner loop... Heuristically the efficiency of the filter is proportional to `$x`. So if we chose the smallest `$x` we get the best result.. - -We can't change order but we can choose the *order* of the loops. This gives us the code from hell... +## Solution ```perl -sub good_triples_fastest { - my($c,$xy,$yz,$xz,$l,$u,$lx,$ux,$ly,$uy,$lz,$uz,$i,$j,$k,$x,$y,$z)=(0,splice@_,0,3); - - if($xy<=$xz&&$xy<=$yz){ - for $i ( 0 .. $#_-2 ) { - ( $ly, $uy, $lz, $uz ) = ( ($x=$_[$i])-$xy, $x+$xy, $x-$xz, $x+$xz ); - for $j ( $i+1 .. $#_-1 ) { - next if ($y=$_[$j]) < $ly || $uy<$y; - ( $l, $u ) = ( $lz > $y-$yz ? $lz : $y-$yz, $uz < $y+$yz ? $uz : $y+$yz ); - $l <= $_[$_] && $_[$_] <= $u && $c++ for $j+1 .. $#_ - } - } - } elsif ( $yz<=$xz ) { - for $j ( 1 .. $#_-1 ) { - ( $lz, $uz, $lx, $ux ) = ( ($y=$_[$j])-$yz, $y+$yz, $y-$xy, $y+$xy ); - for $k ( $j+1 .. $#_ ) { - next if ($z=$_[$k]) < $lz || $uz < $z; - ( $l, $u ) = ( $lx > $z-$xz ? $lx : $z-$xz, $ux < $z+$xz ? $ux : $z+$xz ); - $l <= $_[$_] && $_[$_] <= $u && $c++ for 0 .. $j-1 - } - } - } else { - for $i ( 0..$#_-2 ) { - ( $ly, $uy, $lz, $uz ) = ( ($x=$_[$i])-$xy, $x+$xy, $x-$xz, $x+$xz ); - for $k ( $i+2..$#_ ) { - next if ($z=$_[$k]) <$lz || $uz < $z; - ( $l, $u ) = ( $ly > $z-$yz ? $ly : $z-$yz, $uy < $z+$yz ? $uy : $z+$yz ); - $l <= $_[$_] && $_[$_] <= $u && $c++ for $i+1 .. $k-1; - } +my @truth = qw(abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg); +my @blank = map { ' ' } 0..6; + +## A mapper for segment to what to draw... The rows are represented by pairs of bits 0->blank, 1->LHS, 2->RHS, 3->bar +my %parts = ( 'a' => 0x0003, 'b' => 0x0028, 'c' => 0x0a00, 'd' => 0x3000, 'e' => 0x0500, 'f' => 0x0014, 'g' => 0x00c0, ); +## The four "pictures"! +my @parts = ( ' ', '| ', ' |', ' -- ' ); + +sub display { + ## Grab number & initialise output as empty. + my( $n, @out ) = ( shift, map {''} @blank ); + while( $n ) { + ## Get the last digit & set the display for the digit to blank. + my( $d, @dig ) = ( $n%10, @blank ); + ## Use our truth table along with part mapping to generate values for each number + for my $bar ( map { $parts{$_} } split //, $truth[$d] ) { + $dig[ $_ ] |= $parts[ $bar&3 ], $bar >>= 2 for 0 .. $#blank } + ## Add to the display... + $out[ $_ ] = $dig[ $_ ].' '.$out[ $_ ] for 0..$#blank; + ## Update N... + $n = int( $n / 10 ); } - $c; -} -``` - -Looks nasty - but it is just three copies of the code above - the first called if `$x` is smallest, the second if `$y` is smallest and lastly when `$z` is the smallest. - -### Performance - -When the list is short it doesn't really matter about performance - but with the tests above with the longer list we have: - -| | Rate | naive | opt | copy_1 | range_1 | copy_2 | range_2 | fastest | -| -------- | -----: | ----: | ---: | -----: | ------: | -----: | ------: | ------: | -| naive | 14.6/s | -- | -43% | -50% | -52% | -57% | -64% | -85% | -| opt | 25.6/s | 75% | -- | -12% | -15% | -24% | -36% | -73% | -| copy_1 | 29.1/s | 99% | 13% | -- | -4% | -14% | -28% | -70% | -| range_1 | 30.2/s | 106% | 18% | 4% | -- | -10% | -25% | -69% | -| copy_2 | 33.6/s | 130% | 31% | 16% | 11% | -- | -17% | -65% | -| range_2 | 40.3/s | 176% | 57% | 39% | 33% | 20% | -- | -58% | -| fastest | 96.3/s | 558% | 275% | 231% | 219% | 186% | 139% | -- | + ## Render! + say for @out; +}``` diff --git a/challenge-200/james-smith/blog.txt b/challenge-200/james-smith/blog.txt new file mode 100644 index 0000000000..55f0073b75 --- /dev/null +++ b/challenge-200/james-smith/blog.txt @@ -0,0 +1 @@ +https://github.com/drbaggy/perlweeklychallenge-club/tree/master/challenge-200/james-smith diff --git a/challenge-200/james-smith/perl/ch-1.pl b/challenge-200/james-smith/perl/ch-1.pl new file mode 100644 index 0000000000..5025939f0a --- /dev/null +++ b/challenge-200/james-smith/perl/ch-1.pl @@ -0,0 +1,43 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); +use Test::More; +use Benchmark qw(cmpthese timethis); + +my @TESTS = ( + [ [1..4], '(1,2,3), (1,2,3,4), (2,3,4)' ], + [ [1,3,4,5], '(3,4,5)' ], + [ [1,2,3,5,6,7,9,0,-4,-8], '(0,-4,-8), (1,2,3), (5,6,7)' ], + [ [1,1,1,1,2,3,4,6,8,10,15,20,25,50,100,125,150,175,200], '(1,1,1), (1,1,1), (1,1,1,1), (1,2,3), (1,2,3,4), (10,15,20), (10,15,20,25), (100,125,150), (100,125,150,175), (100,125,150,175,200), (125,150,175), (125,150,175,200), (15,20,25), (150,175,200), (2,3,4), (4,6,8), (4,6,8,10), (6,8,10)' ], + [ [2], "" ], + [ [1,2,4,8,16,32], "" ], +); +is( a_slices( @{$_->[0]}), $_->[1] ) foreach @TESTS; +done_testing(); + +## Display an array of arrays compactly... +sub d_slices { return join ', ', map { '('.join(',', @{$_}).')' } @{$_[0]}; } + + +sub a_slices { + ## Less than 1 value return... + return unless $#_; + ## Set start of sequence to 0, d - the difference between entry 1 and entry 0 + my($st,$d,@pairs)=(0,$_[1]-$_[0]); + ## Loop through all end points + for(my$en=1;$en<@_;$en++) { + ## If the gap is different - update gap (and start) and continute through loop + if($_[$en]-$_[$en-1] != $d) { + ($st,$d)=($en-1,$_[$en]-$_[$en-1]) + ## If it is the same add it and all alternative entries + } else { + ## We only store the start/end of the runs not the whole sequence + push( @pairs, map { [$_,$en] } $st..$en-2 ); + } + } + ## Now we find all the start ends and return the series of each of these subsequences. + return [ map { [ @_[ $_->[0] .. $_->[1] ] ] } @pairs ]; +} + diff --git a/challenge-200/james-smith/perl/ch-2.pl b/challenge-200/james-smith/perl/ch-2.pl new file mode 100644 index 0000000000..4edf36dff1 --- /dev/null +++ b/challenge-200/james-smith/perl/ch-2.pl @@ -0,0 +1,36 @@ +#!/usr/local/bin/perl + +use strict; +use warnings; +use feature qw(say); + +## Our provided truth table... +my @truth = qw(abcdef bc abdeg abcdg bcfg acdfg acdefg abc abcdefg abcfg); +my @blank = map { ' ' } 0..6; + +## A mapper for segment to what to draw... The rows are represented by pairs of bits 0->blank, 1->LHS, 2->RHS, 3->bar +my %parts = ( 'a' => 0x0003, 'b' => 0x0028, 'c' => 0x0a00, 'd' => 0x3000, 'e' => 0x0500, 'f' => 0x0014, 'g' => 0x00c0, ); +## The four "pictures"! +my @parts = ( ' ', '| ', ' |', ' -- ' ); + +sub display { + ## Grab number & initialise output as empty. + my( $n, @out ) = ( shift, map {''} @blank ); + while( $n ) { + ## Get the last digit & set the display for the digit to blank. + my( $d, @dig ) = ( $n%10, @blank ); + ## Use our truth table along with part mapping to generate values for each number + for my $bar ( map { $parts{$_} } split //, $truth[$d] ) { + $dig[ $_ ] |= $parts[ $bar&3 ], $bar >>= 2 for 0 .. $#blank + } + ## Add to the display... + $out[ $_ ] = $dig[ $_ ].' '.$out[ $_ ] for 0..$#blank; + ## Update N... + $n = int( $n / 10 ); + } + ## Render! + say for @out; +} + +display(200); +display(314159265358979); |